需要帮助解决我的 Haskell 代码中关于调车场算法的问题

Question

我正在学习 Haskell，我正在尝试实现非常基本的调车场算法来读取非常基本的数学表达式。例如 A+B-C*D。

这是我当前的算法：

push :: Char -> [Char] -> [Char]
push x [] = [x]
push x xs = reverse (x:(reverse xs))

pop :: [Char] -> [Char]
pop [] = []
pop (x:xs) = xs

peek :: [Char] -> Char
peek (x:_) = x

isEmpty :: [Char] -> Bool
isEmpty [] = True
isEmpty _  = False

isParenthesis :: Char -> Bool
isParenthesis chr = elem chr "()"
isOperand :: Char -> Bool
isOperand chr = elem chr ['A'..'Z'] || elem chr ['a'..'z']
isOperator :: Char -> Bool
isOperator chr = elem chr "+-*/^"

infixToPostfix :: [Char] -> [Char]
infixToPostfix expr = helper expr [] []
  where
    helper :: [Char] -> [Char] -> [Char] -> [Char]
    helper [] operand operator = operand ++ operator
    helper (x:xs) operand operator
      | isParenthesis x = helper xs operand operator
      | isOperand x = helper xs (push x operand) operator
      | isOperator x && isEmpty operator = helper xs operand (x:operator)
      | isOperator x && not (isEmpty operator) =
          if set (peek operator) >= set x
          then helper xs (push (peek operator) operand) (x:pop operator)
          else helper xs operand (x:operator)
      | otherwise = helper xs operand operator
    set :: Char -> Int
    set chr = case chr of
      '+' -> 1
      '-' -> 1
      '*' -> 2
      '/' -> 2
      '^' -> 3
      _   -> 0

main :: IO ()
main = do
 let expr = "A+B-C*D+E/F^G"
 print $ infixToPostfix expr

当我尝试将表达式

A+B-C*D+E/F^G

转换为后缀表示法时，程序给出的输出类似于

AB+CD*EFG^/+-

。但实际正确的输出是

AB+CD*-EFG^/+

。我的算法有什么问题吗？

Answer 1

我找到了解决方案。

push :: Char -> [Char] -> [Char]
push x [] = [x]
push x xs = reverse (x:(reverse xs))

pop :: [Char] -> [Char]
pop [] = []
pop (x:xs) = xs

peek :: [Char] -> Char
peek (x:_) = x

isEmpty :: [Char] -> Bool
isEmpty [] = True
isEmpty _  = False

delimit :: [Char] -> Bool
delimit [] = True
delimit copy = matching copy []
 where
 matching :: [Char] -> [Char] -> Bool
 matching [] ret = isEmpty ret
 matching (x:xs) ret
  | elem x "(" = matching xs (push x ret)
  | elem x ")" = matching xs (pop ret)
  | otherwise = matching xs ret

isParenthesis :: Char -> Bool
isParenthesis chr = elem chr "()"
isOperand :: Char -> Bool
isOperand chr = elem chr ['A'..'Z'] || elem chr ['a'..'z']
isOperator :: Char -> Bool
isOperator chr = elem chr "+-*/^"

infixToPostfix :: [Char] -> [Char]
infixToPostfix expr = helper expr [] []
  where
    helper :: [Char] -> [Char] -> [Char] -> [Char]
    helper [] operand operator = operand ++ operator
    helper copy@(x:xs) operand operator
      | delimit copy == False = error "Delimiter not matched."
      | isParenthesis x = helper xs operand operator
      | isOperand x = helper xs (push x operand) operator
      | isOperator x && isEmpty operator = helper xs operand (x:operator)
      | isOperator x && not (isEmpty operator) =
          if precedence x == precedence (peek operator)
          then helper xs (push (peek operator) operand) (x:pop operator)
          else if precedence x < precedence (peek operator)
          then extractAll xs operand operator x
          else if precedence x > precedence (peek operator)
          then helper xs operand (x:operator)
          else helper xs operand operator
      | otherwise = helper xs operand operator
    precedence :: Char -> Int
    precedence chr = case chr of
      '+' -> 1
      '-' -> 1
      '*' -> 2
      '/' -> 2
      '^' -> 3
      _   -> 0
    extractAll :: [Char] -> [Char] -> [Char] -> Char -> [Char]
    extractAll xs operand operator x = extractAll' xs operand operator x (length operator)
      where
        extractAll' :: [Char] -> [Char] -> [Char] -> Char -> Int -> [Char]
        extractAll' xs operand [] x 0 = helper xs operand [x]
        extractAll' xs operand (y:ys) x len = extractAll' xs (push y operand) ys x (len-1)

main :: IO ()
main = do
 let expr0 = "A+B-C*D+E/F*E+G/A"
     expr1 = "A^B^C*D+E-F/E^G^A+C-D"
     expr2 = "A*B+C-D+A^B^C-D/A"
 print $ infixToPostfix expr0
 print $ infixToPostfix expr1
 print $ infixToPostfix expr2