zipWith

Suma de las sumas de los cuadrados de los divisores

PorJosé A. Alonso 7-marzo-201814-marzo-2018

La suma de las sumas de los cuadrados de los divisores de los 6 primeros números enteros positivos es

     1² + (1²+2²) + (1²+3²) + (1²+2²+4²) + (1²+5²) + (1²+2²+3²+6²)
   = 1  + 5       + 10      + 21         + 26      + 50
   = 113

1² + (1²+2²) + (1²+3²) + (1²+2²+4²) + (1²+5²) + (1²+2²+3²+6²)

= 1 + 5 + 10 + 21 + 26 + 50

= 113

Definir la función

   sumaSumasCuadradosDivisores :: Integer -> Integer

1	sumaSumasCuadradosDivisores :: Integer -> Integer

tal que (sumaSumasCuadradosDivisores n) es la suma de las sumas de los cuadrados de los divisores de los n primeros números enteros positivos. Por ejemplo,

   sumaSumasCuadradosDivisores 6       ==  113
   sumaSumasCuadradosDivisores (10^6)  ==  400686363385965077

1 2	sumaSumasCuadradosDivisores 6 == 113 sumaSumasCuadradosDivisores (10^6) == 400686363385965077

Soluciones

import Data.List (genericIndex)

-- 1ª solución
-- ===========

sumaSumasCuadradosDivisores :: Integer -> Integer
sumaSumasCuadradosDivisores n =
  sum [sumaCuadradosDivisores k | k <- [1..n]]

-- (sumaCuadradosDivisores n) es la suma de los cuadrados de los
-- divisores de n. Por ejemplo,
--    sumaCuadradosDivisores 6  ==  50
sumaCuadradosDivisores :: Integer -> Integer
sumaCuadradosDivisores n = sum (map (^2) (divisores n))

-- (divisores n) es la lista de los divisores de n. Por ejemplo, 
--    divisores 6  ==  [1,6,2,3]
divisores :: Integer -> [Integer]
divisores 1 = [1]
divisores n = 1 : n : [x | x <- [2..n `div` 2], n `mod` x == 0]

-- 2ª solución
-- ===========

sumaSumasCuadradosDivisores2 :: Integer -> Integer
sumaSumasCuadradosDivisores2 n =
  sumasSumasCuadradosDivisores `genericIndex` (n-1)

-- sumasSumasCuadradosDivisores es la sucesión cuyo n-ésimo término es
-- la suma de las sumas de los cuadrados de los divisores de n. Por
-- ejemplo, 
--    take 6 sumasSumasCuadradosDivisores  ==  [1,6,16,37,63,113]
sumasSumasCuadradosDivisores :: [Integer]
sumasSumasCuadradosDivisores = 1 : sig 1 2
  where sig m n = y : sig y (n+1)
          where y = m + sumaCuadradosDivisores n

-- 3ª solución
-- ===========

sumaSumasCuadradosDivisores3 :: Integer -> Integer
sumaSumasCuadradosDivisores3 n =
  last (sumasSumasCuadradosDivisores3 n)

-- (sumasSumasCuadradosDivisores3 n) es la sucesión cuyo k-ésimo término
-- es la suma de las sumas de los cuadrados de los divisores de k, para
-- k entre 0 y n. Por ejemplo, 
--    sumasSumasCuadradosDivisores3 6  ==  [0,6,18,36,52,77,113]
sumasSumasCuadradosDivisores3 :: Integer -> [Integer]
sumasSumasCuadradosDivisores3 n = scanl f 0 [1..n]
  where f x k = x + k^2 * (n `div` k)

-- 4ª solución
-- ===========

sumaSumasCuadradosDivisores4 :: Integer -> Integer
sumaSumasCuadradosDivisores4 n =
  last (sumasSumasCuadradosDivisores4 n)

-- (sumasSumasCuadradosDivisores4 n) es la sucesión cuyo k-ésimo término
-- es la suma de las sumas de los cuadrados de los divisores de k, para
-- k entre 0 y n. Por ejemplo, 
--    sumasSumasCuadradosDivisores4 6  ==  [0,6,18,36,52,77,113]
sumasSumasCuadradosDivisores4 :: Integer -> [Integer]
sumasSumasCuadradosDivisores4 n = scanl1 f [0,1..n]
  where f x k = x + k^2 * (n `div` k)

