Primos hereditarios

4 Comentarios

1. Haskell

   import Data.Numbers.Primes (isPrime) hereditarios :: [Integer] hereditarios = [x | x <- [1..], hereditario x] where hereditario x = derecha x && izquierda x derecha :: Integer -> Bool derecha 0 = True derecha x = isPrime x && derecha (x `div` 10) izquierda :: Integer -> Bool izquierda x = all isPrime [x `mod` 10^i | i <- [1..l]] where l = length (show x)

   1 2 3 4 5 6 7 8 9 10 11 12 13

   import Data.Numbers.Primes (isPrime)   hereditarios :: [Integer] hereditarios = [x | x <- [1..], hereditario x]    where hereditario x = derecha x && izquierda x derecha :: Integer -> Bool derecha 0 = True derecha x = isPrime x && derecha (x `div` 10) izquierda :: Integer -> Bool izquierda x = all isPrime [x `mod` 10^i | i <- [1..l]]     where l = length (show x)

   Responder

   1. La búsqueda se puede reducir a los números primos, pues es una condición necesaria para que sea hereditario:

      Haskell

      hereditarios :: [Integer] hereditarios = [x | x <- primes, hereditario x] where hereditario x = derecha x && izquierda x

      1 2 3

      hereditarios :: [Integer] hereditarios = [x | x <- primes, hereditario x]     where hereditario x = derecha x && izquierda x

      Responder

2. Haskell

   import Data.Numbers.Primes hereditarios :: [Integer] hereditarios = [p | p <- primes, hereditario (show p)] where hereditario xs = and [aux a && aux b | n <- [1..length xs - 1], let (a,b) = splitAt n xs] aux = isPrime . read

   1 2 3 4 5 6 7

   import Data.Numbers.Primes   hereditarios :: [Integer] hereditarios = [p | p <- primes, hereditario (show p)]     where hereditario xs = and [aux a && aux b | n <- [1..length xs - 1],                                                  let (a,b) = splitAt n xs]           aux = isPrime . read

   Responder

