Problem 93

http://projecteuler.net/index.php?section=problems&id=93

とりあえず素直に全生成して、探索。

import Data.List
import Data.Ratio
perm [] = [[]]
perm xs@(_:_) =concat[map (h:)$perm(delete h xs)|h<-xs]
calc  fs xs = concatMap (calc' fs) . perm $ xs
calc' [f,g,h] [x,y,z,w] = [f (g x y) (h z w),f x(g y(h z w)),f x(g (h y z) w),
f (g (h x y) z) w,f (g x (h y z)) w]
possible ::[Rational]->[Integer]
possible ds = map numerator.filter posInt.sort.nub.concatMap (flip calc ds)$ops
where ops =[[f,g,h]|f<-op,g<-op,h<-op]
op = [(+),(-),(*),div']
div' x y | y ==  = -1
| y /=  = x/y
posInt x = x> && denominator x == 1
range = length.takeWhile((a,b)->a==b).zip [1..] .possible
main = print.reverse.map numerator.snd.maximum$[(range [a,b,c,d],[a,b,c,d])|a<-[1..9],b<-[1..a-1],c<-[1..b-1],d<-[1..c-1]]

コンビネーションぐらい作れよと。

import Data.List
import Data.Ratio
import Data.Ord
perm [] = [[]]
perm xs@(_:_) =concat[map (h:)$perm(delete h xs)|h<-xs]
calc  fs xs = concatMap (calc' fs) . perm $ xs
calc' [f,g,h] [x,y,z,w] = [f (g x y) (h z w),f x(g y(h z w)),f x(g (h y z) w),
f (g (h x y) z) w,f (g x (h y z)) w]
possible ::[Rational]->[Integer]
possible ds = map numerator.filter posInt.sort.nub.concatMap (flip calc ds)$ops
where ops =[[f,g,h]|f<-op,g<-op,h<-op]
op = [(+),(-),(*),div']
div' x y | y ==  = -1
| y /=  = x/y
posInt x = x> && denominator x == 1
range = length.takeWhile((a,b)->a==b).zip [1..] .possible
main = print.map numerator.maximumBy(comparing range)$[x|x<-comb [1..9] 4]
comb _  = [[]]
comb [] _ = []
comb (x:xs) (n+1) = map (x:) (comb xs n) ++ comb xs (n+1)

なぜか遅くなった。なぜ？違いはこう

main = print.reverse.map numerator.snd.maximum$[(range x,x)|x<-comb[1..9] 4]
main = print.map numerator.maximumBy(comparing range)$[x|x<-comb [1..9] 4]

rangeの計算回数が増えたのか？