-- 5ª solución
-- ===========

sumaSumasCuadradosDivisores5 :: Integer -> Integer
sumaSumasCuadradosDivisores5 n =
  last (sumasSumasCuadradosDivisores5 n)

-- (sumasSumasCuadradosDivisores5 n) es la sucesión cuyo k-ésimo término
-- es la suma de las sumas de los cuadrados de los divisores de k, para
-- k entre 0 y n. Por ejemplo, 
--    sumasSumasCuadradosDivisores5 6  ==  [0,6,18,36,52,77,113]
sumasSumasCuadradosDivisores5 :: Integer -> [Integer]
sumasSumasCuadradosDivisores5 n = scanl1 f [0,1..n]
  where f x k = x + k * (n - (n `mod` k))

-- 6ª solución
-- ===========

-- Cada elemento k de [1..n], al cuadrado, aparece tantas veces como la
-- parte entera de n/k; luego,
--    sumaSumasCuadradosDivisores n =
--       1^2*n + 2^2*(n `div` 2) + 3^2*(n `div` 3) + ... + n^2*1

sumaSumasCuadradosDivisores6 :: Integer -> Integer
sumaSumasCuadradosDivisores6 n = sum (zipWith (*) ds vs)
  where ds = map (^2) [1..n]
        vs = [n `div` k | k <- [1..n]]

-- Comparación de eficiencia:
-- =========================

--    λ> sumaSumasCuadradosDivisores (3*10^3)
--    10825397502
--    (3.29 secs, 468,721,192 bytes)
--    λ> sumaSumasCuadradosDivisores2 (3*10^3)
--    10825397502
--    (3.25 secs, 469,462,600 bytes)
--    λ> sumaSumasCuadradosDivisores3 (3*10^3)
--    10825397502
--    (0.03 secs, 2,788,752 bytes)
--    λ> sumaSumasCuadradosDivisores4 (3*10^3)
--    10825397502
--    (0.03 secs, 2,813,304 bytes)
--    λ> sumaSumasCuadradosDivisores5 (3*10^3)
--    10825397502
--    (0.03 secs, 1,467,056 bytes)
--    λ> sumaSumasCuadradosDivisores6 (3*10^3)
--    10825397502
--    (0.03 secs, 3,291,664 bytes)
--    
--    λ> sumaSumasCuadradosDivisores3 (5*10^5)
--    50085873311988831
--    (2.34 secs, 440,961,640 bytes)
--    λ> sumaSumasCuadradosDivisores4 (5*10^5)
--    50085873311988831
--    (2.29 secs, 444,962,904 bytes)
--    λ> sumaSumasCuadradosDivisores5 (5*10^5)
--    50085873311988831
--    (1.23 secs, 220,960,152 bytes)
--    λ> sumaSumasCuadradosDivisores6 (5*10^5)
--    50085873311988831
--    (2.76 secs, 524,962,464 bytes)

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

127

128

129

import Data.List (genericIndex)

-- 1ª solución

-- ===========

sumaSumasCuadradosDivisores :: Integer -> Integer

sumaSumasCuadradosDivisores n =

sum [sumaCuadradosDivisores k | k <- [1..n]]

-- (sumaCuadradosDivisores n) es la suma de los cuadrados de los

-- divisores de n. Por ejemplo,

-- sumaCuadradosDivisores 6 == 50

sumaCuadradosDivisores :: Integer -> Integer

sumaCuadradosDivisores n = sum (map (^2) (divisores n))

-- (divisores n) es la lista de los divisores de n. Por ejemplo,

-- divisores 6 == [1,6,2,3]

divisores :: Integer -> [Integer]

divisores 1 = [1]

divisores n = 1 : n : [x | x <- [2..n `div` 2], n `mod` x == 0]

-- 2ª solución

-- ===========

sumaSumasCuadradosDivisores2 :: Integer -> Integer

sumaSumasCuadradosDivisores2 n =

sumasSumasCuadradosDivisores `genericIndex` (n-1)

-- sumasSumasCuadradosDivisores es la sucesión cuyo n-ésimo término es

-- la suma de las sumas de los cuadrados de los divisores de n. Por

-- ejemplo,

-- take 6 sumasSumasCuadradosDivisores == [1,6,16,37,63,113]

