Project Euler (Problem ID 35..40)

ID35から40は、割とあっさり解けた。

実行時間が長いのはID35、ID37、ID39で、それぞれ約4秒、2秒、5秒。
Project Eulerの問題は全て30秒以内に解けるようにできているとのこと。
一応30秒以内には解けているけれども、ID35..40の出題時期は2003年なので、その当時のPCだと30秒を超えてしまうかもしれない。

ID 35..40

import Char
import List

isPrime n
	| n < 0 = False
	| n == 1 = False
	| otherwise = all (\p -> (rem n p) /= 0) ps
		where ps = takeWhile (\p -> p * p <= n) primes

primes = [2] ++ sieve [3,5..]
	where sieve (p:ns) = [p] ++ (sieve $ filter (\n -> rem n p /= 0) ns)

toInts n = toIntsWithRadix 10 n
theNum ns = foldl (\x y -> (10 * x) + y) 0 ns

toIntsWithRadix r n = toIntsRec r 1 n
	where toIntsRec r d n
		| r > n = [n]
		| otherwise = (toIntsRec r (d + 1) (div n r)) ++ [rem n r]

prog035 = length $ filter isCircularPrime $ map toInts [2..1000000]
	where
		isCircularPrime ns = all isPrime $ map theNum $ rotates ns
		rotates xs = map (rotate xs) [0..(length xs - 1)]
			where rotate xs n = (drop n xs) ++ (take n xs)

prog036 = sum $ filter palindromic2 $ filter palindromic10 $ [1,3..(1000 * 1000 -1)]
	where
		palindromic2 n = (==) (toBins n) (reverse $ toBins n)
		palindromic10 n = (==) (show n) (reverse $ show n)
		toBins n = toIntsWithRadix 2 n

prog037 = sum $ take 11 $ filter truncatablePrime [11,13..]
	where
		truncatablePrime n = all isPrime $ truncates n
		truncates n = map theNum $
			((truncsLeft $ toInts n) ++ (truncsRight $ toInts n))
		truncsLeft [] = []
		truncsLeft (n:ns) = [(n:ns)] ++ truncsLeft ns
		truncsRight ns = map reverse $ truncsLeft $ reverse ns

prog038 = head $ reverse $ sort $ map theNum $ filter pandigital $ concatMap concatProds [2..9]
	where
		concatProds n = takeWhile (\ns -> length ns <= 9) $ map (concatProd n) [1..]
		concatProd n m = concatMap toInts $ [(m * i) | i <- [1..n]]
		pandigital ns = (sort ns) == [1..9]

prog039 = elemIndex maxTriangles triangles
	where
		maxTriangles = maximum triangles
		triangles = map length $ map pythag [0..1000]
		pythag p = [(a,b,c) |
			c <- [(div (4 * p) 10)..(div p 2)],
			b <- [((div (p - c) 2) + 1)..(c - 1)],
			a <- [p - (b + c)],
			a^2 + b^2 == c^2]

prog040 = product $ map dn $ map ((^)10) [0..6]
	where
		dn n = theFraction !! (n - 1)
		theFraction = concatMap toInts [1..]

main = putStrLn $ show $ prog040