回複:這個厲害,哈哈!

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

請您先登陸,再發跟帖!