sumasSumasCuadradosDivisores :: [Integer]

sumasSumasCuadradosDivisores = 1 : sig 1 2

where sig m n = y : sig y (n+1)

where y = m + sumaCuadradosDivisores n

-- 3ª solución

-- ===========

sumaSumasCuadradosDivisores3 :: Integer -> Integer

sumaSumasCuadradosDivisores3 n =

last (sumasSumasCuadradosDivisores3 n)

-- (sumasSumasCuadradosDivisores3 n) es la sucesión cuyo k-ésimo término

-- es la suma de las sumas de los cuadrados de los divisores de k, para

-- k entre 0 y n. Por ejemplo,

-- sumasSumasCuadradosDivisores3 6 == [0,6,18,36,52,77,113]

sumasSumasCuadradosDivisores3 :: Integer -> [Integer]

sumasSumasCuadradosDivisores3 n = scanl f 0 [1..n]

where f x k = x + k^2 * (n `div` k)

-- 4ª solución

-- ===========

sumaSumasCuadradosDivisores4 :: Integer -> Integer

sumaSumasCuadradosDivisores4 n =

last (sumasSumasCuadradosDivisores4 n)

-- (sumasSumasCuadradosDivisores4 n) es la sucesión cuyo k-ésimo término

-- es la suma de las sumas de los cuadrados de los divisores de k, para

-- k entre 0 y n. Por ejemplo,

-- sumasSumasCuadradosDivisores4 6 == [0,6,18,36,52,77,113]

sumasSumasCuadradosDivisores4 :: Integer -> [Integer]

sumasSumasCuadradosDivisores4 n = scanl1 f [0,1..n]

where f x k = x + k^2 * (n `div` k)

-- 5ª solución

-- ===========

sumaSumasCuadradosDivisores5 :: Integer -> Integer

sumaSumasCuadradosDivisores5 n =

last (sumasSumasCuadradosDivisores5 n)

-- (sumasSumasCuadradosDivisores5 n) es la sucesión cuyo k-ésimo término

-- es la suma de las sumas de los cuadrados de los divisores de k, para

-- k entre 0 y n. Por ejemplo,

-- sumasSumasCuadradosDivisores5 6 == [0,6,18,36,52,77,113]

sumasSumasCuadradosDivisores5 :: Integer -> [Integer]

sumasSumasCuadradosDivisores5 n = scanl1 f [0,1..n]

where f x k = x + k * (n - (n `mod` k))

-- 6ª solución

-- ===========

-- Cada elemento k de [1..n], al cuadrado, aparece tantas veces como la

-- parte entera de n/k; luego,

-- sumaSumasCuadradosDivisores n =

-- 1^2*n + 2^2*(n `div` 2) + 3^2*(n `div` 3) + ... + n^2*1

sumaSumasCuadradosDivisores6 :: Integer -> Integer

sumaSumasCuadradosDivisores6 n = sum (zipWith (*) ds vs)

where ds = map (^2) [1..n]

vs = [n `div` k | k <- [1..n]]

-- Comparación de eficiencia:

-- =========================

-- λ> sumaSumasCuadradosDivisores (3*10^3)

-- 10825397502

-- (3.29 secs, 468,721,192 bytes)

-- λ> sumaSumasCuadradosDivisores2 (3*10^3)

-- 10825397502

-- (3.25 secs, 469,462,600 bytes)

-- λ> sumaSumasCuadradosDivisores3 (3*10^3)

-- 10825397502

-- (0.03 secs, 2,788,752 bytes)

-- λ> sumaSumasCuadradosDivisores4 (3*10^3)

-- 10825397502

-- (0.03 secs, 2,813,304 bytes)

-- λ> sumaSumasCuadradosDivisores5 (3*10^3)

-- 10825397502

-- (0.03 secs, 1,467,056 bytes)

-- λ> sumaSumasCuadradosDivisores6 (3*10^3)

-- 10825397502

-- (0.03 secs, 3,291,664 bytes)

-- λ> sumaSumasCuadradosDivisores3 (5*10^5)

-- 50085873311988831

-- (2.34 secs, 440,961,640 bytes)

-- λ> sumaSumasCuadradosDivisores4 (5*10^5)

-- 50085873311988831

-- (2.29 secs, 444,962,904 bytes)

-- λ> sumaSumasCuadradosDivisores5 (5*10^5)

-- 50085873311988831

-- (1.23 secs, 220,960,152 bytes)

-- λ> sumaSumasCuadradosDivisores6 (5*10^5)

-- 50085873311988831

-- (2.76 secs, 524,962,464 bytes)

Números que no son cuadrados

PorJosé A. Alonso 15-febrero-201822-febrero-2018

Definir las funciones

   noCuadrados :: [Integer]
   graficaNoCuadrados :: Integer -> IO ()

1 2	noCuadrados :: [Integer] graficaNoCuadrados :: Integer -> IO ()

tales que

noCuadrados es la lista de los números naturales que no son cuadrados. Por ejemplo,

     λ> take 25 noCuadrados
     [2,3,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,26,27,28,29,30]

1 2	λ> take 25 noCuadrados [2,3,5,6,7,8,10,11,12,13,14,15,17,18,19,20,21,22,23,24,26,27,28,29,30]

(graficaNoCuadrados n) dibuja las diferencias entre los n primeros elementos de noCuadrados y sus posiciones. Por ejemplo, (graficaNoCuadrados 300) dibuja

(graficaNoCuadrados 3000) dibuja

(graficaNoCuadrados 30000) dibuja

Comprobar con QuickCheck que el término de noCuadrados en la posición n-1 es (n + floor(1/2 + sqrt(n))).

Soluciones

import Data.List (genericIndex)
import Graphics.Gnuplot.Simple
import Test.QuickCheck

-- 1ª definición
-- =============

noCuadrados :: [Integer]
noCuadrados = aux [0..] cuadrados
  where aux xs (y:ys) = as ++ aux bs ys
          where (as,_:bs) = span (<y) xs

cuadrados :: [Integer]
cuadrados = [x^2 | x <- [0..]]

-- 2ª definición
-- =============

noCuadrados2 :: [Integer]
noCuadrados2 = aux 2 [1..]
  where aux n (_:xs) = ys ++ aux (n+2) zs
          where (ys,zs) = splitAt n xs

-- Definición de graficaNoCuadrados
-- ================================

graficaNoCuadrados :: Integer -> IO ()
graficaNoCuadrados n =
  plotList [ Key Nothing
           , PNG ("Numeros_que_no_son_cuadrados_" ++ show n ++ ".png")
           ]
           (zipWith (-) noCuadrados [0..n-1])

-- La propiedad es
prop_noCuadrados :: Positive Integer -> Bool
prop_noCuadrados (Positive n) =
  noCuadrados `genericIndex` (n-1) ==
  n + floor (1/2 + sqrt (fromIntegral n))

-- La comprobación es
--    λ> quickCheck prop_noCuadrados
--    +++ OK, passed 100 tests.

import Data.List (genericIndex)

import Graphics.Gnuplot.Simple

import Test.QuickCheck

-- 1ª definición

-- =============

noCuadrados :: [Integer]

noCuadrados = aux [0..] cuadrados

where aux xs (y:ys) = as ++ aux bs ys

where (as,_:bs) = span (<y) xs

cuadrados :: [Integer]

cuadrados = [x^2 | x <- [0..]]

-- 2ª definición

-- =============

noCuadrados2 :: [Integer]

noCuadrados2 = aux 2 [1..]

where aux n (_:xs) = ys ++ aux (n+2) zs

where (ys,zs) = splitAt n xs

-- Definición de graficaNoCuadrados

-- ================================

graficaNoCuadrados :: Integer -> IO ()

graficaNoCuadrados n =

plotList [ Key Nothing

, PNG ("Numeros_que_no_son_cuadrados_" ++ show n ++ ".png")

]

(zipWith (-) noCuadrados [0..n-1])

-- La propiedad es

prop_noCuadrados :: Positive Integer -> Bool

prop_noCuadrados (Positive n) =

noCuadrados `genericIndex` (n-1) ==

n + floor (1/2 + sqrt (fromIntegral n))

-- La comprobación es

-- λ> quickCheck prop_noCuadrados

-- +++ OK, passed 100 tests.

Períodos de Fibonacci

PorJosé A. Alonso 9-febrero-201819-febrero-2018

Los primeros términos de la sucesión de Fibonacci son

   0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610

1	0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610

Al calcular sus restos módulo 3 se obtiene

   0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1

