Menu Close

Sucesión de Lichtenberg

La sucesión de Lichtenberg esta formada por la representación decimal de los números binarios de la sucesión de dígitos 0 y 1 alternados Los primeros términos de ambas sucesiones son

   Alternada ..... Lichtenberg
   0 ....................... 0
   1 ....................... 1
   10 ...................... 2
   101 ..................... 5
   1010 ................... 10
   10101 .................. 21
   101010 ................. 42
   1010101 ................ 85
   10101010 .............. 170
   101010101 ............. 341
   1010101010 ............ 682
   10101010101 .......... 1365
   101010101010 ......... 2730

Definir las funciones

   lichtenberg        :: [Integer]
   graficaLichtenberg :: Int -> IO ()

tales que

  • lichtenberg es la lista cuyos elementos son los términos de la sucesión de Lichtenberg. Por ejemplo,
     λ> take 17 lichtenberg
     [0,1,2,5,10,21,42,85,170,341,682,1365,2730,5461,10922,21845,43690]
  • (graficaLichtenberg n) dibuja la gráfica del número de dígitos de los n primeros términos de la sucesión de Lichtenberg. Por ejemlo, (graficaLichtenberg 100) dibuja
    Sucesion_de_Lichtenberg

Comprobar con QuickCheck que todos los términos de la sucesión de Lichtenberg, a partir del 4º, son números compuestos.

Soluciones

import Data.Char (digitToInt)
import Graphics.Gnuplot.Simple
import Test.QuickCheck
import Data.Numbers.Primes (isPrime)
 
-- 1ª solución
-- ===========
 
lichtenberg1 :: [Integer]
lichtenberg1 = map binarioAdecimal sucAlternada
 
-- sucAlternada es la lista cuyos elementos son los términos de la
-- sucesión de los dígitos 0 y 1 alternados. Por ejemplo,
--    λ> take 7 sucAlternada
--    ["0","1","10","101","1010","10101","101010"]
sucAlternada :: [String]
sucAlternada =
  ['0'] : [take n cadenaAlternada | n <- [1..]]
 
-- cadenaAltenada es la cadena formada alternando los caracteres 1 y
-- 0. Por ejemplo,
--    take 20 cadenaAlternada  ==  "10101010101010101010"
cadenaAlternada :: String
cadenaAlternada = cycle ['1','0']
 
-- (binarioAdecimal cs) es el número decimal correspondiente al número
-- binario cuya cadena de dígitos es cs. Por ejemplo,
--    binarioAdecimal "11101"  ==  29
binarioAdecimal :: String -> Integer
binarioAdecimal =
  foldl (\acc x -> acc * 2 + (toInteger . digitToInt) x) 0
 
-- 2ª solución
lichtenberg2 :: [Integer]
lichtenberg2 = map a [0..]
  where a 0 = 0
        a 1 = 1
        a n = a (n-1) + 2 * a (n-2) + 1
 
-- 3ª solución
lichtenberg3 :: [Integer]
lichtenberg3 =
  0 : 1 : map (+1) (zipWith (+) (tail lichtenberg3) (map (*2) lichtenberg3)) 
 
-- Comprobación de eficiencia
--    λ> length (show (lichtenberg1 !! 27))
--    8
--    (0.02 secs, 155,384 bytes)
--    λ> length (show (lichtenberg2 !! 27))
--    8
--    (2.22 secs, 311,157,760 bytes)
--    
--    λ> length (show (lichtenberg1 !! (8*10^4)))
--    24083
--    (1.28 secs, 664,207,040 bytes)
--    λ> length (show (lichtenberg3 !! (8*10^4)))
--    24083
--    (2.59 secs, 1,253,328,200 bytes)
 
-- La propiedad es
propLichtenberg :: Int -> Property
propLichtenberg n =
  n > 4 ==> not (isPrime (lichtenberg1 !! n))
 
-- La comprobación es
--    λ> quickCheck propLichtenberg
--    +++ OK, passed 100 tests.
 
