blob: e3d8aef8549ba8698699105648464e269f65c601 (
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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
module Expr where
import Data.List
data Atom
= Rational Float
| Imaginary Float
| Matrix [[Expr]]
data Expr
= EAtom Atom
| Add Expr Expr
| Sub Expr Expr
| Mul Expr Expr
| Div Expr Expr
| Mod Expr Expr
| Exp Expr Expr
| Dot Expr Expr
| Variable String
| Function String Expr
eval :: Expr -> Maybe Atom
eval (EAtom a) = Just a
eval (Add e1 e2) = evalInfix e1 e2 (+?)
eval (Sub e1 e2) = evalInfix e1 e2 (-?)
eval (Mul e1 e2) = evalInfix e1 e2 (*?)
eval (Div e1 e2) = evalInfix e1 e2 (/?)
eval (Mod e1 e2) = evalInfix e1 e2 (%?)
eval (Exp e1 e2) = evalInfix e1 e2 (^?)
eval (Dot e1 e2) = evalInfix e1 e2 (**?)
eval _ = Nothing
evalInfix :: Expr -> Expr -> (Atom -> Atom -> Maybe Atom) -> Maybe Atom
evalInfix e1 e2 f = do a <- eval e1
b <- eval e2
f a b
infixl 6 +?
(+?) :: Atom -> Atom -> Maybe Atom
(Rational a) +? (Rational b) = Just $ Rational (a + b)
(Imaginary a) +? (Imaginary b) = Just $ Imaginary (a + b)
_ +? _ = Nothing
infixl 6 -?
(-?) :: Atom -> Atom -> Maybe Atom
(Rational a) -? (Rational b) = Just $ Rational (a - b)
(Imaginary a) -? (Imaginary b) = Just $ Imaginary (a - b)
_ -? _ = Nothing
infixl 7 *?
(*?) :: Atom -> Atom -> Maybe Atom
(Rational a) *? (Rational b) = Just $ Rational (a * b)
(Rational a) *? (Imaginary b) = Just $ Imaginary (a * b)
(Imaginary a) *? (Imaginary b) = (Imaginary (a * b)) ^? Rational 2
_ *? _ = Nothing
infixl 7 /?
(/?) :: Atom -> Atom -> Maybe Atom
_ /? (Rational 0) = Nothing
(Rational a) /? (Rational b) = Just $ Rational (a / b)
_ /? _ = Nothing
infixl 7 %?
(%?) :: Atom -> Atom -> Maybe Atom
_ %? _ = Nothing
infixr 8 ^?
(^?) :: Atom -> Atom -> Maybe Atom
(Rational a) ^? (Rational b) = Just $ Rational (a ** b)
(Imaginary a) ^? (Rational 0) = Just $ Rational a
(Imaginary a) ^? (Rational 1) = Just $ Imaginary a
(Imaginary a) ^? (Rational 2) = Just $ Rational (-a)
(Imaginary a) ^? (Rational 3) = Just $ Imaginary (-a)
(Imaginary a) ^? (Rational b) = Imaginary a ^? (Rational (b - 4))
_ ^? _ = Nothing
infixr 8 **?
(**?) :: Atom -> Atom -> Maybe Atom
_ **? _ = Nothing
instance Show Expr where
show (EAtom a) = show a
show (Add e1 e2) = show e1 ++ " + " ++ show e2
show (Sub e1 e2) = show e1 ++ " - " ++ show e2
show (Mul e1 e2) = show e1 ++ " * " ++ show e2
show (Div e1 e2) = show e1 ++ " / " ++ show e2
show (Mod e1 e2) = show e1 ++ " % " ++ show e2
show (Exp e1 e2) = show e1 ++ " ^ " ++ show e2
show (Dot e1 e2) = show e1 ++ " ** " ++ show e2
show (Variable name) = name
show (Function name e) = name ++ "(" ++ show e ++ ")"
instance Show Atom where
show (Rational r) = show r
show (Imaginary i) = show i ++ "i"
show (Matrix m) = intercalate "\n" (map showRow m)
where showRow r = "[ " ++ intercalate ", " (map show r) ++ " ]"
|
