Problem51 - Project Euler

30分プログラム、その326。Problem51 - Project Euler。

*57の第1桁を置き換えることで, 157, 257, 457, 557, 757, 857という6つの素数が得られる.
56**3の第3桁と第4桁を同じ数で置き換ることを考えよう. この5桁の数は7つの素数をもつ最初の例である: 56003, 56113, 56333, 56443, 56663, 56773, 56993. よって, この族の最初の数である56003は, このような性質を持つ最小の素数である.
桁を同じ数で置き換えることで8つの素数が得られる最小の素数を求めよ. (注:連続した桁でなくても良い)

例えば、*57を置き換えたやつは、全部差が100nになることを用いて計算しようとした。でも、繰り下りがあることを忘れていた。続きはまた明日。

使い方

# 3桁で、6つの素数が得られるやつの取得
Main> solveN 3 6

ソースコード

import Control.Monad.List
import Data.List

sieve (x:xs) = x:sieve [y | y <- xs, y `mod` x /= 0]

primes = sieve [2..]

splitInt :: Int -> [Int]
splitInt n = map (\x-> read [x]) $ show n

isTimes x y =
    x < y*10 && x `mod` y == 0

solve3 = do p <- primes3
            let first  = filter (\n -> isTimes (n - p) 100) primes3
            let second = filter (\n -> isTimes (n - p) 10)  primes3
            let third  = filter (\n -> isTimes (n - p) 1)   primes3
            guard $ (length first) == 6 || (length second) == 6 || (length third) == 6
            return p
    where primes3 = takeWhile (< 1000) $ dropWhile (<100) primes

perm [] = [[]]
perm xs = nub $ do x <- xs
                   ys <- perm $ delete x xs
                   return (x:ys)

primesN n = let min = 10^(n-1)
                max = 10^n
            in takeWhile (< max) $ dropWhile (<min) primes

makeInt xs = foldl1 (\x y->x*10+y) xs 

solveN n m = do p <- primes'
                repCount <- [1..n-1]
                mask <- map makeInt $ perm $ take n $ (replicate repCount 1)++[0,0..]
                let xs = filter (\n -> isTimes (n - p) mask) primes'
                guard $ length xs == m
                return (p,mask,xs)
    where primes' = primesN n

answer = head $ concatMap (\n -> solveN n 8) [2..]
main = print answer

参考

• 過去の30分プログラム
• Problem 51 - PukiWiki