import Number
import Data.Char
import Data.List
replace ::[Int] -> Int -> Integer -> Integer
replace ms d n = read.map intToDigit$[f k|k<-[..length ns -1]]
where ns = map digitToInt.show $n
f k |elem k ms = d
|otherwise = ns!!k
choose  _  = [[]]
choose _ [] = []
choose (n+1) (x:xs) = [x:ys|ys<-choose n xs]++choose (n+1) xs
count = maximum.map length.group.sort.(show::Integer->String)
family n =[[replace ms d n|d<-ds ms]|ms<-mms]
where len = length.show$n
mms = concat[choose k [..len-1]|k<-[1..len-1],k<=count n]
ds ms |elem  ms =[1..9]
|otherwise =[..9]
p051 n = any ((==n).length.filter isPrime).family
main = print.find (p051 8).takeWhile(<1000000).dropWhile(<100000)$primes

範囲が限定されているのは事前調査から。ちょっとせこいといえば、せこい。