summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xrpn.hs28
1 files changed, 18 insertions, 10 deletions
diff --git a/rpn.hs b/rpn.hs
index b441db4..d70c909 100755
--- a/rpn.hs
+++ b/rpn.hs
@@ -1,5 +1,7 @@
1#!/usr/bin/env runghc 1#!/usr/bin/env runghc
2 2
3{-# LANGUAGE ViewPatterns #-}
4
3import Control.Monad (join, sequence, forever) 5import Control.Monad (join, sequence, forever)
4import Control.Applicative 6import Control.Applicative
5import System.Environment 7import System.Environment
@@ -10,7 +12,7 @@ import qualified Control.Monad.State as S
10import qualified Data.Map as M 12import qualified Data.Map as M
11import System.IO 13import System.IO
12 14
13data Symbol a = Number a a | Err | Add | Sub | Mult | Div | Unc | Exp deriving (Eq, Ord, Show) 15data Symbol a = Number a a | Err | Add | Sub | Mult | Div | Unc | Exp | Pow deriving (Eq, Ord, Show)
14instance Floating a => Num (Symbol a) where 16instance Floating a => Num (Symbol a) where
15 (Number x del) + (Number y del') = Number (x + y) (abs $ gMean [del, del']) 17 (Number x del) + (Number y del') = Number (x + y) (abs $ gMean [del, del'])
16 _ + _ = Err 18 _ + _ = Err
@@ -42,7 +44,7 @@ fromSymbol _ = (0, 0)
42 44
43 45
44pPrint :: (Show a, Fractional a) => Symbol a -> String 46pPrint :: (Show a, Fractional a) => Symbol a -> String
45pPrint (Number x d) = (show x) ++ " ± " ++ (show d) ++ " (relative error: " ++ (show $ d / x) ++ ")" 47pPrint (Number x d) = x `seq` d `seq` (show x) ++ " ± " ++ (show d) ++ " (relative error: " ++ (show $ d / x) ++ ")"
46pPrint s = show s 48pPrint s = show s
47 49
48main :: IO () 50main :: IO ()
@@ -71,7 +73,7 @@ clarifySymbol s = maybe clarify' (return . words) =<< lookupEnv s
71 73
72isKnownSymbol :: String -> Bool 74isKnownSymbol :: String -> Bool
73isKnownSymbol s = or [ 75isKnownSymbol s = or [
74 s `elem` ["+", "-", "*", "/", "±", "+-", "e"], 76 s `elem` ["+", "-", "*", "/", "±", "+-", "e", "^"],
75 isJust $ (maybeRead s :: Maybe Double) 77 isJust $ (maybeRead s :: Maybe Double)
76 ] 78 ]
77 79
@@ -91,17 +93,18 @@ interpreteSymbol "/" = Div
91interpreteSymbol "±" = Unc 93interpreteSymbol "±" = Unc
92interpreteSymbol "+-" = Unc 94interpreteSymbol "+-" = Unc
93interpreteSymbol "e" = Exp 95interpreteSymbol "e" = Exp
96interpreteSymbol "^" = Pow
94interpreteSymbol x = Number (read x) 0 97interpreteSymbol x = Number (read x) 0
95 98
96evalExpVec :: Floating a => [Symbol a] -> Symbol a 99evalExpVec :: (Floating a, RealFrac a, Eq a) => [Symbol a] -> Symbol a
97evalExpVec is = head . snd $ S.runState (evalExpVec' is) [] 100evalExpVec is = head . snd $ S.runState (evalExpVec' is) []
98 101
99evalExpVec' :: Floating a => [Symbol a] -> S.State [Symbol a] () 102evalExpVec' :: (Floating a, RealFrac a, Eq a) => [Symbol a] -> S.State [Symbol a] ()
100evalExpVec' is = do 103evalExpVec' is = do
101 sequence $ map evalExp is 104 sequence $ map evalExp is
102 return () 105 return ()
103 106
104evalExp :: Floating a => Symbol a -> S.State [Symbol a] () 107evalExp :: (Floating a, RealFrac a, Eq a) => Symbol a -> S.State [Symbol a] ()
105evalExp (Number x del) = do 108evalExp (Number x del) = do
106 state <- S.get 109 state <- S.get
107 S.put $ ((Number x del):state) 110 S.put $ ((Number x del):state)
@@ -121,8 +124,13 @@ evalExp Div = do
121 state <- S.get 124 state <- S.get
122 S.put $ ((foldl1 (/) . reverse $ take 2 state):drop 2 state) 125 S.put $ ((foldl1 (/) . reverse $ take 2 state):drop 2 state)
123evalExp Exp = do 126evalExp Exp = do
124 state <- S.get 127 (e:b:state) <- S.get
128 S.put $ (b * (Number (10 ** (fst $ fromSymbol e)) 0)):state
129evalExp Pow = do
130 ((Number b'@(round -> b) 0):(Number y dY):(Number a'@(round -> a) 0):(Number x dX):state) <- S.get
125 let 131 let
126 b = state !! 1 132 prod = (x^^a) * (y^^b)
127 e = state !! 0 133 dX' = dX / x
128 S.put $ ((b * (Number (10 ** (fst $ fromSymbol e)) 0)):drop 2 state) 134 dY' = dY / y
135 err = prod * (sqrt $ (a' * dX')^2 + (b' * dY')^2)
136 S.put $ (Number prod err):state