Задача по ссылке от Munin

[rockclimber]

_Ivana в сообщении #687816 писал(а):

Я сам сейчас пишу реализацию своего последнего алгоритма на С, может так больше народу заинтересуется и покритикует, сравнит )

Выложи, главное, чтобы было с чем сравнивать... Хотя я свой код улучшать дальше вряд ли буду.
Правда, тут автор топика выкладывал уже код 1С - я не смог заставить себя его читать. Русские буквы вызывают у меня паралич программировательного отдела мозга. Си почти не знаю, понимаю с пятого на десятое, но наверно что-то да пойму.

P. S. В моем коде модуль parser.pas собственно выполняет всю работу по разбору кода и преобразованию, а модуль unit1.pas - это модуль формы главного окна.

P. P. S. Еще был такой эпичнейший топик на схожую тему на sql.ru, но людям с тонкой душевной организацией его лучше не читать. Топик наполовину состоит из пустого флуда (цена популярности сайта, что поделать), но вроде кто-то даже периодически пытался давать умные советы.

[Xaositect]

Посидел еще часик со своей реализацией. Получился огрызок Парсека, поэтому смотреть на него не так интересно.

Используется синтаксис Haskell

module Main where

import Data.Char
import Control.Monad
import Control.Arrow

isVar :: Char -> Bool
isVar c = isAscii c && isAlpha c

inList :: (Eq a) => [a] -> a -> Bool
inList = flip elem

data Variable = Var Char
data Operator = ADD | SUB | MUL | DIV deriving Show

instance Show Variable where
  show (Var c) = c:[]

op :: Char -> Operator
op '+' = ADD
op '-' = SUB
op '*' = MUL
op '/' = DIV

data BinTree a b = Leaf a | Branch b (BinTree a b) (BinTree a b)

treeCata :: (a -> r) -> (b -> r -> r -> r) -> (BinTree a b -> r)
treeCata base rec = go where
  go (Leaf a) = base a
  go (Branch b l r) = rec b (go l) (go r)

instance (Show a, Show b) => Show (BinTree a b) where
  show = treeCata show (\b l r -> (show b) ++ "(" ++ l ++ ", " ++ r ++ ")")

data Intercalated a b = First a | Then (Intercalated a b) (b, a)

interCata :: (a -> r) -> (r -> b -> a -> r) -> (Intercalated a b -> r)
interCata base rec = go where
  go (First a) = base a
  go (Then init (b, a)) = rec (go init) b a

instance (Show a, Show b) => Show (Intercalated a b) where
  show = interCata show (\l b a -> l ++ " - " ++ (show b) ++ (show a))

data Parser a r = Parser ([a] -> Maybe (r, [a]))

