Project Euler Problem 051

import Data.Char
import Data.List
import Data.Maybe

primes :: [Integer]
primes = 2:f [3] [3,5..] where
  f (x:xs) ys = ps ++ f (xs++ps) [z | z<-qs,z`rem`x/=0] where
    (ps,qs) = span (< x*x) ys
isPrime :: Integer -> Bool
isPrime 1 = False
isPrime nn = imp nn primes where
  imp n (x:xs) = if x*x>n then True
                 else if rem n x==0 then False
                      else imp n xs      
sdigs :: [Integer]
sdigs = filter same $ dropWhile (<56003) primes where  
  same n = r /= nub r where
    r = show n
sames :: Integer -> String
sames n = imp (show n) [] where
  imp [] acc = acc
  imp (x:xs) acc = case elem x xs of
    True -> imp (filter (/=x) xs) (x:acc)
    False -> imp xs acc
--同じ数字を置き換えて作れる素数の個数をかえす    
--複数パターンがある場合はその最大値をかえす    
trial :: Integer -> Int
trial p =  
  count $ map (length.filter (\x -> isPrime x && (length $ show x)==(length $ show p))) r where
  count [] = 0
  count x = maximum x
  s2i n = foldl (\a x -> 10*a+x) 0 n
  sp = show p  
  fromlist = sames p
  tolist = map intToDigit [0..9]
  r = map (\from -> map (\to -> s2i $ map (fromIntegral.digitToInt) $ imp sp from to) tolist) fromlist
  --impは置き換えるだけ
  imp :: String -> Char -> Char -> String
  imp [] _ _ = []
  imp (x:xs) from to = if x==from then to:imp xs from to
                       else x:imp xs from to
ans1 :: Integer
ans1 = fromJust $ find ((==8).trial) primes
--121313
main :: IO ()
main = print ans1