Menu Close

Números de la suerte

Un número de la suerte es un número natural que se genera por una criba, similar a la criba de Eratóstenes, como se indica a continuación:

Se comienza con la lista de los números enteros a partir de 1:

   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...

Se eliminan los números de dos en dos

   1,  3,  5,  7,  9,   11,   13,   15,   17,   19,   21,   23,   25...

Como el segundo número que ha quedado es 3, se eliminan los números
restantes de tres en tres:

   1,  3,      7,  9,         13,   15,         19,   21,         25...

Como el tercer número que ha quedado es 7, se eliminan los números restantes de
siete en siete:

   1,  3,      7,  9,         13,   15,               21,         25...

Este procedimiento se repite indefinidamente y los supervivientes son
los números de la suerte:

   1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79

Definir la sucesión

   numerosDeLaSuerte :: [Int]

cuyos elementos son los números de la suerte. Por ejemplo,

   λ> take 20 numerosDeLaSuerte
   [1,3,7,9,13,15,21,25,31,33,37,43,49,51,63,67,69,73,75,79]
   λ> numerosDeLaSuerte !! 1500
   13995

Soluciones

-- 1ª definición
numerosDeLaSuerte :: [Int]
numerosDeLaSuerte = criba 3 [1,3..]
  where
    criba i (n:s:xs) =
      n : criba (i + 1) (s : [x | (n, x) <- zip [i..] xs
                                , rem n s /= 0])
 
-- 2ª definición
numerosDeLaSuerte2 :: [Int]
numerosDeLaSuerte2 =  1 : criba 2 [1, 3..]
  where criba k xs = z : criba (k + 1) (aux xs)
          where z = xs !! (k - 1 )
                aux ws = us ++ aux vs
                  where (us, _:vs) = splitAt (z - 1) ws

4 soluciones de “Números de la suerte

  1. albcercid
    numerosDeLaSuerte :: [Int]
    numerosDeLaSuerte = 1 : auxE [3,5..] 2
       where auxE (x:xs) n = x : auxE [a | (a,b) <- zip xs [n+1..]
                                         , mod b x /= 0 ]
                                      (n+1)
  2. paumacpar
    numerosDeLaSuerte :: [Int]
    numerosDeLaSuerte = 1 : auxS 3 [1,3..]
      where auxS n ys = n : auxS t (filtrado n ys) 
              where t = head (dropWhile (<= n) (filtrado n ys))
     
    filtrado :: Int -> [Int] -> [Int]
    filtrado n zs = [x | (x, r) <- zip zs [1..]
                       , r `mod`n /= 0]
  3. josejuan

    Básicamente es la misma que la sugerida por @albcercid pero con algunas optimizaciones.

    numerosDeLaSuerte = 1: r [3,5..] 2
      where r (x:xs) n = x: r (q (n + 1) xs) (n + 1)
              where q i (y:ys) = if i == x then q 1 ys else y: q (i + 1) ys
     
    {-
    $ time -f "%E" ../numeros-de-la-suerte 1 12345
    145855
    0:33.01
    $ time -f "%E" ../numeros-de-la-suerte 2 12345
    145855
    0:12.78
    -}
  4. josejuan

    No he encontrado ninguna propiedad local que permite enumerar los números de la suerte (ni global para indexarlos), pero se acelera enormemente la enumeración calculando y refinando los deltas (por lo que saltamos rápidamente gran cantidad de números). Se calculan los primeros 247.902 números de la suerte en sólo 6 segundos.

    {-
     
      Se generan y van refinando los saltos según se añaden números de la suerte
     
        1: +2
        3: +2+4
        7: +2+4+2+4+2+6+4+2+4+2+4+6
        9: +2+4+2+4+2+6+4+6+2+4+6+2+4+2+4+8+4+2+4+2+4+6+2+6+4+2+6+4+2+4+2+10
        ...
     
      una vez alcanzado cierto límite prefijado (el ciclo crece muy rápidamente)
      ya no se expande el ciclo, sino que se va acortando, según se sigue refinando
      por la acción de nuevos números de la suerte generados.
     
      El proceso termina cuando ya no hay incrementos en el ciclo.
     
        9:   [2,6,4,6,2,4,6,2,4,2,4,8,4,2,4,2,4,6,2,6,4,2,6,4,2,4,2,10]
        13:  [6,4,6,2,4,6,6,2,4,8,4,2,4,2,4,6,2,6,6,6,4,2,4,2,10]
        15:  [4,6,2,4,6,6,2,12,4,2,4,2,4,6,2,6,6,6,4,2,4,12]
        ...
        99:  [6,4,12]
        105: [4,12]
        111: [12]
        115: []
     
      Se usa `Data.Sequence` para poder "cortar" los incrementos y soldarlos de
      forma eficiente.
     
    -}
    expandirCiclo :: Int ->Seq Int ->Seq Int
    expandirCiclo n xs = j $ Seq.cycleTaking (s * r) xs
      where s = Seq.length xs
            r = lcm s n `div` s
            j (viewl ->Seq.EmptyL) = Seq.empty
            j xs = let (as, bs) = Seq.splitAt (n - 2) xs
                   in  as >< ((bs `Seq.index` 0 + bs `Seq.index` 1) <| j (Seq.drop 2 bs))
     
    ajustarCiclo :: Int ->Int ->Seq Int ->Seq Int
    ajustarCiclo k n = g
      where g = d k
            j = d n
            d i xs = let (as, bs) = Seq.splitAt (i - 2) xs
                     in  if Seq.length bs < 2
                           then as
                           else as >< ((bs `Seq.index` 0 + bs `Seq.index` 1) <| j (Seq.drop 2 bs))
     
    expansiones :: Int ->[Int]
    expansiones = r 1 (Seq.fromList [2]) 0
      where r :: Int ->Seq Int ->Int ->Int ->[Int]
            r n xs i 0 = a n (Seq.drop i xs) i
            r n xs i z = n: r n' (expandirCiclo n' xs) (i + 1) (z - 1) where n' = n + Seq.index xs i
            a _ (viewl ->Seq.EmptyL) _   = []
            a n (viewl ->x :< xs) i = n: a n' (ajustarCiclo q n' xs) (i + 1)
                            where n' = n + x
                                  q  = n' - i - 1
     
    -- por ejemplo, sin compilar, obtiene los primeros 10.571 números de la
    -- suerte en unos 0,2 segundos.
    numerosDeLaSuerte = expansiones 7
     
    -- compilando, calcular los primeros 247.902 números de la suerte (siendo el último de ellos
    -- el número de la suerte 3.808.287) le toma sólo 6 segundos.
     
    -- Código completo en:
    -- https://gist.github.com/josejuan/3d095616cbc2912304183d43dc3636b9

Escribe tu solución

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.