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

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

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

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

1	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

1	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]

1	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

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

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

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)

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)

Responder

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]

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]

Responder

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

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

Responder

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

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

Responder

Números de la suerte

Soluciones

4 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Se puede imprimir o compartir con

4 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico