Menu Close

Sucesión de Lichtenberg

José A. Alonso,

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))
Inicial
, , , , , , , , , , , , , , , , , , , ,

9 soluciones de “Sucesión de Lichtenberg”

  1. Responder
    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. Responder
    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. Responder
    pabhueacu 
    lichtenberg :: [Integer]
lichtenberg = 0 : map f (zip lichtenberg [1..])
  where f (x,y) | even y    = 2*x
                | otherwise = 2*x+1
  4. Responder
    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. Responder
    jaibengue 
    lichtenberg :: [Integer]
lichtenberg = aux 0
  where aux x = [s, t] ++ aux t
          where s = 2*x
                t = 2*s+1
  6. Responder
    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. Responder
    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. Responder
    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.