Problem 224

224 Almost right-angled triangles II
Problem 224 - Project Euler
今度はなる整数の組を探す．
前問とまったく同じアルゴリズム．

import Data.List (unfoldr, foldl')

trans :: (Num a) => [a] -> [a]
trans [a,b,c] = [ -a - 2*b + 2*c, -2*a - b + 2*c, -2*a - 2*b + 3*c]

next :: (Num a) => [a] -> [[a]]
next x@[a,b,c] | a == b    = map trans [ [-a, b, c], [-a, -b, c]]
               | otherwise = map trans [ [-a, b, c], [a, -b, c], [-a, -b, c]]

p224 :: Integer -> Integer
p224 l = foldl' count 0.unfoldr step $ [ [2,2,3] ]
    where step [] = Nothing
          step xs = Just (xs, filter feasible.concatMap next $ xs)
          feasible xs = sum xs <= l
          count c xs = c + toInteger (length xs)

main :: IO ()
main = print.p224 $ 75*10^6

アルゴリズムは同じで探索範囲はこちらのほうが広いが，解の数が約 1/10 なので，
計算時間も約 1/10 で，速かった．