3. Aunque algo elaborado puede hacerse exponencialmente más rápido que la solución trivial.
   Generamos desde la izquierda el árbol con podas hasta la mitad de dígitos.
   Generamos desde la derecha el árbol con podas hasta la mitad de dígitos.
   Vamos fusionando ambos árboles podando combinaciones que no encajan.
   Por A024785, no existirá ningún hereditario de más de 24 dígitos (¿existe alguna cota inferior?).
   Así, obtenerlos todos (sin saber que son 15) toma unos 95 mS y tomar los 15 unos 48 mS.

   Haskell

   import Data.Maybe import Data.Numbers.Primes import System.Environment type Digit = Integer type Power10 = Integer -- Primos crecientes por la derecha data AD = AD Digit [AD] deriving Show -- sin llegar nunca a la izquierda del todo (en que habría que incluir todos los dígitos primos) generateAD :: Int -> [AD] generateAD = gen [AD d [] | d <- [3,7]] where gen ad 1 = ad gen ad n = gen (extendADsto [1,3,7,9] ad) (n - 1) extendADto :: Digit -> [AD] -> Maybe AD extendADto d = restrictADto 0 . AD d extendADsto :: [Digit] -> [AD] -> [AD] extendADsto ds ad = catMaybes [extendADto d ad | d <- ds] restrictADto :: Integer -> AD -> Maybe AD restrictADto z h@(AD d []) = if isPrime (10 * z + d) then Just h else Nothing restrictADto z (AD d ad) = case restrictADsto (10 * z + d) ad of [] -> Nothing ad_ -> Just $ AD d ad_ restrictADsto :: Integer -> [AD] -> [AD] restrictADsto z = catMaybes . map (restrictADto z) -- Primos crecientes por la izquierda data AI = AI Digit [AI] deriving Show -- sin llegar nunca a la derecha del todo (en que habría que excluir al 9) generateAI :: Int -> [AI] generateAI = gen [AI d [] | d <- [2,3,5,7]] where gen ad 1 = ad gen ad n = gen (extendAIsto [1,3,7,9] ad) (n - 1) extendAIto :: Digit -> [AI] -> Maybe AI extendAIto d = restrictAIto (0, 1) . AI d extendAIsto :: [Digit] -> [AI] -> [AI] extendAIsto ds ai = catMaybes [extendAIto d ai | d <- ds] restrictAIto :: (Integer, Power10) -> AI -> Maybe AI restrictAIto (z, p10) h@(AI d []) = if isPrime (p10 * d + z) then Just h else Nothing restrictAIto (z, p10) (AI d ai) = case restrictAIsto (p10 * d + z, 10 * p10) ai of [] -> Nothing ai_ -> Just $ AI d ai_ restrictAIsto :: (Integer, Power10) -> [AI] -> [AI] restrictAIsto zp = catMaybes . map (restrictAIto zp) -- Fusión central data Fus = Fus [AI] (Integer, Power10) [AD] deriving Show simplify :: Fus -> [Fus] simplify (Fus ai zp ad) = catMaybes [fuss zp i d | i <- ai, d <- ad] fuss :: (Integer, Power10) -> AI -> AD -> Maybe Fus fuss (z, p10) aii@(AI di (_:_)) add@(AD dd (_:_)) = case (restrictAIto (10 * z + dd, 10 * p10) aii, restrictADto w add) of (Just (AI _ ai_), Just (AD _ ad_)) -> Just $ Fus ai_ (10 * w + dd, 100 * p10) ad_ _ -> Nothing where w = p10 * di + z fuss _ _ _ = error "Final step must be computed through `simplifyHer`" -- Reduce el último paso y generar los hereditarios que queden simplifyHer :: Fus -> [Integer] simplifyHer (Fus aii zp add) = catMaybes [fussHer zp i d | i <- aii, d <- add] fussHer (z, p10) aii@(AI di []) add@(AD dd []) = let p = (p10 * di + z) * 10 + dd in if isPrime p then Just p else Nothing fussHer _ _ _ = error "Invalid argument. Must be a final step." -- Reducir hasta último paso y generar los hereditarios que queden solve :: [Fus] -> [Integer] solve [] = [] solve xs@((Fus ((AI _ []):_) _ ((AD _ []):_)):_) = concatMap simplifyHer xs solve ((Fus ((AI _ []):_) _ _):_) = [] -- sin solución solve ((Fus _ _ ((AD _ []):_)):_) = [] -- sin solución solve xs = solve $ concatMap simplify xs -- Dados dos árboles (AI y AD) expande el cancidato con dígitos pares e impares (el pares + 1) solveN :: Int -> [Integer] solveN n = let aii = generateAI n add = generateAD n in solve ((Fus aii (0, 1) add): [ Fus aii_ zp add_ | d <- [1,3,7,9] , let zp = (d, 10) aii_ = restrictAIsto zp aii add_ = restrictADsto d add , not (null aii_) , not (null add_) ]) -- no hace falta revisar más de 24 dígitos porque: -- A024785: Last term is a(4260) = 357686312646216567629137 (Angell and Godwin) hereditarios :: [Integer] hereditarios = [2,3,5,7] ++ concatMap solveN [1..12] main = do (n:_) <- getArgs >>= return . map read print $ take n hereditarios {- josejuan@haskell /cygdrive/d/Projects/haskell $ time ./hereditarios.exe 15 [2,3,5,7,23,37,53,73,313,317,373,797,3137,3797,739397] real 0m0.048s user 0m0.000s sys 0m0.015s josejuan@haskell /cygdrive/d/Projects/haskell $ time ./hereditarios.exe 150 [2,3,5,7,23,37,53,73,313,317,373,797,3137,3797,739397] real 0m0.092s user 0m0.000s sys 0m0.015s -}

   1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126

   import Data.Maybe import Data.Numbers.Primes import System.Environment   type Digit   = Integer type Power10 = Integer   -- Primos crecientes por la derecha data AD = AD Digit [AD] deriving Show   -- sin llegar nunca a la izquierda del todo (en que habría que incluir todos los dígitos primos) generateAD :: Int -> [AD] generateAD = gen [AD d [] | d <- [3,7]]     where gen ad 1 = ad           gen ad n = gen (extendADsto [1,3,7,9] ad) (n - 1)   extendADto :: Digit -> [AD] -> Maybe AD extendADto d = restrictADto 0 . AD d   extendADsto :: [Digit] -> [AD] -> [AD] extendADsto ds ad = catMaybes [extendADto d ad | d <- ds]   restrictADto :: Integer -> AD -> Maybe AD restrictADto z h@(AD d []) = if isPrime (10 * z + d) then Just h else Nothing restrictADto z   (AD d ad) = case restrictADsto (10 * z + d) ad of                                 []  -> Nothing                                 ad_ -> Just $ AD d ad_   restrictADsto :: Integer -> [AD] -> [AD] restrictADsto z = catMaybes . map (restrictADto z)   -- Primos crecientes por la izquierda data AI = AI Digit [AI] deriving Show   -- sin llegar nunca a la derecha del todo (en que habría que excluir al 9) generateAI :: Int -> [AI] generateAI = gen [AI d [] | d <- [2,3,5,7]]     where gen ad 1 = ad           gen ad n = gen (extendAIsto [1,3,7,9] ad) (n - 1)   extendAIto :: Digit -> [AI] -> Maybe AI extendAIto d = restrictAIto (0, 1) . AI d   extendAIsto :: [Digit] -> [AI] -> [AI] extendAIsto ds ai = catMaybes [extendAIto d ai | d <- ds]   restrictAIto :: (Integer, Power10) -> AI -> Maybe AI restrictAIto (z, p10) h@(AI d []) = if isPrime (p10 * d + z) then Just h else Nothing restrictAIto (z, p10)   (AI d ai) = case restrictAIsto (p10 * d + z, 10 * p10) ai of                                         []  -> Nothing                                         ai_ -> Just $ AI d ai_   restrictAIsto :: (Integer, Power10) -> [AI] -> [AI] restrictAIsto zp = catMaybes . map (restrictAIto zp)   -- Fusión central data Fus = Fus [AI] (Integer, Power10) [AD] deriving Show   simplify :: Fus -> [Fus] simplify (Fus ai zp ad) = catMaybes [fuss zp i d | i <- ai, d <- ad]   fuss :: (Integer, Power10) -> AI -> AD -> Maybe Fus fuss (z, p10) aii@(AI di (_:_)) add@(AD dd (_:_)) =     case (restrictAIto (10 * z + dd, 10 * p10) aii, restrictADto w add) of         (Just (AI _ ai_), Just (AD _ ad_)) -> Just $ Fus ai_ (10 * w + dd, 100 * p10) ad_         _                                  -> Nothing     where w = p10 * di + z fuss _ _ _ = error "Final step must be computed through `simplifyHer`"   -- Reduce el último paso y generar los hereditarios que queden simplifyHer :: Fus -> [Integer] simplifyHer (Fus aii zp add) = catMaybes [fussHer zp i d | i <- aii, d <- add]   fussHer (z, p10) aii@(AI di []) add@(AD dd []) = let p = (p10 * di + z) * 10 + dd                                                  in if isPrime p then Just p else Nothing fussHer _ _ _ = error "Invalid argument. Must be a final step."   -- Reducir hasta último paso y generar los hereditarios que queden solve :: [Fus] -> [Integer] solve [] = [] solve xs@((Fus ((AI _ []):_) _ ((AD _ []):_)):_) = concatMap simplifyHer xs solve ((Fus ((AI _ []):_) _ _):_) = [] -- sin solución solve ((Fus _ _ ((AD _ []):_)):_) = [] -- sin solución solve xs = solve $ concatMap simplify xs   -- Dados dos árboles (AI y AD) expande el cancidato con dígitos pares e impares (el pares + 1) solveN :: Int -> [Integer] solveN n = let aii = generateAI n                add = generateAD n            in  solve ((Fus aii (0, 1) add): [ Fus aii_ zp add_                                                 | d <- [1,3,7,9]                                                 , let zp = (d, 10)                                                       aii_ = restrictAIsto zp aii                                                       add_ = restrictADsto  d add                                                 , not (null aii_)                                                 , not (null add_)                                                 ])   -- no hace falta revisar más de 24 dígitos porque: -- A024785: Last term is a(4260) = 357686312646216567629137 (Angell and Godwin) hereditarios :: [Integer] hereditarios = [2,3,5,7] ++ concatMap solveN [1..12]   main = do     (n:_) <- getArgs >>= return . map read     print $ take n hereditarios   {-   josejuan@haskell /cygdrive/d/Projects/haskell $ time ./hereditarios.exe 15 [2,3,5,7,23,37,53,73,313,317,373,797,3137,3797,739397]   real    0m0.048s user    0m0.000s sys     0m0.015s   josejuan@haskell /cygdrive/d/Projects/haskell $ time ./hereditarios.exe 150 [2,3,5,7,23,37,53,73,313,317,373,797,3137,3797,739397]   real    0m0.092s user    0m0.000s sys     0m0.015s   -}

   Responder