(#) :: Parser a r -> [a] -> Maybe (r, [a])
(#) (Parser parser) xs = parser xs

runParser :: Parser a r -> [a] -> Maybe r
runParser parser xs = case parser # xs of
  Just (result, []) -> Just result
  _ -> Nothing

instance Functor (Parser a) where
  fmap f (Parser parser) = Parser (fmap (first f) . parser)

eat :: (a -> Bool) -> Parser a a
eat p = Parser newparser where
  newparser [] = Nothing
  newparser (x:xs) = if p x then Just (x, xs) else Nothing

pSeq :: Parser a b -> Parser a c -> Parser a (b, c)
pSeq parser1 parser2 = Parser newparser where
  newparser xs = do
    (b, rest1) <- parser1 # xs
    (c, rest2) <- parser2 # rest1
    return ((b, c), rest2)

pLoop :: Parser a b -> Parser a [b]
pLoop item = Parser newparser where
  newparser xs = case item # xs of
    Nothing -> return ([], xs)
    Just (b, rest) -> do (bs, rest2) <- newparser rest; return (b:bs, rest2)

separated :: Parser a b -> Parser a c -> Parser a (Intercalated b c)
separated item separator = Parser newparser where
  newparser xs = do
    (b, rest) <- item # xs
    (xs, rest2) <- pLoop (pSeq separator item) # rest
    return $ (foldl Then (First b) xs, rest2)

bracketed :: Parser a b -> Parser a () -> Parser a () -> Parser a b
bracketed item left right = Parser newparser where
  newparser xs = do
    ((), good) <- left # xs
    (b, rest) <- item # good
    ((), rest2) <- right # rest
    return (b, rest2)

pOr :: Parser a b -> Parser a b -> Parser a b
pOr parser1 parser2 = Parser newparser where
  newparser xs = case parser1 # xs of
    Nothing -> parser2 # xs
    Just result -> Just result

atom :: Parser Char (BinTree Variable Operator)
atom = fmap (Leaf . Var) $ eat isVar

element :: Parser Char (BinTree Variable Operator)
element = pOr atom (bracketed expression (void $ eat (== '(')) (void $ eat (== ')')))

summand :: Parser Char (BinTree Variable Operator)
summand = fmap (interCata id (flip Branch)) $ separated element (fmap op $ eat $ inList "*/")

expression :: Parser Char (BinTree Variable Operator)
expression = fmap (interCata id (flip Branch)) $ separated summand (fmap op $ eat $ inList "+-")

skipSpaces :: Parser Char ()
skipSpaces = Parser (\xs -> Just ((), filter (/= ' ') xs))

pre :: Parser a () -> Parser a b -> Parser a b
pre preparser parser = fmap snd $ pSeq preparser parser

main :: IO ()
main = do
  str <- getLine
  case runParser (pre skipSpaces expression) str of
    Nothing -> print "ERROR"
    Just result -> print result
 

-- Пн фев 25, 2013 02:13:44 --

rockclimber в сообщении #687814 писал(а):

Вы меня прямо заразили, я сел и тоже написал решение этой задачи.
Заодно прикрутил ей пошаговый отладчик с визуализацией дерева операций.
Писал наспех, то есть кое-как.
Исходники проекта для Lazarus можно скачать тут.

P. S. Теорию синтаксического анализа не читал, но осуждаю но обязательно почитаю (не знаю когда, очередь "что почитать" расписана на годы вперед ).
P. P. S. Про деревья я тоже ничего не читал (да я вообще почти ничего не читал, если честно), так что если код вызывает у вас - это нормально.

Цитата:

procedure TParser.Operation(l: char);
[...]
       if     (FCurrent.Parent.Optype in [otMul, otDiv])
          or ((FCurrent.Parent.Optype in [otMul, otDiv]) and (l in ['*', '/']))
[...]

Второе условие не нужно.

А еще у Вас память течет, например, в том же TParser.Operation Вы создаете операнды у newOp, а потом их присваиваете без удаления предыдущего значения.

[rockclimber]

Xaositect в сообщении #687853 писал(а):

Цитата:

procedure TParser.Operation(l: char);
[...]
       if     (FCurrent.Parent.Optype in [otMul, otDiv])
          or ((FCurrent.Parent.Optype in [otMul, otDiv]) and (l in ['*', '/']))
[...]

Второе условие не нужно.

Разве? Тут проверяется приоритет операций, если убрать второе условие, то в участках вида "a * b * c" второе умножение будет получаться более приоритетным, чем первое. По крайней мере, поначалу так получалось, но я с тех пор много чего поменять успел. Я немного подумал и, пожалуй, соглашусь.

Xaositect в сообщении #687853 писал(а):

А еще у Вас память течет, например, в том же TParser.Operation Вы создаете операнды у newOp, а потом их присваиваете без удаления предыдущего значения.

Да, точно. По-хорошему, надо было написать отдельный метод для встраивания нового узла в середину, но этот момент лень было обдумывать более тщательно.
А слово "например" значит, что память течет много где еще?
P. S. Если вдруг кому надо, для freepascal есть модуль leakview - позваляет утечки отслеживать (вроде даже входит в стандартный дистрибутив Lazarus), могу даже выдать имя автора...

[arseniiv]

Xaositect в сообщении #687853 писал(а):

Получился огрызок Парсека

А там тоже стрелки используются внутри?

[Xaositect]

arseniiv в сообщении #687928 писал(а):

А там тоже стрелки используются внутри?

Вроде нет, но у меня от стрелок используется только first :: (b -> c) -> ((b, d) -> (c, d)) (полная сигнатура (Arrow a) => a b c -> a (b, d) (c, d))

-- Пн фев 25, 2013 12:56:21 --

rockclimber в сообщении #687888 писал(а):

А слово "например" значит, что память течет много где еще?

Вроде нет. Показалось :)

[_Ivana]

rockclimber

(Оффтоп)

rockclimber в сообщении #687822 писал(а):

Правда, тут автор топика выкладывал уже код 1С - я не смог заставить себя его читать. Русские буквы вызывают у меня паралич программировательного отдела мозга.

Этот диагноз можно лечить по разному. Можно, например, написать переводчик текста кода на английский язык - 1С допускает англоязычные синонимы всех операторов и зарезервированных конструкций (Для = For, Если = If и т.д.), переменные можно переводить транслитом. Написать такой переводчик гораздо легче, чем решить сабжевую задачу этой темы, например. А можно поступить по примеру скромных и грамотных участников форума, которые прочитали код не акцентируя внимания на его русскоязычности. Ну и, наконец, можно оставить все как есть, и дальше обрастать амбициями, которые свойственны дилетантам, строящим из себя крутых программистов - не любить русские буквы, бэйсик, Майкрософт, цикл в цикле вместо рекурсии, получение десятичных разрядов вычитанием порядка а не делением на 10 и куча прочих суеверий, которым нет конца.

ЗЫ я бы очень хотел, чтобы подобные холивары и меряние амбициями остались в соседней теме. И продолжаю надеяться, что в этой теме будет конструктивное обсуждение алгоритмов и конкретных реализаций.

[rockclimber]

(Оффтоп)

_Ivana в сообщении #687962 писал(а):

Ну и, наконец, можно оставить все как есть, и дальше обрастать амбициями, которые свойственны дилетантам, строящим из себя крутых программистов - не любить русские буквы, бэйсик, Майкрософт, цикл в цикле вместо рекурсии, получение десятичных разрядов вычитанием порядка а не делением на 10 и куча прочих суеверий, которым нет конца.

Я разве говорил, что не люблю русские буквы? Я обожаю русские буквы, русские буквы - самые лучшие буквы в мире! Но когда я читаю код, написанный исключительно на русском - у меня в голове происходит "щелк" - и я перестаю что-то понимать. Я не специально. Просто английские буквы более "чужие", их проще воспринимать не как буквы, а как специальные значки для "особого употребления". Вот Xaositect, кстати, тоже код приводил на каком-то далеком от меня языке я его еще меньше понял.

_Ivana в сообщении #687962 писал(а):

бэйсик, Майкрософт, цикл в цикле вместо рекурсии, получение десятичных разрядов вычитанием порядка а не делением на 10 и куча прочих суеверий, которым нет конца.

Это исключительно ваши половые фантазии или банальная провокация, все эти слова не имеют ко мне никакого отношения.

[Xaositect]

Xaositect в сообщении #687853 писал(а):

Используется синтаксис Haskell

separated :: Parser a b -> Parser a c -> Parser a (Intercalated b c)
separated item separator = Parser newparser where
  newparser xs = do
    (b, rest) <- item # xs
    (xs, rest2) <- pLoop (pSeq separator item) # rest
    return $ (foldl Then (First b) xs, rest2)

bracketed :: Parser a b -> Parser a () -> Parser a () -> Parser a b
bracketed item left right = Parser newparser where
  newparser xs = do
    ((), good) <- left # xs
    (b, rest) <- item # good
    ((), rest2) <- right # rest
    return (b, rest2)

Собственно, что это я комбинаторов понаписал и не использую:

Используется синтаксис Haskell

separated item separator = fmap (uncurry (foldl Then)) $ pSeq (fmap First item) $ pLoop (pSeq separator item)

bracketed item left right = fmap snd $ pSeq left (fmap fst $ pSeq item right)

[_Ivana]

Написал на С. Работает. Но такой ужасно неоптимальный код плюс прожорливость памяти, что мне стыдно его выкладывать, боюсь массового глумления

[_Ivana]

Ну а вот это уже думаю можно выложить По требуемой памяти имхо очень хорошо, по скорости выполнения - немного хуже, можно наверное убыстрить ценой ввода дополнительного массива из 39 указателей, может попозже допишу. Да, на двухбуквенные выходные операторы не обращайте внимания, сделал так исключительно для удобства и проверки алгоритма, в следующей редакции сделаю все таки трехбуквенные

Используется синтаксис C

char in_str[] = "((i*a)) - b*(c-d-e)/(e-f-l)";
// SUB( MUL(i,a), DIV( MUL(b, SUB( SUB(c,d),e)), SUB( SUB(e,f),l)))
        
void main(void)
{
        volatile char out_str[275]; // 39*7+1+1
        int level=0, order=0, last_order=-1;
        char c, op;
        char *p_in, *p_out, *p_op, *p_arg;
        
        p_in = in_str; p_out = out_str;
        while (1) {
                c = *p_in++;
                if (c == ' ') {}
                else if (c == '(') { level++;}
                else if (c == ')') { level--;}
                else if ( (c == '+')||(c == '-')||(c == '*')||(c == '/')||(!c) ) {
                        order = level<<1;
                        if ( (c == '*')||(c == '/') ) { order++;} else if (!c) { order = 0;}
                        
                        if (order <= last_order){
                                p_op = p_out - 4;
                                while (p_op >= out_str) {
                                        op = *p_op;
                                        if ( (op == '+')||(op == '-')||(op == '*')||(op == '/') ) {
                        if (*(p_op + 1) < order) break;
                        p_arg = p_op + 3;
                        while (p_arg < p_out) {*(p_arg - 1) = *p_arg++;}
                        *(p_arg - 1) = ')';     *(p_op + 1) = ',';
                        p_arg = p_op - 3;
                        while ( (p_arg >= out_str) & (*p_arg != ' ') ) {*(p_arg + 3) = *p_arg--;}
                        p_arg++;
                        if        (op == '+') { *p_arg++ = 'A';*p_arg++ = 'D';*p_arg++ = '(';
                        } else if (op == '-') { *p_arg++ = 'S';*p_arg++ = 'U';*p_arg++ = '(';
                        } else if (op == '*') { *p_arg++ = 'M';*p_arg++ = 'U';*p_arg++ = '(';
                        } else if (op == '/') { *p_arg++ = 'D';*p_arg++ = 'I';*p_arg++ = '(';}
                                        }
                                        p_op = p_op - 6;
                                }
                        }
                        if (!c) break;
                        *p_out++=' '; *p_out++=' '; *p_out++=c; *p_out++=order; *p_out++=' ';
                        last_order = order;
                }
                else { *p_out++ = c;}
        }
}

Надеюсь на С желающим будет проще проверить, протестировать и замерить. Да, проверки корректности входящих данных нет.
UPD: внутренний блок сдвинул на пару табуляций влево, иначе здесь строки переносятся - некрасиво. У меня в АВР-Студио на экран влезает, мне удобно (похоже длина табуляции меньше или еще что).
UPD 1: исключил лишние пробежки по операциям.

[rockclimber]

_Ivana в сообщении #688687 писал(а):

Используется синтаксис C

char in_str[] = "((i*a)) - b*(c-d-e)/(e-f-l)";

Интересная мысль... Выражение вида ((i*a)) - корректное? Вроде бы да, но мой алгоритм, скорее всего, это не обработает Доделать его что ли...

[EtCetera]

Получилось слишком многословно, но зато просматривается задел для усовершенствований:

Используется синтаксис Prolog

Domains

        CharList = Char *
        
        Operator = plus; minus; multiply; divide
        Bracket = left; right
        Token = identifier(Char); operator(Operator); bracket(Bracket)
        TokenList = Token *
        
        Operand = variable(Char); operation(Operation)
        OperationType = addition; subtraction; multiplication; division
        Operation = operation(OperationType, Operand, Operand)

Predicates

        StringToCharList(String, Charlist)
        SkipSpaces(CharList, CharList)
        IsLetter(Char)
        
        IdentifyToken(Char, Token)
        CharListToTokenList(CharList, TokenList)
        
        IsLowPriority(OperationType)
        TokenListToBracket(TokenList, Bracket, TokenList)
        TokenListToOperand(TokenList, Operand, TokenList)
        TokenListToOperationType(TokenList, OperationType, TokenList)
        TokenListToPrioritySequence(Operand, TokenList, Operand, TokenList)
        TokenListToPriority(TokenList, Operand, TokenList)
        TokenListToExpressionSequence(Operand, TokenList, Operand, TokenList)
        TokenListToExpression(TokenList, Operand, TokenList)
        
        OperandToString(Operand, String)
        OperationTypeToString(OperationType, String)
        OperationToString(Operation, String)

        Calculator()

Clauses

        StringToCharList("", []) :- !.
        StringToCharList(S, [H | T]) :-
                frontchar(S, H, ST),
                StringToCharList(ST, T).

        SkipSpaces([], []) :- !.
        SkipSpaces([C | T1], T2) :- C = ' ', SkipSpaces(T1, T2), !.
        SkipSpaces([C | T1], [C | T2]) :- SkipSpaces(T1, T2).
        
        IsLetter(C) :- C >= 'a', C <= 'z', !.
        IsLetter(C) :- C >= 'A', C <= 'Z'.
        
        IdentifyToken(C, identifier(C)) :- IsLetter(C), !.
        IdentifyToken('+', operator(plus)).
        IdentifyToken('-', operator(minus)).
        IdentifyToken('*', operator(multiply)).
        IdentifyToken('/', operator(divide)).
        IdentifyToken('(', bracket(left)).
        IdentifyToken(')', bracket(right)).
        
        CharListToTokenList([], []).
        CharListToTokenList([CLH | CLT], [TLH | TLT]) :- IdentifyToken(CLH, TLH), CharListToTokenList(CLT, TLT).
        
        IsLowPriority(addition).
        IsLowPriority(subtraction).
        
        TokenListToBracket([bracket(B) | TLT], B, TLT).
        
        TokenListToOperand([identifier(C) | TLT], variable(C), TLT) :- !.
        TokenListToOperand(TL1, O, TL) :-
                TokenListToBracket(TL1, left, TL2),
                TokenListToExpression(TL2, O, TL3),
                TokenListToBracket(TL3, right, TL).
        
        TokenListToOperationType([operator(plus) | TLT], addition, TLT).
        TokenListToOperationType([operator(minus) | TLT], subtraction, TLT).
        TokenListToOperationType([operator(multiply) | TLT], multiplication, TLT).
        TokenListToOperationType([operator(divide) | TLT], division, TLT).
        
        TokenListToPrioritySequence(O1, TL, O, TLT) :-
                TokenListToOperationType(TL, OT, TLT1),
                not(IsLowPriority(OT)),
                TokenListToOperand(TLT1, O2, TLT2),
                TokenListToPrioritySequence(operation(operation(OT, O1, O2)), TLT2, O, TLT), !.
        TokenListToPrioritySequence(O, TL, O, TL).
        
        TokenListToPriority(TL, O, TLT) :-
                TokenListToOperand(TL, O1, TLT1),
                TokenListToPrioritySequence(O1, TLT1, O, TLT), !.
        TokenListToPriority(TL, O, TLT) :- TokenListToOperand(TL, O, TLT).
        
        TokenListToExpressionSequence(O1, TL, O, TLT) :-
                TokenListToOperationType(TL, OT, TLT1),
                IsLowPriority(OT),
                TokenListToPriority(TLT1, O2, TLT2),
                TokenListToExpressionSequence(operation(operation(OT, O1, O2)), TLT2, O, TLT), !.
        TokenListToExpressionSequence(O, TL, O, TL).
                        
        TokenListToExpression(TL, O, TLT) :-
                TokenListToPriority(TL, O1, TLT1),
                TokenListToExpressionSequence(O1, TLT1, O, TLT), !.
        TokenListToExpression(TL, O, TLT) :-
                TokenListToPriority(TL, O, TLT).
        
        OperandToString(variable(C), S) :- str_char(S, C), !.
        OperandToString(operation(O), S) :- OperationToString(O, S).
        
        OperationTypeToString(addition, "ADD").
        OperationTypeToString(subtraction, "SUB").
        OperationTypeToString(multiplication, "MUL").
        OperationTypeToString(division, "DIV").
        
        OperationToString(operation(OT, O1, O2), S) :-
                OperationTypeToString(OT, SOT),
                OperandToString(O1, SO1),
                OperandToString(O2, SO2),
                format(S, "%(%,%)", SOT, SO1, SO2).

        Calculator() :-
                readln(IS),
                StringToCharList(IS, CL),
                SkipSpaces(CL, CL_WS),
                CharListToTokenList(Cl_WS, TL),
                TokenListToExpression(TL, O, []),
                OperandToString(O, OS),
                write(OS), nl,
                readchar(_).

Goal

        Calculator().

[_Ivana]

rockclimber в сообщении #688705 писал(а):

Выражение вида ((i*a)) - корректное?

Думаю, не стоит ограничивать пользователя в возможности поставить лишние скобки, как это и делают все компиляторы. У меня алгоритм прожевывает даже такое:

Используется синтаксис C

char in_str[] = "((i*a)) - (())()(((b)))*(c-(((d)))-e)/(e-f-l)";

ЗЫ народ выкладывает алгоритмы, но я кроме своих остальные не понимаю совершенно, по причине незнания языков, в которых они выложены Может стоит сопровождать их подробными описаниями что они делают - на словах? Если кому интересно и непонятно, могу рассказать про свои.

UPD страница с задачей не открывается, уже пару дней глюк какой-то у них на сайте. А я уже хотел отправить туда свой последний код на С, чтобы оценить сравнительную непрожорливость и производительность...

[Xaositect]

У EtCetera какой-то из диалектов пролога. Сначала классифицируем все символы на скобки, идендификаторы и операторы, потом для списка таких токенов строим синтаксическое дерево (задаваемое типом Operation). Для этого рассматриваем список слева направо как последовательность, разделенную операторами малого приоритета (+-), каждый элемент этой последовательности как последовательность, разделенную операторами */, а на нижнем уровне операнд - либо идентификатор, либо аналогичное выражение в скобках.

[arseniiv]

(Оффтоп)

_Ivana в сообщении #688899 писал(а):

(())()…

Слишком широкий язык разбирается вашим алгоритмом. А если такие прилепленные скобки содержат ещё одно выражение, типа (1+2)(3/4), такое, случайно, не допустится тоже?