Project Euler Problem 093

import Data.List

komati :: [a] -> [a -> a -> a] -> [a]
komati (a:b:c:[d]) (o1:o2:[o3]) =
  [((a `o1` b) `o2` c) `o3` d]
  ++
  [(a `o1` (b `o2` c)) `o3` d]
  ++
  [a `o1` ((b `o2` c) `o3` d)]
  ++
  [a `o1` (b `o2` (c `o3` d))]
  ++
  [((a `o1` b) `o2` (c `o3` d))]

-- 順列  
perm :: Eq a => [a] -> [[a]]
perm [] = [[]]
perm l = [x:xs|x<-l,xs<-perm (l\\[x])]

-- 重複組み合わせ
hck :: (Eq a, Num a) => [a1] -> a -> [[a1]]
hck _ 0 = [[]]
hck [] _ = []
hck (x:xs) k = map (x:) (hck (x:xs) (k-1)) ++ hck xs k
ops :: [Double -> Double -> Double]
ops = [(+),(-),(*),(/)]
nums :: [[Double]]
nums = perm [1,2,3,4]
ops1 :: [[Double -> Double -> Double]]
ops1 = hck ops 3
ops2 :: [[Double -> Double -> Double]]
ops2 = [[a,b,c]|a<-ops,b<-ops,c<-ops]


test
  :: (Integral a, RealFrac a1) => [[a1]] -> [[a1 -> a1 -> a1]] -> a
test nums ops = consecutive $ map round $ nub $ sort $ filter (\x -> (x>0)&&isInt x) $ concat [komati num op| num <- nums,op <- ops]

isInt :: RealFrac a => a -> Bool
isInt x = floor x == ceiling x

sample :: Integer
sample = test nums ops1
sample2 :: Integer
sample2= test nums ops2

consecutive :: (Eq a, Num a) => [a] -> a
consecutive :: (Eq a, Num a) => [a] -> a
consecutive (1:x) = imp x 2
  where
    imp (x:xs) n | x == n = imp xs (n+1)
                 | x /= n = n-1
    imp [x] n | x == n = n
              | x /= n = n-1
    imp [] n = n-1
consecutive _ = 0

-- 6sec [1,2,5,8] 長さ51になる。ok
-- (51,1.0,2.0,5.0,8.0)
ans1imp :: (Integer, Double, Double, Double, Double)
ans1imp =  maximum [(u,a,b,c,d)|
                    a<-[0..9],
                    b<-[(a+1)..9],
                    c<-[(b+1)..9],
                    d<-[(c+1)..9],
                    let u=test (perm [a,b,c,d]) ops2]
ans1 :: Double
ans1 = let (_,a,b,c,d) = ans1imp in
  a*1000 + b*100+ c*10+d
-- 1258
main :: IO ()
main = print ans1