I’m learning the Haskell and I am trying to implement the very basic Shunting Yard algorithm to read the very basic mathematical expression. For example as like A+B-C*D.
Here is my current algorithm:
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
When I try to convert the expression A+B-C*D+E/F^G
to postfix notation, the program give the output as like AB+CD*EFG^/+-
. But the actual correct output is AB+CD*-EFG^/+
. What is wrong with my algorithm?
Take a look at your isOperator x && not (isEmpty operator)
case. What happens if there are two operators on the operator stack, both of which are higher precedence than the current operator?
I modified my code as follow and it well produce the correct output.
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