1	0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1

Se observa que es periódica y su período es

   0,1,1,2,0,2,2,1

1	0,1,1,2,0,2,2,1

Definir las funciones

   fibsMod                   :: Integer -> [Integer]
   periodoFibMod             :: Integer -> [Integer]
   longPeriodosFibMod        :: [Int]
   graficaLongPeriodosFibMod :: Int -> IO ()

fibsMod :: Integer -> [Integer]

periodoFibMod :: Integer -> [Integer]

longPeriodosFibMod :: [Int]

graficaLongPeriodosFibMod :: Int -> IO ()

tales que

(fibsMod n) es la lista de los términos de la sucesión de Fibonacci módulo n. Por ejemplo,

     λ> take 24 (fibsMod 3)
     [0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1]
     λ> take 24 (fibsMod 4)
     [0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1]

λ> take 24 (fibsMod 3)

[0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1, 0,1,1,2,0,2,2,1]

λ> take 24 (fibsMod 4)

[0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1, 0,1,1,2,3,1]

(periodoFibMod n) es la parte perioica de la sucesión de Fibonacci módulo n. Por ejemplo,

     periodoFibMod 3  ==  [0,1,1,2,0,2,2,1]
     periodoFibMod 4  ==  [0,1,1,2,3,1]
     periodoFibMod 7  ==  [0,1,1,2,3,5,1,6,0,6,6,5,4,2,6,1]

periodoFibMod 3 == [0,1,1,2,0,2,2,1]

periodoFibMod 4 == [0,1,1,2,3,1]

periodoFibMod 7 == [0,1,1,2,3,5,1,6,0,6,6,5,4,2,6,1]

longPeriodosFibMod es la sucesión de las longitudes de los períodos de las sucesiones de Fibonacci módulo n, para n > 0. Por ejemplo,

     λ> take 20 longPeriodosFibMod
     [1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]

1 2	λ> take 20 longPeriodosFibMod [1,3,8,6,20,24,16,12,24,60,10,24,28,48,40,24,36,24,18,60]

(graficaLongPeriodosFibMod n) dibuja la gráfica de los n primeros términos de la sucesión longPeriodosFibMod. Por ejemplo, (graficaLongPeriodosFibMod n) dibuja

Soluciones

import Graphics.Gnuplot.Simple

fibsMod :: Integer -> [Integer]
fibsMod n = map (`mod` n) fibs

