blob: a0d33ef5edfc4d08ff7a50f29c479a21dc3fa9fb (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
import Control.Monad (join, sequence)
import System.Environment (getArgs)
import qualified Control.Monad.State as S
data Symbol a = Number a a | Err | Add | Sub | Mult | Div | Unc deriving (Eq, Ord, Show)
instance Floating a => Num (Symbol a) where
(Number x del) + (Number y del') = Number (x + y) (abs $ gMean [del, del'])
_ + _ = Err
(Number x del) * (Number y del') = Number (x * y) (abs $ (x * y) * (gMean [del / x, del' / y]))
_ * _ = Err
negate (Number x del) = Number (negate x) del
negate _ = Err
abs (Number x del) = Number (abs x) del
abs _ = Err
signum (Number x del) = Number (signum x) 0
signum _ = Err
fromInteger i = Number (fromInteger i) 0
instance Floating a => Fractional (Symbol a) where
recip (Number x del) = Number (recip x) (abs $ (recip x) * (del / x))
recip _ = Err
fromRational x = Number (fromRational x) 0
dropUnc :: Floating a => Symbol a -> a
dropUnc (Number x _) = x
dropUnc _ = 0
gMean :: Floating a => [a] -> a
gMean xs = sqrt $ foldl1 (+) $ map (\x -> x * x) xs
fromSymbol :: Floating a => Symbol a -> (a, a)
fromSymbol (Number x d) = (x, d)
fromSymbol _ = (0, 0)
main :: IO ()
main = do
(mode:stdin:_) <- getArgs
let symbols = map interpreteSymbol $ join $ map words . lines $ stdin
result = evalExpVec symbols
case mode of
"n" -> putStrLn . show . fst $ fromSymbol result
"e" -> putStrLn . show . snd $ fromSymbol result
interpreteSymbol :: String -> Symbol Double
interpreteSymbol "+" = Add
interpreteSymbol "-" = Sub
interpreteSymbol "*" = Mult
interpreteSymbol "/" = Div
interpreteSymbol "±" = Unc
interpreteSymbol x = Number (read x) 0
evalExpVec :: Floating a => [Symbol a] -> Symbol a
evalExpVec is = head . snd $ S.runState (evalExpVec' is) []
evalExpVec' :: Floating a => [Symbol a] -> S.State [Symbol a] ()
evalExpVec' is = do
sequence $ map evalExp is
return ()
evalExp :: Floating a => Symbol a -> S.State [Symbol a] ()
evalExp (Number x del) = do
state <- S.get
S.put $ ((Number x del):state)
evalExp Unc = do
state <- S.get
S.put $ ((Number (dropUnc (state !! 1)) (dropUnc (state !! 0))):drop 2 state)
evalExp Add = do
state <- S.get
S.put $ ((foldl1 (+) $ take 2 state):drop 2 state)
evalExp Sub = do
state <- S.get
S.put $ ((foldl1 (-) . reverse $ take 2 state):drop 2 state)
evalExp Mult = do
state <- S.get
S.put $ ((foldl1 (*) $ take 2 state):drop 2 state)
evalExp Div = do
state <- S.get
S.put $ ((foldl1 (/) . reverse $ take 2 state):drop 2 state)
|
