Created
June 11, 2009 23:40
-
-
Save chrisvest/128317 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Rpn | |
where | |
import qualified Data.Map as Map | |
data Operator a = Unary (a -> a) | |
| Binary (a -> a -> a) | |
| Ternary (a -> a -> a -> a) | |
| Quaternary (a -> a -> a -> a -> a) | |
| Reductive ([a] -> a) | |
| Projective ([a] -> [a]) | |
project f (x:xs) = map (f x) xs | |
calculate :: (Num a) => Operator a -> [a] -> [a] | |
calculate (Unary op) (a:ns) = (op a):ns | |
calculate (Binary op) (a:b:ns) = (a `op` b):ns | |
calculate (Ternary op) (a:b:c:ns) = (op a b c):ns | |
calculate (Quaternary op) (a:b:c:d:ns) = (op a b c d):ns | |
calculate (Reductive op) ns = [op ns] | |
calculate (Projective op) ns = op ns | |
pow a b = a ^^ (floor b) | |
applyOperator (x:xs) = calculate op xs | |
where op = (snd $ operatorList !! floor x) | |
operatorList :: [(String, Operator Double)] | |
operatorList = [ | |
("neg", Unary negate), | |
("abs", Unary abs), | |
("sig", Unary signum), | |
("recip", Unary recip), | |
("exp", Unary exp), | |
("sqrt", Unary sqrt), | |
("log", Unary log), | |
("log10", Unary (logBase 10)), | |
("+", Binary (+)), | |
("-", Binary (-)), | |
("*", Binary (*)), | |
("/", Binary (/)), | |
("max", Binary max), | |
("min", Binary min), | |
("^", Binary pow), | |
("sum", Reductive sum), | |
("product", Reductive product), | |
("+´", Projective (project (+))), | |
("-´", Projective (project (-))), | |
("*´", Projective (project (*))), | |
("/´", Projective (project (/))), | |
("max´", Projective (project max)), | |
("min´", Projective (project min)), | |
("^´", Projective (project pow)), | |
(">", Projective tail), | |
("><", Projective (\(x:y:ns) -> y:x:ns)), | |
("<", Projective (\(x:xs) -> x:x:xs)), | |
("<=>", Projective reverse), | |
("$", Projective applyOperator), | |
(".", Projective (\(x:y:ns) -> [y .. x] ++ ns)), | |
("..", Projective (\(x:y:z:ns) -> [y, z .. x] ++ ns)) | |
] | |
operators = Map.fromList operatorList | |
perform stack input = apply operator | |
where apply Nothing = (read input):stack | |
apply (Just op) = calculate op stack | |
operator = Map.lookup input operators | |
performRpn input = | |
show $ head $ foldl (perform) [] $ words input | |
main = interact (unlines . (map performRpn) . lines) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment