Problem 200

200 Find the 200th prime-proof sqube containing the contiguous sub-string "200"
Problem 200 - Project Euler
2、5が含まれていれば、prime-proofだということはすぐに分かる。
つまり、prime-proofの十分条件。気になるのは必要条件だが…
ちょっと調べてみると（狭い範囲では）、2、5以外にprime-proofはでてこない。
ということで、必要十分条件なんだろうと勝手に仮定して解いた。

import Number (primes,isPrime')
import Data.List (isInfixOf)

sqube25 :: [Integer]
sqube25 = foldl1 merge.zipWith map [s 2,s 5,`s` 2,`s` 5] .repeat.drop 3 $ primes
    where s p q = p^2*q^3

merge :: Ord a => [a] -> [a] -> [a]
merge xs@(x:xt) ys@(y:yt) = case compare x y of
    LT -> x : merge xt ys
    EQ -> x : merge xt yt
    GT -> y : merge xs yt

primeProof :: Integer -> Bool
primeProof x = all (not.isPrime'.read) [change i d (show x) | i <- [1..length.show $ x], d <- ['0'..'9']]
    where change i d xs = let (a,b) = splitAt i xs
                          in init a ++ d:b

p200 :: Int -> Integer
p200 (n+2) = (!!n).filter primeProof.filter contain200 $ sqube25
    where contain200 = isInfixOf "200".show

main :: IO ()
main = print $ p200 200

とりあえず、答は正しいらしい。

追記

仮定は間違いだった。
105200812888979987 = 2011^2 * 2963^3
これが反例。
まぁ、ラッキーだった、ということで。

追記

ちゃんと、探すほうのコード。

import Number (primes, isPrime')
import Data.List (sort, delete, isInfixOf)

squbes :: Integer -> [Integer]
squbes u = do let u_q = floor.(**(1/3)).fromIntegral.div u $ 4
              q <- takeWhile (< u_q) primes
              let u_p = floor.sqrt.fromIntegral.div u $ q^3
              p <- takeWhile (< u_p).delete q $ primes
              return $ p*p*q*q*q

primeProof :: Integer -> Bool
primeProof x = all (not.isPrime'.read) [change i d (show x) | i <- [1..length.show $ x], d <- ['0'..'9']]
    where change i d xs = let (a,b) = splitAt i xs
                          in init a ++ d:b

p200 :: Int -> Int -> Integer
p200 (m+2) n = (!!m).sort.filter primeProof.filter contain200 $ squbes (10^n)
    where contain200 = isInfixOf "200".show

main :: IO ()
main = print $ p200 200 12