Project Euler (Problem ID 33..34)
ID33は、消去される数をcとして、特に問題無く完了。
ID34では、rangeOfDigitにより解の探索範囲を桁で絞っただけでは、計算時間が30秒を超えてしまった(正解は得られた)。
そこで、さらに枝刈りを追加(condOfNums)し、何とか計算時間を2秒に。
しかし、汚いコードになってしまった…
ID 33..34
prog033 = lowestTerm [pnums, pdenoms] where pnums = product $ map num $ curiousFracs pdenoms = product $ map denom $ curiousFracs curiousFracs = filter isCurious $ cnds cnds = [[c,n,d] | c <- [1..9], n <- [1..9], d <- [1..9], n < d, not (c == n && n == d)] lowestTerm [n,d] = [div n g, div d g] where g = gcd n d num [c,n,d] = n * 10 + c denom [c,n,d] = c * 10 + d isCurious [c,n,d] = lowestTerm (curiousFrac [c,n,d]) == lowestTerm [n,d] curiousFrac [c,n,d] = [num [c,n,d], denom [c,n,d]] frac n = product [1..n] theNum ns = foldl (\x y -> (10 * x) + y) 0 ns sumOfFrac [] = 0 sumOfFrac (n:ns) = frac n + sumOfFrac ns rangeOfDigit = takeWhile condOfDigit [2..] where condOfDigit d = minNum d <= maxSumOfFrac d minNum d = 10^(d - 1) maxSumOfFrac d = d * frac 9 nums nss d | length (head nss) == d = nss | mss == [] = [] | otherwise = nums (concatMap (genNums d) mss) d where mss = filter (condOfNums d) $ nss genNums d ns = [ns ++ [n] | n <- [0..9]] condOfNums d ns = theNum (ns0s d ns) <= sumOfFrac ns + (frac 9 * rest) where ns0s d ns = ns ++ take rest [0..] rest = d - length ns anss d = filter (\ns -> theNum ns == sumOfFrac ns) $ nums [[n] | n <- [1..9]] d prog034 = sum $ map theNum $ concatMap anss rangeOfDigit main = putStrLn $ show $ prog034