回复:这个厉害,哈哈!

来源: 火球魔法 2009-10-04 15:35:52 [] [博客] [旧帖] [给我悄悄话] 本文已被阅读: 次 (7449 bytes)
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 <- l]
neg (Neg e) = e
neg e = Neg e

inv (MulList l) = MulList [inv e | e <- l]
inv (Inv e) = e
inv e = Inv e

norm (AddList l) = foldr add (AddList []) [norm e | e <- l]
norm (MulList l) = foldr mul (MulList []) [norm e | e <- l]
norm (Inv e) = inv (norm e)
norm (Neg e) = neg (norm e)
norm (N a) = N a

removeId (AddList l) = AddList [removeId e | e <- l, not (e == (N 0)), not (e == (Neg (N 0))) ]
removeId (MulList l) = MulList [removeId e | e <- l, not (e == (N 1.0)), not (e == (Inv (N 1.0))) ]
removeId e = e

flattern (AddList l) =
if length l == 0
then N 0
else let l1 = [flattern e | e <- l]
in foldr (flip add) (head l1) (tail l1)
flattern (MulList l) =
if length l == 0
then N 1
else let l1 = [flattern e | e <- l]
in foldr (flip mul) (head l1) (tail l1)
flattern e = e

eval (N x) = x
eval (AddList l) = sum [eval e | e <- l]
eval (MulList l) = mul [eval e | e <- l]
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 <- l] ++ ")"
show (MulList l) = "(" ++ joinWith "*" [show e | e <- l] ++ ")"

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 <- l,
y <- remove x l,
z <- [AddList [x, y], AddList [x, Neg y], MulList [x, y], MulList [x, Inv y]],
s <- find t (z: (remove y (remove x l)))
]

f t l = dedupe [flattern $ removeId $ norm e | e <- find t [N a | a <- l]]

set =
let r = [1..10] in
[[a,b,c,d] | a <- r, b <- r, c <- r, d <- r]

most cmax tup [] = tup
most cmax tup (x:xs) =
let tmax = length $ f 24 x in
if (cmax < tmax)
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 <- l]
neg (Neg e) = e
neg e = Neg e

inv (MulList l) = MulList [inv e | e <- l]
inv (Inv e) = e
inv e = Inv e

norm (AddList l) = foldr add (AddList []) [norm e | e <- l]
norm (MulList l) = foldr mul (MulList []) [norm e | e <- l]
norm (Inv e) = inv (norm e)
norm (Neg e) = neg (norm e)
norm (N a) = N a

removeId (AddList l) = AddList [removeId e | e <- l, not (e == (N 0)), not (e == (Neg (N 0))) ]
removeId (MulList l) = MulList [removeId e | e <- l, not (e == (N 1.0)), not (e == (Inv (N 1.0))) ]
removeId e = e

flattern (AddList l) =
if length l == 0
then N 0
else let l1 = [flattern e | e <- l]
in foldr (flip add) (head l1) (tail l1)
flattern (MulList l) =
if length l == 0
then N 1
else let l1 = [flattern e | e <- l]
in foldr (flip mul) (head l1) (tail l1)
flattern e = e

eval (N x) = x
eval (AddList l) = sum [eval e | e <- l]
eval (MulList l) = mul [eval e | e <- l]
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 <- l] ++ ")"
show (MulList l) = "(" ++ joinWith "*" [show e | e <- l] ++ ")"

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 <- l,
y <- remove x l,
z <- [AddList [x, y], AddList [x, Neg y], MulList [x, y], MulList [x, Inv y]],
s <- find t (z: (remove y (remove x l)))
]

f t l = dedupe [flattern $ removeId $ norm e | e <- find t [N a | a <- l]]

set =
let r = [1..10] in
[[a,b,c,d] | a <- r, b <- r, c <- r, d <- r]

most cmax tup [] = tup
most cmax tup (x:xs) =
let tmax = length $ f 24 x in
if (cmax < tmax)
then most tmax x xs
else most cmax tup xs

res = most 0 [0, 0, 0, 0] set
请您先登陆,再发跟帖!

发现Adblock插件

如要继续浏览
请支持本站 请务必在本站关闭Adblock

关闭Adblock后 请点击

请参考如何关闭Adblock

安装Adblock plus用户请点击浏览器图标
选择“Disable on www.wenxuecity.com”

安装Adblock用户请点击图标
选择“don't run on pages on this domain”