-- fibs es la sucesión de Fibonacci. Por ejemplo,
--    λ> take 20 fibs
--    [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

periodoFibMod :: Integer -> [Integer]
periodoFibMod 1 = [0]
periodoFibMod n = 0 : 1 : aux (drop 2 (fibsMod n))
  where aux (0:1:xs) = []
        aux (a:b:xs) = a : aux (b:xs)

longPeriodosFibMod :: [Int]
longPeriodosFibMod =
  [length (periodoFibMod n) | n <- [1..]]

-- 2ª definición de longPeriodosFibMod
-- ===================================

longPeriodosFibMod2 :: [Int]
longPeriodosFibMod2 = map longPeriodoFibMod [1..]

longPeriodoFibMod :: Integer -> Int
longPeriodoFibMod 1 = 1
longPeriodoFibMod n = aux 1 (tail (fibsMod n)) 0
  where aux 0 (1 : xs) k = k
        aux _ (x : xs) k = aux x xs (k + 1)

graficaLongPeriodosFibMod :: Int -> IO ()
graficaLongPeriodosFibMod n =
  plotList [ Key Nothing
           , Title ("graficaLongPeriodosFibMod " ++ show n)
           , PNG ("Periodos_de_Fibonacci " ++ show n ++ ".png")]
           (take n longPeriodosFibMod)

import Graphics.Gnuplot.Simple

fibsMod :: Integer -> [Integer]

fibsMod n = map (`mod` n) fibs

-- fibs es la sucesión de Fibonacci. Por ejemplo,

-- λ> take 20 fibs

-- [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]

fibs :: [Integer]

fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

periodoFibMod :: Integer -> [Integer]

periodoFibMod 1 = [0]

periodoFibMod n = 0 : 1 : aux (drop 2 (fibsMod n))

where aux (0:1:xs) = []

aux (a:b:xs) = a : aux (b:xs)

longPeriodosFibMod :: [Int]

longPeriodosFibMod =

[length (periodoFibMod n) | n <- [1..]]

-- 2ª definición de longPeriodosFibMod

-- ===================================

longPeriodosFibMod2 :: [Int]

longPeriodosFibMod2 = map longPeriodoFibMod [1..]

longPeriodoFibMod :: Integer -> Int

longPeriodoFibMod 1 = 1

longPeriodoFibMod n = aux 1 (tail (fibsMod n)) 0

where aux 0 (1 : xs) k = k

aux _ (x : xs) k = aux x xs (k + 1)

graficaLongPeriodosFibMod :: Int -> IO ()

graficaLongPeriodosFibMod n =

plotList [ Key Nothing

, Title ("graficaLongPeriodosFibMod " ++ show n)

, PNG ("Periodos_de_Fibonacci " ++ show n ++ ".png")]

(take n longPeriodosFibMod)

Sucesión de Lichtenberg

PorJosé A. Alonso 25-enero-20181-febrero-2018

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

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 ()

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

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

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

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

De hexadecimal a decimal

PorJosé A. Alonso 1-enero-201819-febrero-2018

El sistema hexadecimal es el sistema de numeración posicional que tiene como base el 16.

En principio, dado que el sistema usual de numeración es de base decimal y, por ello, sólo se dispone de diez dígitos, se adoptó la convención de usar las seis primeras letras del alfabeto latino para suplir los dígitos que nos faltan. El conjunto de símbolos es el siguiente: {0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F}. En ocasiones se emplean letras minúsculas en lugar de mayúsculas. Se debe notar que A = 10, B = 11, C = 12, D = 13, E = 14 y F = 15.

Como en cualquier sistema de numeración posicional, el valor numérico de cada dígito es alterado dependiendo de su posición en la cadena de dígitos, quedando multiplicado por una cierta potencia de la base del sistema, que en este caso es 16. Por ejemplo, el valor decimal del número hexadecimal 3E0A es

     3×16^3 + E×16^2 + 0×16^1 + A×16^0
   = 3×4096 + 14×256 + 0×16   + 10×1
   = 15882

3×16^3 + E×16^2 + 0×16^1 + A×16^0

= 3×4096 + 14×256 + 0×16 + 10×1

= 15882

Definir la función

   hexAdec :: String -> Int

1	hexAdec :: String -> Int

tal que (hexAdec cs) es el valor decimal del número hexadecimal representado meiante la cadena cs. Por ejemplo,

   hexAdec "3E0A"   == 15882
   hexAdec "ABCDEF" == 11259375
   hexAdec "FEDCBA" == 16702650

hexAdec "3E0A" == 15882

hexAdec "ABCDEF" == 11259375

hexAdec "FEDCBA" == 16702650

Soluciones

import Data.Char (digitToInt)
import Numeric(readHex)
import Data.List (foldl')

-- 1ª solución
hexAdec1 :: String -> Int
hexAdec1 s =
  sum (zipWith (*) (map digitToInt (reverse s)) (iterate (*16) 1))

-- 2ª solución
hexAdec2 :: String -> Int
hexAdec2 = foldl' (\acc x -> acc * 16 + digitToInt x) 0

-- 3ª solución
hexAdec3 :: String -> Int
hexAdec3 = read . ("0x" ++)

-- 4ª solución
hexAdec4 :: String -> Int
hexAdec4 = fst . head . readHex

import Data.Char (digitToInt)

import Numeric(readHex)

import Data.List (foldl')

-- 1ª solución

hexAdec1 :: String -> Int

hexAdec1 s =

sum (zipWith (*) (map digitToInt (reverse s)) (iterate (*16) 1))

-- 2ª solución

hexAdec2 :: String -> Int

hexAdec2 = foldl' (\acc x -> acc * 16 + digitToInt x) 0

-- 3ª solución

hexAdec3 :: String -> Int

hexAdec3 = read . ("0x" ++)

-- 4ª solución

hexAdec4 :: String -> Int

hexAdec4 = fst . head . readHex

Suma de las sumas de los cuadrados de los divisores

Soluciones

Números que no son cuadrados

Soluciones

Períodos de Fibonacci

Soluciones

Sucesión de Lichtenberg

Soluciones

De hexadecimal a decimal

Soluciones

Entradas recientes

Buscar

Correo electrónico