data E a =
N a
| AddList [E a]
| MulList [E a]
| Inv (E a){-
Here is the haskell program that I use to compute the results. To run it
you need ghc (Glasgow Haskell Compiler). You can modify the normalizer as
you want to further reduce semantically duplicated cases.
-}
data E a =
N a
| AddList [E a]
| MulList [E a]
| Inv (E a)
| Neg (E a)
-- deriving Show
add (AddList l1) e2 =
case e2 of
AddList l2 -> AddList (l1 ++ l2)
_ -> AddList(l1 ++ [e2])
add e1 (AddList l2) =
case e1 of
AddList l1 -> AddList (l1 ++ l2)
_ -> AddList ([e1] ++ l2)
add e1 e2 = AddList [e1, e2]
sub e1 e2 = add e1 (neg e2)
mul (MulList l1) e2 =
case e2 of
MulList l2 -> MulList (l1 ++ l2)
_ -> MulList(l1 ++ [e2])
mul e1 (MulList l2) =
case e1 of
MulList l1 -> MulList (l1 ++ l2)
_ -> MulList ([e1] ++ l2)
mul e1 e2 = MulList [e1, e2]
ddiv e1 e2 = mul e1 (inv e2)
neg (AddList l) = AddList [neg e | e
neg (Neg e) = e
neg e = Neg e
inv (MulList l) = MulList [inv e | e
inv (Inv e) = e
inv e = Inv e
norm (AddList l) = foldr add (AddList []) [norm e | e
norm (MulList l) = foldr mul (MulList []) [norm e | e
norm (Inv e) = inv (norm e)
norm (Neg e) = neg (norm e)
norm (N a) = N a
removeId (AddList l) = AddList [removeId e | e
removeId (MulList l) = MulList [removeId e | e
removeId e = e
flattern (AddList l) =
if length l == 0
then N 0
else let l1 = [flattern e | e
in foldr (flip add) (head l1) (tail l1)
flattern (MulList l) =
if length l == 0
then N 1
else let l1 = [flattern e | e
in foldr (flip mul) (head l1) (tail l1)
flattern e = e
eval (N x) = x
eval (AddList l) = sum [eval e | e
eval (MulList l) = mul [eval e | e
where mul l = foldr (*) 1 l
eval (Neg e) = - (eval e)
eval (Inv e) = 1 / (eval e)
instance (Num a, Show a) => Show (E a) where
show (N a) = show a
show (Neg e) = "-" ++ show e
show (Inv e) = "/" ++ show e
show (AddList l) = "(" ++ joinWith "+" [show e | e
show (MulList l) = "(" ++ joinWith "*" [show e | e
joinWith c [] = ""
joinWith c [x] = x
joinWith c (x:xs) =
let s = joinWith c xs in
if (head s == '-' || head s == '/')
then x ++ s
else x ++ c ++ s
instance Eq a => Eq (E a) where
(==) (N a) (N b) = a == b
(==) (AddList l1) (AddList l2) = l1 `listEq` l2
(==) (MulList l1) (MulList l2) = l1 `listEq` l2
(==) (Neg a) (Neg b) = a == b
(==) (Inv a) (Inv b) = a == b
(==) _ _ = False
listSub [] l2 = True
listSub (x:xs) l2 = elem x l2 && listSub xs l2
listEq l1 l2 = listSub l1 l2 && listSub l2 l1
remove x [] = []
remove x (y:ys) =
if x == y
then ys
else y : (remove x ys)
dedupe [] = []
dedupe (x:xs) = x: (remove x (dedupe xs))
find t [] = []
find t [e] = if t == eval e then [e] else []
find t l =
[s | x
y
z
s
]
f t l = dedupe [flattern $ removeId $ norm e | e
set =
let r = [1..10] in
[[a,b,c,d] | a
most cmax tup [] = tup
most cmax tup (x:xs) =
let tmax = length $ f 24 x in
if (cmax
then most tmax x xs
else most cmax tup xs
res = most 0 [0, 0, 0, 0] set
| Neg (E a)
-- deriving Show
add (AddList l1) e2 =
case e2 of
AddList l2 -> AddList (l1 ++ l2)
_ -> AddList(l1 ++ [e2])
add e1 (AddList l2) =
case e1 of
AddList l1 -> AddList (l1 ++ l2)
_ -> AddList ([e1] ++ l2)
add e1 e2 = AddList [e1, e2]
sub e1 e2 = add e1 (neg e2)
mul (MulList l1) e2 =
case e2 of
MulList l2 -> MulList (l1 ++ l2)
_ -> MulList(l1 ++ [e2])
mul e1 (MulList l2) =
case e1 of
MulList l1 -> MulList (l1 ++ l2)
_ -> MulList ([e1] ++ l2)
mul e1 e2 = MulList [e1, e2]
ddiv e1 e2 = mul e1 (inv e2)
neg (AddList l) = AddList [neg e | e
neg (Neg e) = e
neg e = Neg e
inv (MulList l) = MulList [inv e | e
inv (Inv e) = e
inv e = Inv e
norm (AddList l) = foldr add (AddList []) [norm e | e
norm (MulList l) = foldr mul (MulList []) [norm e | e
norm (Inv e) = inv (norm e)
norm (Neg e) = neg (norm e)
norm (N a) = N a
removeId (AddList l) = AddList [removeId e | e
removeId (MulList l) = MulList [removeId e | e
removeId e = e
flattern (AddList l) =
if length l == 0
then N 0
else let l1 = [flattern e | e
in foldr (flip add) (head l1) (tail l1)
flattern (MulList l) =
if length l == 0
then N 1
else let l1 = [flattern e | e
in foldr (flip mul) (head l1) (tail l1)
flattern e = e
eval (N x) = x
eval (AddList l) = sum [eval e | e
eval (MulList l) = mul [eval e | e
where mul l = foldr (*) 1 l
eval (Neg e) = - (eval e)
eval (Inv e) = 1 / (eval e)
instance (Num a, Show a) => Show (E a) where
show (N a) = show a
show (Neg e) = "-" ++ show e
show (Inv e) = "/" ++ show e
show (AddList l) = "(" ++ joinWith "+" [show e | e
show (MulList l) = "(" ++ joinWith "*" [show e | e
joinWith c [] = ""
joinWith c [x] = x
joinWith c (x:xs) =
let s = joinWith c xs in
if (head s == '-' || head s == '/')
then x ++ s
else x ++ c ++ s
instance Eq a => Eq (E a) where
(==) (N a) (N b) = a == b
(==) (AddList l1) (AddList l2) = l1 `listEq` l2
(==) (MulList l1) (MulList l2) = l1 `listEq` l2
(==) (Neg a) (Neg b) = a == b
(==) (Inv a) (Inv b) = a == b
(==) _ _ = False
listSub [] l2 = True
listSub (x:xs) l2 = elem x l2 && listSub xs l2
listEq l1 l2 = listSub l1 l2 && listSub l2 l1
remove x [] = []
remove x (y:ys) =
if x == y
then ys
else y : (remove x ys)
dedupe [] = []
dedupe (x:xs) = x: (remove x (dedupe xs))
find t [] = []
find t [e] = if t == eval e then [e] else []
find t l =
[s | x
y
z
s
]
f t l = dedupe [flattern $ removeId $ norm e | e
set =
let r = [1..10] in
[[a,b,c,d] | a
most cmax tup [] = tup
most cmax tup (x:xs) =
let tmax = length $ f 24 x in
if (cmax
then most tmax x xs
else most cmax tup xs
res = most 0 [0, 0, 0, 0] set