Project Euler 47

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

順に素因数分解すれば答えは出る。

is_prime n = all (\p -> mod n p /= 0) (takeWhile (\p -> p * p <= n) primes)
primes = 2:(filter is_prime [3,5..])
div_pow n p | mod n p /= 0 = (n, 0)
            | otherwise    = (\(n, e) -> (n, e + 1)) (div_pow (div n p) p)
factorize 1 ps = []
factorize n (p:ps)
        | p * p > n = [(n,1)]
        | otherwise = if e > 0 then [(p, e)] ++ f else f where
                                            f = factorize m ps
                                            (m, e) = div_pow n p
fact n = factorize n primes

num_primes = map (length . fact) [1..]
a = (1,0):[ (n + 1, if num_p == 4 then m + 1 else 0) |
            (num_p,(n,m)) <- zip (tail num_primes) a ]
main = print((fst (head (filter (\(_,num_p) -> num_p == 4) a))) - 3)

4つの素数から成る整数を生成してそこから題意を満たす解を得る方法は無いだろうか。しかし、昇順に並べて生成するのは難しい。最大を決めて生成することはできるので、生成したらソートすることにする。そして、最大を倍々にする。

import Data.List

is_prime n = all (\p -> mod n p /= 0) (takeWhile (\p -> p * p <= n) primes)
primes = 2:(filter is_prime [3,5..])

pows p = scanl (\x y -> x * p) p [1..]
composites n limit (p:ps)
    | limit < p^n = []
    | n == 1      = (takeWhile (<= limit) (pows p)) ++ (composites n limit ps)
    | otherwise   = (concat (map f (takeWhile (\q -> p * q < limit) (pows p))))
                                                    ++ (composites n limit ps)
            where
                f :: Int -> [Int]
                f q = map (* q) (composites (n - 1) (div limit q) ps)

succesive n [] m = 0
succesive n [x] m = if n == m then x - n + 1 else 0
succesive n (x:y:xs) m | n == m     = x - n + 1
                       | x == y - 1 = succesive n (y:xs) (m + 1)
                       | otherwise  = succesive n (y:xs) 1

n = 4
solve = head (filter (>0) (map f (pows 2))) where
        f m = succesive n (sort (composites n m primes)) 1
main = print solve