graficaLichtenberg :: Int -> IO ()
graficaLichtenberg n =
  plotList [ Key Nothing
           , Title "Numero de digitos de la sucesion de Lichtenberg"
           , PNG "Sucesion_de_Lichtenberg.png"
           ]
           (take n (map (length . show) lichtenberg1))

9 soluciones de “Sucesión de Lichtenberg

  1. alerodrod5
    import Data.List
    import Graphics.Gnuplot.Simple
    import Test.QuickCheck
    import Data.Numbers.Primes
     
    lichtenberg :: [Integer]
    lichtenberg = map bin2dec2 sucAlternada
     
    sucAlternada :: [Integer]
    sucAlternada = iterate aux 0
      where aux x | last xs == 0 = numero (xs ++ [1])
                  | otherwise    = numero (xs ++ [0])
              where xs = cifras x
     
    cifras :: Integer -> [Integer]
    cifras  x = [read [d] | d <- show x]
     
    numero :: [Integer] -> Integer
    numero xs = sum [x*10^y | (x,y) <- zip xs [length xs-1, length xs-2..0]]
     
    bin2dec :: Integral a => [a] -> a 
    bin2dec [] = 0 
    bin2dec xs = 1 * (last xs) + 2 * bin2dec (init xs)
     
    bin2dec2 :: Integer -> Integer
    bin2dec2 x = bin2dec (cifras x)
     
    graficaLichtenberg :: Int -> IO ()
    graficaLichtenberg x =
      plotList [ Key Nothing
               , Title "Numero de digitos de la sucesion de Lichtenberg"]
               (take x digitoslichtenberg)
     
    digitoslichtenberg :: [Integer]
    digitoslichtenberg = map (genericLength . cifras) lichtenberg
     
    propiedad :: Integer -> Property
    propiedad x =
      x >= 10 && x `elem` (takeWhile (<=x) lichtenberg) ==>
      (not . isPrime) x
  2. albcarcas1
     
    import Graphics.Gnuplot.Simple
    import Test.QuickCheck
    import Data.Numbers.Primes
     
    lichtenberg :: [Integer]
    lichtenberg = [aux (cifras x) | x <- sucAlternada]
      where aux xs |even(length xs) = 2*(bin2int xs)
                   |otherwise = bin2int xs
    bin2int :: [Integer] -> Integer
    bin2int = foldr (x y -> x + 2*y) 0
     
    graficaLichtenberg :: Int -> IO ()
    graficaLichtenberg n = plotList [Title "Numero de digitos de la sucesion de Lichtneberg", Key Nothing](take n (map length(map cifras lichtenberg)))
     
    propiedad :: Integer -> Property
    propiedad n = n >= 10 && elem n (takeWhile (<= n) lichtenberg) ==> not(isPrime n)
  3. pabhueacu
    lichtenberg :: [Integer]
    lichtenberg = 0 : map f (zip lichtenberg [1..])
      where f (x,y) | even y    = 2*x
                    | otherwise = 2*x+1
  4. agumaragu1

    Una definición de la sucesión por recursión

    import Graphics.Gnuplot.Simple
    import Test.QuickCheck
    import Data.Numbers.Primes
     
    lichtenberg :: [Integer]
    lichtenberg = 0 : 1 : zipWith (+) [2^n | n <- [1..]] lichtenberg
     
    graficaLichtenberg :: Int -> IO ()
    graficaLichtenberg n = plotList [] (map cifras (take n lichtenberg))
      where cifras :: Integer -> Integer
            cifras x = succ $ floor $ log (fromInteger x) / log 10
     
    propiedad :: Integer -> Bool
    propiedad n = all (not . isPrime) (drop 4 $ takeWhile (<=n) lichtenberg)
  5. jaibengue
    lichtenberg :: [Integer]
    lichtenberg = aux 0
      where aux x = [s, t] ++ aux t
              where s = 2*x
                    t = 2*s+1
  6. jorcatote
    import Data.Numbers.Primes
    import Graphics.Gnuplot.Simple
    import Test.QuickCheck
     
    alternada :: [Integer]
    alternada = 1:0:alternada
     
    bin2dec xs = sum [2^n*x | (x,n) <- zip (reverse xs) [0..]]
     
    lichtenberg :: [Integer]
    lichtenberg = 0:map bin2dec [take n alternada | n <- [1..]]
     
    cifras:: Integer -> Integer
    cifras n = head [x | x <- [1..], 10^x >n]
     
    graficaLichtenberg n = plotList
             [Key Nothing, Title "Numero de digitos de la sucesion de Lichtenberg"]
             (map cifras (take n lichtenberg))
     
    prop_compuesto n = all (not.isPrime) (drop 4 (takeWhile (<=n) lichtenberg))
  7. carbremor
    import Graphics.Gnuplot.Simple
    import Data.Numbers.Primes
    import Test.QuickCheck
     
    -- Primera forma, basándonos en el ejercicio del 24 de enero de 2018, goo.gl/f5BXMt
     
    lichtenberg :: [Integer]
    lichtenberg = map (bintodec) sucAlternada
     
    -- Convierte los números de base binaria a decimal
     
    bintodec :: Integer -> Integer
    bintodec 0 = 0
    bintodec i = 2 * bintodec (div i 10) + (mod i 10)
     
    -- Por ejemplo,
    -- bintodec 100010101 == 277
     
    sucesion :: Integer -> Integer
    sucesion 1 = 0
    sucesion 2 = 1
    sucesion 3 = 10
    sucesion n = 10*sucesion(n-1) + sucesion(n-2) - 10*sucesion(n-3)
     
     
    sucAlternada :: [Integer]
    sucAlternada = [sucesion n | n <- [1..]]
     
    -- Segunda forma
     
    lichtenberg1 :: [Integer]
    lichtenberg1 = [ceiling(2*(2^n-1)/3) | n <- [0..]]
     
    -- Tercera forma
     
    termino_lichtenberg2 0 = 0
    termino_lichtenberg2 1 = 1
    termino_lichtenberg2 2 = 2
    termino_lichtenberg2 n = 2*termino_lichtenberg2(n-1) + termino_lichtenberg2(n-2) -2*termino_lichtenberg2(n-3)
     
    lichtenberg2 :: [Integer]
    lichtenberg2 = [termino_lichtenberg2 n | n <- [0..]]
     
    -- Comparación de eficiencia
    -- λ> lichtenberg !! 25
    -- 22369621
    -- (2.92 secs, 766,610,728 bytes)
    -- λ> lichtenberg1 !! 25
    -- 22369621
    -- (0.01 secs, 80,856 bytes)
    -- λ> lichtenberg2 !! 25
    -- 22369621
    -- (4.40 secs, 1,378,077,808 bytes)
    --
    -- Se aprecia, claramente, que la más eficiente es lichtenberg1
    --
    -- λ> length (show (lichtenberg1 !! (2*10^6)))
    -- 309
    -- (0.64 secs, 368,103,632 bytes)
    --
    -- Por ello, la utilizaremos para dibujar la gráfica del número de dígitos de los primeros términos
     
    graficaLichtenberg :: Int -> IO ()
    graficaLichtenberg n = plotList [Title "Numero de digitos de la sucesion de Lichtenberg" , Key Nothing] (map (length . digitos) (take n lichtenberg1))
     
    digitos :: Integer -> [Integer]
    digitos n = [read [d] | d <- show n]
     
    -- Comprobación de la propiedad
     
    propiedad :: Integer -> Bool
    propiedad n = all (not.isPrime) (drop 4 $ takeWhile (<=n) lichtenberg1)
  8. alvblamol
    lichtenberg        :: [Integer]
    lichtenberg = 0:[sig2 n | n<-lichtenberg]
    sig2 x | even x = 2*x +1
           | otherwise = 2*x

Escribe tu solución

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