iterate – Exercitium

Reconocimiento de potencias de 2

PorJosé A. Alonso 11-mayo-2022

Definir la función

   esPotenciaDeDos :: Integer -> Bool

1	esPotenciaDeDos :: Integer -> Bool

tal que (esPotenciaDeDos n) se verifica si n es una potencia de dos (suponiendo que n es mayor que 0). Por ejemplo.

   esPotenciaDeDos    1        == True
   esPotenciaDeDos    2        == True
   esPotenciaDeDos    6        == False
   esPotenciaDeDos    8        == True
   esPotenciaDeDos 1024        == True
   esPotenciaDeDos 1026        == False
   esPotenciaDeDos (2^(10^8))  == True

esPotenciaDeDos 1 == True

esPotenciaDeDos 2 == True

esPotenciaDeDos 6 == False

esPotenciaDeDos 8 == True

esPotenciaDeDos 1024 == True

esPotenciaDeDos 1026 == False

esPotenciaDeDos (2^(10^8)) == True

Soluciones

import Data.Bits ((.&.))
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck (Positive (Positive), quickCheck)

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

esPotenciaDeDos1 :: Integer -> Bool
esPotenciaDeDos1 1 = True
esPotenciaDeDos1 n
  | even n    = esPotenciaDeDos1 (n `div` 2)
  | otherwise = False

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

esPotenciaDeDos2 :: Integer -> Bool
esPotenciaDeDos2 n = n ==
  head (dropWhile (<n) potenciasDeDos)

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,
--    take 10 potenciasDeDos  == [1,2,4,8,16,32,64,128,256,512]
potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1

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

esPotenciaDeDos3 :: Integer -> Bool
esPotenciaDeDos3 x = all (==2) (primeFactors x)

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

-- Usando la función (.&.) de la librería Data.Bits. Dicha función
-- calcula el número correspondiente a la conjunción de las
-- representaciones binarias de sus argumentos. Por ejemplo,
--    6 .&. 3 == 2
-- ya que
--    la representación binaria de 6 es     [1,1,0]
--    la representación binaria de 3 es       [1,1]
--    la conjunción es                        [1,0]
--    la representación decimal de [1,0] es   2
--
-- Otros ejemplos:
--    4 .&. 3 ==   [1,0,0] .&.   [1,1] == 0
--    8 .&. 7 == [1,0,0,0] .&. [1,1,1] = 0

esPotenciaDeDos4 :: Integer -> Bool
esPotenciaDeDos4 n = n .&. (n-1) == 0

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_esPotenciaDeDos :: Positive Integer -> Bool
prop_esPotenciaDeDos (Positive n) =
  all (== esPotenciaDeDos1 n)
      [ esPotenciaDeDos2 n
      , esPotenciaDeDos3 n
      , esPotenciaDeDos4 n
      ]

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

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

-- La comparación es
--    λ> esPotenciaDeDos1 (2^(3*10^5))
--    True
--    (3.51 secs, 5,730,072,544 bytes)
--    λ> esPotenciaDeDos2 (2^(3*10^5))
--    True
--    (3.12 secs, 5,755,639,952 bytes)
--    λ> esPotenciaDeDos3 (2^(3*10^5))
--    True
--    (2.92 secs, 5,758,872,040 bytes)
--    λ> esPotenciaDeDos4 (2^(3*10^5))
--    True
--    (0.03 secs, 715,152 bytes)

import Data.Bits ((.&.))

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck (Positive (Positive), quickCheck)

-- 1ª solución

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

esPotenciaDeDos1 :: Integer -> Bool

esPotenciaDeDos1 1 = True

esPotenciaDeDos1 n

| even n = esPotenciaDeDos1 (n `div` 2)

| otherwise = False

-- 2ª solución

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

esPotenciaDeDos2 :: Integer -> Bool

esPotenciaDeDos2 n = n ==

head (dropWhile (<n) potenciasDeDos)

-- potenciasDeDos es la lista de las potencias de dos. Por ejemplo,

-- take 10 potenciasDeDos == [1,2,4,8,16,32,64,128,256,512]

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- 3ª solución

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

esPotenciaDeDos3 :: Integer -> Bool

esPotenciaDeDos3 x = all (==2) (primeFactors x)

-- 4ª solución

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

-- Usando la función (.&.) de la librería Data.Bits. Dicha función

-- calcula el número correspondiente a la conjunción de las

-- representaciones binarias de sus argumentos. Por ejemplo,

-- 6 .&. 3 == 2

-- ya que

-- la representación binaria de 6 es [1,1,0]

-- la representación binaria de 3 es [1,1]

-- la conjunción es [1,0]

-- la representación decimal de [1,0] es 2

-- Otros ejemplos:

-- 4 .&. 3 == [1,0,0] .&. [1,1] == 0

-- 8 .&. 7 == [1,0,0,0] .&. [1,1,1] = 0

esPotenciaDeDos4 :: Integer -> Bool

esPotenciaDeDos4 n = n .&. (n-1) == 0

-- Comprobación de equivalencia

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

-- La propiedad es

prop_esPotenciaDeDos :: Positive Integer -> Bool

prop_esPotenciaDeDos (Positive n) =

all (== esPotenciaDeDos1 n)

[ esPotenciaDeDos2 n

, esPotenciaDeDos3 n

, esPotenciaDeDos4 n

]

-- La comprobación es

-- λ> quickCheck prop_esPotenciaDeDos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esPotenciaDeDos1 (2^(3*10^5))

-- True

-- (3.51 secs, 5,730,072,544 bytes)

-- λ> esPotenciaDeDos2 (2^(3*10^5))

-- True

-- (3.12 secs, 5,755,639,952 bytes)

-- λ> esPotenciaDeDos3 (2^(3*10^5))

-- True

-- (2.92 secs, 5,758,872,040 bytes)

-- λ> esPotenciaDeDos4 (2^(3*10^5))

-- True

-- (0.03 secs, 715,152 bytes)

El código se encuentra en GitHub.

Números con todos sus dígitos primos

PorJosé A. Alonso 29-abril-20221-mayo-2022

Definir la lista

   numerosConDigitosPrimos :: [Integer]

1	numerosConDigitosPrimos :: [Integer]

cuyos elementos son los números con todos sus dígitos primos. Por ejemplo,

   λ> take 22 numerosConDigitosPrimos
   [2,3,5,7,22,23,25,27,32,33,35,37,52,53,55,57,72,73,75,77,222,223]
   λ> numerosConDigitosPrimos !! (10^7)
   322732232572

λ> take 22 numerosConDigitosPrimos

[2,3,5,7,22,23,25,27,32,33,35,37,52,53,55,57,72,73,75,77,222,223]

λ> numerosConDigitosPrimos !! (10^7)

322732232572

Soluciones

module Numeros_con_digitos_primos where

import Test.QuickCheck (NonNegative (NonNegative), quickCheck)
import Data.Char (intToDigit)

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

numerosConDigitosPrimos1 :: [Integer]
numerosConDigitosPrimos1 = [n | n <- [2..], digitosPrimos n]

-- (digitosPrimos n) se verifica si todos los dígitos de n son
-- primos. Por ejemplo,
--    digitosPrimos 352  ==  True
--    digitosPrimos 362  ==  False
digitosPrimos :: Integer -> Bool
digitosPrimos n = subconjunto (digitos n) [2,3,5,7]

-- (digitos n) es la lista de las digitos de n. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos n = [read [x] | x <- show n]

-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys. Por
-- ejemplo,
--    subconjunto [3,2,5,2] [2,7,3,5]  ==  True
--    subconjunto [3,2,5,2] [2,7,2,5]  ==  False
subconjunto :: Eq a => [a] -> [a] -> Bool
subconjunto xs ys = and [x `elem` ys | x <- xs]

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

numerosConDigitosPrimos2 :: [Integer]
numerosConDigitosPrimos2 =
  filter (all (`elem` "2357") . show) [2..]

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

--    λ> take 60 numerosConDigitosPrimos2
--    [  2,  3,  5,  7,
--      22, 23, 25, 27,
--      32, 33, 35, 37,
--      52, 53, 55, 57,
--      72, 73, 75, 77,
--     222,223,225,227,
--     232,233,235,237,
--     252,253,255,257,
--     272,273,275,277,
--     322,323,325,327,
--     332,333,335,337,
--     352,353,355,357,
--     372,373,375,377,
--     522,523,525,527,
--     532,533,535,537]

numerosConDigitosPrimos3 :: [Integer]
numerosConDigitosPrimos3 =
  [2,3,5,7] ++ [10*n+d | n <- numerosConDigitosPrimos3, d <- [2,3,5,7]]

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

--    λ> take 60 numerosConDigitosPrimos2
--    [ 2, 3, 5, 7,
--     22,23,25,27,
--     32,33,35,37,
--     52,53,55,57,
--     72,73,75,77,
--     222,223,225,227, 232,233,235,237, 252,253,255,257, 272,273,275,277,
--     322,323,325,327, 332,333,335,337, 352,353,355,357, 372,373,375,377,
--     522,523,525,527, 532,533,535,537]

numerosConDigitosPrimos4 :: [Integer]
numerosConDigitosPrimos4 = concat (iterate siguiente [2,3,5,7])

-- (siguiente xs) es la lista obtenida añadiendo delante de cada
-- elemento de xs los dígitos 2, 3, 5 y 7. Por ejemplo,
--    λ> siguiente [5,6,8]
--    [25,26,28,
--     35,36,38,
--     55,56,58,
--     75,76,78]
siguiente :: [Integer] -> [Integer]
siguiente xs = concat [map (pega d) xs | d <- [2,3,5,7]]

-- (pega d n) es el número obtenido añadiendo el dígito d delante del
-- número n. Por ejemplo,
--    pega 3 35  ==  335
pega :: Int -> Integer -> Integer
pega d n = read (intToDigit d : show n)

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_numerosConDigitosPrimos :: NonNegative Int -> Bool
prop_numerosConDigitosPrimos (NonNegative n) =
  all (== numerosConDigitosPrimos1 !! n)
      [ numerosConDigitosPrimos2 !! n
      , numerosConDigitosPrimos3 !! n
      , numerosConDigitosPrimos4 !! n
      ]

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

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

-- La comparación es
--    λ> numerosConDigitosPrimos1 !! 5000
--    752732
--    (2.45 secs, 6,066,926,272 bytes)
--    λ> numerosConDigitosPrimos2 !! 5000
--    752732
--    (0.34 secs, 387,603,456 bytes)
--    λ> numerosConDigitosPrimos3 !! 5000
--    752732
--    (0.01 secs, 1,437,624 bytes)
--    λ> numerosConDigitosPrimos4 !! 5000
--    752732
--    (0.00 secs, 1,556,104 bytes)
--
--    λ> numerosConDigitosPrimos3 !! (10^7)
--    322732232572
--    (3.94 secs, 1,820,533,328 bytes)
--    λ> numerosConDigitosPrimos4 !! (10^7)
--    322732232572
--    (1.84 secs, 2,000,606,640 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

130

131

132

module Numeros_con_digitos_primos where

import Test.QuickCheck (NonNegative (NonNegative), quickCheck)

import Data.Char (intToDigit)

-- 1ª solución

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

numerosConDigitosPrimos1 :: [Integer]

numerosConDigitosPrimos1 = [n | n <- [2..], digitosPrimos n]

-- (digitosPrimos n) se verifica si todos los dígitos de n son

-- primos. Por ejemplo,

-- digitosPrimos 352 == True

-- digitosPrimos 362 == False

digitosPrimos :: Integer -> Bool

digitosPrimos n = subconjunto (digitos n) [2,3,5,7]

-- (digitos n) es la lista de las digitos de n. Por ejemplo,

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Integer]

digitos n = [read [x] | x <- show n]

-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys. Por

-- ejemplo,

-- subconjunto [3,2,5,2] [2,7,3,5] == True

-- subconjunto [3,2,5,2] [2,7,2,5] == False

subconjunto :: Eq a => [a] -> [a] -> Bool

subconjunto xs ys = and [x `elem` ys | x <- xs]

-- 2ª solución

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

numerosConDigitosPrimos2 :: [Integer]

numerosConDigitosPrimos2 =

filter (all (`elem` "2357") . show) [2..]

-- 3ª solución

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

-- λ> take 60 numerosConDigitosPrimos2

-- [ 2, 3, 5, 7,

-- 22, 23, 25, 27,

-- 32, 33, 35, 37,

-- 52, 53, 55, 57,

-- 72, 73, 75, 77,

-- 222,223,225,227,

-- 232,233,235,237,

-- 252,253,255,257,

-- 272,273,275,277,

-- 322,323,325,327,

-- 332,333,335,337,

-- 352,353,355,357,

-- 372,373,375,377,

-- 522,523,525,527,

-- 532,533,535,537]

numerosConDigitosPrimos3 :: [Integer]

numerosConDigitosPrimos3 =

[2,3,5,7] ++ [10*n+d | n <- numerosConDigitosPrimos3, d <- [2,3,5,7]]

-- 4ª solución

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

-- λ> take 60 numerosConDigitosPrimos2

-- [ 2, 3, 5, 7,

-- 22,23,25,27,

-- 32,33,35,37,

-- 52,53,55,57,

-- 72,73,75,77,

-- 222,223,225,227, 232,233,235,237, 252,253,255,257, 272,273,275,277,

-- 322,323,325,327, 332,333,335,337, 352,353,355,357, 372,373,375,377,

-- 522,523,525,527, 532,533,535,537]

numerosConDigitosPrimos4 :: [Integer]

numerosConDigitosPrimos4 = concat (iterate siguiente [2,3,5,7])

-- (siguiente xs) es la lista obtenida añadiendo delante de cada

-- elemento de xs los dígitos 2, 3, 5 y 7. Por ejemplo,

-- λ> siguiente [5,6,8]

-- [25,26,28,

-- 35,36,38,

-- 55,56,58,

-- 75,76,78]

siguiente :: [Integer] -> [Integer]

siguiente xs = concat [map (pega d) xs | d <- [2,3,5,7]]

-- (pega d n) es el número obtenido añadiendo el dígito d delante del

-- número n. Por ejemplo,

-- pega 3 35 == 335

pega :: Int -> Integer -> Integer

pega d n = read (intToDigit d : show n)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_numerosConDigitosPrimos :: NonNegative Int -> Bool

prop_numerosConDigitosPrimos (NonNegative n) =

all (== numerosConDigitosPrimos1 !! n)

[ numerosConDigitosPrimos2 !! n

, numerosConDigitosPrimos3 !! n

, numerosConDigitosPrimos4 !! n

]

-- La comprobación es

-- λ> quickCheck prop_numerosConDigitosPrimos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numerosConDigitosPrimos1 !! 5000

-- 752732

-- (2.45 secs, 6,066,926,272 bytes)

-- λ> numerosConDigitosPrimos2 !! 5000

-- 752732

-- (0.34 secs, 387,603,456 bytes)

-- λ> numerosConDigitosPrimos3 !! 5000

-- 752732

-- (0.01 secs, 1,437,624 bytes)

-- λ> numerosConDigitosPrimos4 !! 5000

-- 752732

-- (0.00 secs, 1,556,104 bytes)

-- λ> numerosConDigitosPrimos3 !! (10^7)

-- 322732232572

-- (3.94 secs, 1,820,533,328 bytes)

-- λ> numerosConDigitosPrimos4 !! (10^7)

-- 322732232572

-- (1.84 secs, 2,000,606,640 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Reiteración de una función

PorJosé A. Alonso 8-abril-202216-abril-2022

Definir la función

   reiteracion :: (a -> a) -> Int -> a -> a

1	reiteracion :: (a -> a) -> Int -> a -> a

tal que (reiteracion f n x) es el resultado de aplicar n veces la función f a x. Por ejemplo,

   reiteracion (+1) 10 5  ==  15
   reiteracion (+5) 10 0  ==  50
   reiteracion (*2)  4 1  ==  16
   reiteracion (5:)  4 [] ==  [5,5,5,5]

reiteracion (+1) 10 5 == 15

reiteracion (+5) 10 0 == 50

reiteracion (*2) 4 1 == 16

reiteracion (5:) 4 [] == [5,5,5,5]

Soluciones

import Test.QuickCheck (Fun (..), Positive (..), quickCheck)

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

reiteracion1 :: (a -> a) -> Int -> a -> a
reiteracion1 _ 0 x = x
reiteracion1 f n x = f (reiteracion1 f (n-1) x)

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

reiteracion2 :: (a -> a) -> Int -> a -> a
reiteracion2 _ 0 = id
reiteracion2 f n = f . reiteracion2 f (n-1)

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

reiteracion3 :: (a -> a) -> Int -> a -> a
reiteracion3 _ 0 = id
reiteracion3 f n
  | even n    = reiteracion3 (f . f) (n `div` 2)
  | otherwise = f . reiteracion3 (f . f) (n `div` 2)

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

reiteracion4 :: (a -> a) -> Int -> a -> a
reiteracion4 f n x = reiteraciones f x !! n

reiteraciones :: (a -> a) -> a -> [a]
reiteraciones f x = x : reiteraciones f (f x)

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

reiteracion5 :: (a -> a) -> Int -> a -> a
reiteracion5 f n x = (iterate f x) !! n

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

-- Se puede eliminar los argumentos de la definición anterior como sigue:
--    reiteracion4 f n x = iterate f x !! n
--    reiteracion4 f n x = ((!!) (iterate f x)) n
--    reiteracion4 f n x = (((!!) . (iterate f)) x) n
--    reiteracion4 f n x = ((!!) . (iterate f)) x n
--    reiteracion4 f n x = flip ((!!) . (iterate f)) n x
--    reiteracion4 f = flip ((!!) . (iterate f))
--    reiteracion4 f = flip (((!!) .) (iterate f))
--    reiteracion4 f = flip (((!!) .) . iterate) f
--    reiteracion4 f = (flip . ((!!) .) . iterate) f
--    reiteracion4   = flip . ((!!) .) . iterate

reiteracion6 :: (a -> a) -> Int -> a -> a
reiteracion6 = flip . ((!!) .) . iterate

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_reiteracion :: Fun Int Int -> Positive Int -> Int -> Bool
prop_reiteracion (Fun _ f) (Positive n) x =
  all (== reiteracion1 f n x)
      [reiteracion2 f n x,
       reiteracion3 f n x,
       reiteracion4 f n x,
       reiteracion5 f n x,
       reiteracion6 f n x]

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

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

-- La comparación es
--    λ> reiteracion1 (+1) (10^7) 0
--    10000000
--    (5.09 secs, 2,505,392,792 bytes)
--    λ> reiteracion2 (+1) (10^7) 0
--    10000000
--    (5.45 secs, 2,896,899,728 bytes)
--    λ> reiteracion3 (+1) (10^7) 0
--    10000000
--    (2.14 secs, 816,909,416 bytes)
--    λ> reiteracion4 (+1) (10^7) 0
--    10000000
--    (4.24 secs, 1,696,899,816 bytes)
--    λ> reiteracion5 (+1) (10^7) 0
--    10000000
--    (2.53 secs, 1,376,899,800 bytes)
--    λ> reiteracion6 (+1) (10^7) 0
--    10000000
--    (2.34 secs, 1,376,899,984 bytes)

import Test.QuickCheck (Fun (..), Positive (..), quickCheck)

-- 1ª solución

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

reiteracion1 :: (a -> a) -> Int -> a -> a

reiteracion1 _ 0 x = x

reiteracion1 f n x = f (reiteracion1 f (n-1) x)

-- 2ª solución

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

reiteracion2 :: (a -> a) -> Int -> a -> a

reiteracion2 _ 0 = id

reiteracion2 f n = f . reiteracion2 f (n-1)

-- 3ª solución

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

reiteracion3 :: (a -> a) -> Int -> a -> a

reiteracion3 _ 0 = id

reiteracion3 f n

| even n = reiteracion3 (f . f) (n `div` 2)

| otherwise = f . reiteracion3 (f . f) (n `div` 2)

-- 4ª solución

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

reiteracion4 :: (a -> a) -> Int -> a -> a

reiteracion4 f n x = reiteraciones f x !! n

reiteraciones :: (a -> a) -> a -> [a]

reiteraciones f x = x : reiteraciones f (f x)

-- 5ª solución

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

reiteracion5 :: (a -> a) -> Int -> a -> a

reiteracion5 f n x = (iterate f x) !! n

-- 6ª solución

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

-- Se puede eliminar los argumentos de la definición anterior como sigue:

-- reiteracion4 f n x = iterate f x !! n

-- reiteracion4 f n x = ((!!) (iterate f x)) n

-- reiteracion4 f n x = (((!!) . (iterate f)) x) n

-- reiteracion4 f n x = ((!!) . (iterate f)) x n

-- reiteracion4 f n x = flip ((!!) . (iterate f)) n x

-- reiteracion4 f = flip ((!!) . (iterate f))

-- reiteracion4 f = flip (((!!) .) (iterate f))

-- reiteracion4 f = flip (((!!) .) . iterate) f

-- reiteracion4 f = (flip . ((!!) .) . iterate) f

-- reiteracion4 = flip . ((!!) .) . iterate

reiteracion6 :: (a -> a) -> Int -> a -> a

reiteracion6 = flip . ((!!) .) . iterate

-- Comprobación de equivalencia

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

-- La propiedad es

prop_reiteracion :: Fun Int Int -> Positive Int -> Int -> Bool

prop_reiteracion (Fun _ f) (Positive n) x =

all (== reiteracion1 f n x)

[reiteracion2 f n x,

reiteracion3 f n x,

reiteracion4 f n x,

reiteracion5 f n x,

reiteracion6 f n x]

-- La comprobación es

-- λ> quickCheck prop_reiteracion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> reiteracion1 (+1) (10^7) 0

-- 10000000

-- (5.09 secs, 2,505,392,792 bytes)

-- λ> reiteracion2 (+1) (10^7) 0

-- 10000000

-- (5.45 secs, 2,896,899,728 bytes)

-- λ> reiteracion3 (+1) (10^7) 0

-- 10000000

-- (2.14 secs, 816,909,416 bytes)

-- λ> reiteracion4 (+1) (10^7) 0

-- 10000000

-- (4.24 secs, 1,696,899,816 bytes)

-- λ> reiteracion5 (+1) (10^7) 0

-- 10000000

-- (2.53 secs, 1,376,899,800 bytes)

-- λ> reiteracion6 (+1) (10^7) 0

-- 10000000

-- (2.34 secs, 1,376,899,984 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Nuevas soluciones

En los comentarios se pueden escribir nuevas soluciones.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Sucesión duplicadora

PorJosé A. Alonso 26-mayo-20202-junio-2020

Para cada entero positivo n, existe una única sucesión que empieza en 1, termina en n y en la que cada uno de sus elementos es el doble de su anterior o el doble más uno. Dicha sucesión se llama la sucesión duplicadora de n. Por ejemplo, la sucesión duplicadora de 13 es [1, 3, 6, 13], ya que

    3 = 2*1 +1
    6 = 2*3
   13 = 2*6 +1

3 = 2*1 +1

6 = 2*3

13 = 2*6 +1

Definir la función

   duplicadora :: Integer -> [Integer]

1	duplicadora :: Integer -> [Integer]

tal que (duplicadora n) es la sucesión duplicadora de n. Por ejemplo,

   duplicadora 13                   ==  [1,3,6,13]
   duplicadora 17                   ==  [1,2,4,8,17]
   length (duplicadora (10^40000))  ==  132878

duplicadora 13 == [1,3,6,13]

duplicadora 17 == [1,2,4,8,17]

length (duplicadora (10^40000)) == 132878

Soluciones

-- 1ª definición
duplicadora :: Integer -> [Integer]
duplicadora x =
  reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición
duplicadora2 :: Integer -> [Integer]
duplicadora2  =
  reverse . takeWhile (>=1) . iterate (`div` 2)

-- 1ª definición

duplicadora :: Integer -> [Integer]

duplicadora x =

reverse (takeWhile (>=1) (iterate (`div` 2) x))

-- 2ª definición

duplicadora2 :: Integer -> [Integer]

duplicadora2 =

reverse . takeWhile (>=1) . iterate (`div` 2)

Cadenas de primos complementarios

PorJosé A. Alonso 25-mayo-20201-junio-2020

El complemento de un número positivo x se calcula por el siguiente procedimiento:

si x es mayor que 9, se toma cada dígito por su valor posicional y se resta del mayor los otro dígitos. Por ejemplo, el complemento de 1448 es 1000 – 400 – 40 – 8 = 552. Para
si x es menor que 10, su complemento es x.

Definir las funciones

   cadena    :: Integer -> [Integer]
   conCadena :: Int -> [Integer]

1 2	cadena :: Integer -> [Integer] conCadena :: Int -> [Integer]

tales que

(cadena x) es la cadena de primos a partir de x tal que cada uno es el complemento del anterior. Por ejemplo,

     cadena 8         == []
     cadena 7         == [7]
     cadena 13        == [13,7]
     cadena 643       == [643,557,443]
     cadena 18127     == [18127,1873,127,73,67,53,47]
     cadena 18181213  == [18181213,1818787,181213,18787,1213,787,613,587]

cadena 8 == []

cadena 7 == [7]

cadena 13 == [13,7]

cadena 643 == [643,557,443]

cadena 18127 == [18127,1873,127,73,67,53,47]

cadena 18181213 == [18181213,1818787,181213,18787,1213,787,613,587]

(conCadena n) es la lista de números cuyas cadenas tienen n elementos. Por ejemplo,

     take 6 (conCadena 3)                == [23,31,61,67,103,307]
     [head (conCadena n) | n <- [4..8]]  == [37,43,157,18127,181873]

1 2	take 6 (conCadena 3) == [23,31,61,67,103,307] [head (conCadena n) \| n <- [4..8]] == [37,43,157,18127,181873]

Soluciones

import Data.Numbers.Primes

-- (complemento x) es le complemento de x. Por ejemplo,
--    complemento 1448  == 552
--    complemento  639  == 561
--    complemento    7  == 7
complemento :: Integer -> Integer
complemento x = (div x c)*c - (rem x c)
  where c = 10^(length (show x) - 1)          

cadena :: Integer -> [Integer]
cadena x    
  | x < 10 && isPrime x = [x]
  | otherwise           = takeWhile isPrime (iterate f x)
  where f x | x < 10 && isPrime x = 0
            | otherwise           = complemento x

conCadena :: Int -> [Integer]
conCadena n =
  [y | y <- primes, length (cadena y) == n]

import Data.Numbers.Primes

-- (complemento x) es le complemento de x. Por ejemplo,

-- complemento 1448 == 552

-- complemento 639 == 561

-- complemento 7 == 7

complemento :: Integer -> Integer

complemento x = (div x c)*c - (rem x c)

where c = 10^(length (show x) - 1)

cadena :: Integer -> [Integer]

cadena x

| x < 10 && isPrime x = [x]

| otherwise = takeWhile isPrime (iterate f x)

where f x | x < 10 && isPrime x = 0

| otherwise = complemento x

conCadena :: Int -> [Integer]

conCadena n =

[y | y <- primes, length (cadena y) == n]

Las sucesiones de Loomis

PorJosé A. Alonso 22-mayo-202029-mayo-2020

La sucesión de Loomis generada por un número entero positivo x es la sucesión cuyos términos se definen por

f(0) es x
f(n) es la suma de f(n-1) y el producto de los dígitos no nulos de f(n-1)

Los primeros términos de las primeras sucesiones de Loomis son

Generada por 1: 1, 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, …
Generada por 2: 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 3: 3, 6, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 4: 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, 138, …
Generada por 5: 5, 10, 11, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, …

Se observa que a partir de un término todas coinciden con la generada por 1. Dicho término se llama el punto de convergencia. Por ejemplo,

la generada por 2 converge a 2
la generada por 3 converge a 26
la generada por 4 converge a 4
la generada por 5 converge a 26

Definir las siguientes funciones

   sucLoomis           :: Integer -> [Integer]
   convergencia        :: Integer -> Integer
   graficaConvergencia :: [Integer] -> IO ()

sucLoomis :: Integer -> [Integer]

convergencia :: Integer -> Integer

graficaConvergencia :: [Integer] -> IO ()

tales que

(sucLoomis x) es la sucesión de Loomis generada por x. Por ejemplo,

     λ> take 15 (sucLoomis 1)
     [1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 2)
     [2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 3)
     [3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 4)
     [4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]
     λ> take 15 (sucLoomis 5)
     [5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 20)
     [20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]
     λ> take 15 (sucLoomis 100)
     [100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]
     λ> sucLoomis 1 !! (2*10^5)
     235180736652

λ> take 15 (sucLoomis 1)

[1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 2)

[2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 3)

[3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 4)

[4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]

λ> take 15 (sucLoomis 5)

[5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 20)

[20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]

λ> take 15 (sucLoomis 100)

[100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]

λ> sucLoomis 1 !! (2*10^5)

235180736652

(convergencia x) es el término de convergencia de la sucesioń de Loomis generada por x xon la geerada por 1. Por ejemplo,

     convergencia  2      ==  2
     convergencia  3      ==  26
     convergencia  4      ==  4
     convergencia 17      ==  38
     convergencia 19      ==  102
     convergencia 43      ==  162
     convergencia 27      ==  202
     convergencia 58      ==  474
     convergencia 63      ==  150056
     convergencia 81      ==  150056
     convergencia 89      ==  150056
     convergencia (10^12) ==  1000101125092

convergencia 2 == 2

convergencia 3 == 26

convergencia 4 == 4

convergencia 17 == 38

convergencia 19 == 102

convergencia 43 == 162

convergencia 27 == 202

convergencia 58 == 474

convergencia 63 == 150056

convergencia 81 == 150056

convergencia 89 == 150056

convergencia (10^12) == 1000101125092

(graficaConvergencia xs) dibuja la gráfica de los términos de convergencia de las sucesiones de Loomis generadas por los elementos de xs. Por ejemplo, (graficaConvergencia ([1..50]) dibuja

y graficaConvergencia ([1..148] \ [63,81,89,137]) dibuja

Soluciones

import Data.List               ((\\))
import Data.Char               (digitToInt)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG))

-- 1ª definición de sucLoomis
-- ==========================

sucLoomis :: Integer -> [Integer]
sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer
loomis x 0 = x
loomis x n = y + productoDigitosNoNulos y
  where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer
productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]
digitosNoNulos x =
  [read [c] | c <- show x, c /= '0']

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

sucLoomis2 :: Integer -> [Integer]
sucLoomis2 = iterate siguienteLoomis 

siguienteLoomis :: Integer -> Integer
siguienteLoomis y = y + productoDigitosNoNulos y

-- 3ª definición de sucLoomis
-- ==========================

sucLoomis3 :: Integer -> [Integer]
sucLoomis3 =
  iterate ((+) <*> product .
           map (toInteger . digitToInt) .
           filter (/= '0') . show)

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

--    λ> sucLoomis 1 !! 30000
--    6571272766
--    (2.45 secs, 987,955,944 bytes)
--    λ> sucLoomis2 1 !! 30000
--    6571272766
--    (2.26 secs, 979,543,328 bytes)
--    λ> sucLoomis3 1 !! 30000
--    6571272766
--    (0.31 secs, 88,323,832 bytes)

-- 1ª definición de convergencia
-- =============================

convergencia1 :: Integer -> Integer
convergencia1 x =
  head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool
noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]
sucLoomisDe1 = sucLoomis 1

pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)

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

convergencia2 :: Integer -> Integer
convergencia2 = aux (sucLoomis3 1) . sucLoomis3
 where aux as@(x:xs) bs@(y:ys) | x == y    = x
                               | x < y     = aux xs bs
                               | otherwise = aux as ys

-- 3ª definición de convergencia
-- =============================

convergencia3 :: Integer -> Integer
convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3
 
-- (interseccion xs ys) es la intersección entre las listas ordenadas xs
-- e ys. Por ejemplo,
--    λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))
--    [2,4,8,16,22,26,38,62,74,102]
interseccion :: Ord a => [a] -> [a] -> [a]
interseccion = aux
  where aux as@(x:xs) bs@(y:ys) = case compare x y of
                                    LT ->     aux xs bs
                                    EQ -> x : aux xs ys
                                    GT ->     aux as ys
        aux _         _         = []                           

-- 4ª definición de convergencia
-- =============================

convergencia4 :: Integer -> Integer
convergencia4 x = perteneceA (sucLoomis3 x) 1
  where perteneceA (y:ys) n | y == c    = y
                            | otherwise = perteneceA ys c
          where c = head $ dropWhile (< y) $ sucLoomis3 n

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

--    λ> convergencia1 (10^4)
--    150056
--    (2.94 secs, 1,260,809,808 bytes)
--    λ> convergencia2 (10^4)
--    150056
--    (0.03 secs, 700,240 bytes)
--    λ> convergencia3 (10^4)
--    150056
--    (0.03 secs, 1,165,496 bytes)
--    λ> convergencia4 (10^4)
--    150056
--    (0.02 secs, 1,119,648 bytes)
--    
--    λ> convergencia2 (10^12)
--    1000101125092
--    (1.81 secs, 714,901,080 bytes)
--    λ> convergencia3 (10^12)
--    1000101125092
--    (1.92 secs, 744,932,184 bytes)
--    λ> convergencia4 (10^12)
--    1000101125092
--    (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia
-- ==================================

graficaConvergencia :: [Integer] -> IO ()
graficaConvergencia xs =
  plotList [ Key Nothing
           , Title "Convergencia de sucesiones de Loomis"
           , XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))
           , PNG "Las_sucesiones_de_Loomis_2.png"
           ]
           [(x,convergencia2 x) | x <- xs]

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

130

131

132

133

134

135

136

137

138

139

140

141

142

143

import Data.List ((\\))

import Data.Char (digitToInt)

import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG))

-- 1ª definición de sucLoomis

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

sucLoomis :: Integer -> [Integer]

sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer

loomis x 0 = x

loomis x n = y + productoDigitosNoNulos y

where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer

productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]

digitosNoNulos x =

[read [c] | c <- show x, c /= '0']

-- 2ª definición de sucLoomis

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

sucLoomis2 :: Integer -> [Integer]

sucLoomis2 = iterate siguienteLoomis

siguienteLoomis :: Integer -> Integer

siguienteLoomis y = y + productoDigitosNoNulos y

-- 3ª definición de sucLoomis

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

sucLoomis3 :: Integer -> [Integer]

sucLoomis3 =

iterate ((+) <*> product .

map (toInteger . digitToInt) .

filter (/= '0') . show)

-- Comparación de eficiencia

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

-- λ> sucLoomis 1 !! 30000

-- 6571272766

-- (2.45 secs, 987,955,944 bytes)

-- λ> sucLoomis2 1 !! 30000

-- 6571272766

-- (2.26 secs, 979,543,328 bytes)

-- λ> sucLoomis3 1 !! 30000

-- 6571272766

-- (0.31 secs, 88,323,832 bytes)

-- 1ª definición de convergencia

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

convergencia1 :: Integer -> Integer

convergencia1 x =

head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool

noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]

sucLoomisDe1 = sucLoomis 1

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

x == head (dropWhile (<x) ys)

-- 2ª definición de convergencia

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

convergencia2 :: Integer -> Integer

convergencia2 = aux (sucLoomis3 1) . sucLoomis3

where aux as@(x:xs) bs@(y:ys) | x == y = x

| x < y = aux xs bs

| otherwise = aux as ys

-- 3ª definición de convergencia

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

convergencia3 :: Integer -> Integer

convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3

-- (interseccion xs ys) es la intersección entre las listas ordenadas xs

-- e ys. Por ejemplo,

-- λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))

-- [2,4,8,16,22,26,38,62,74,102]

interseccion :: Ord a => [a] -> [a] -> [a]

interseccion = aux

where aux as@(x:xs) bs@(y:ys) = case compare x y of

LT -> aux xs bs

EQ -> x : aux xs ys

GT -> aux as ys

aux _ _ = []

-- 4ª definición de convergencia

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

convergencia4 :: Integer -> Integer

convergencia4 x = perteneceA (sucLoomis3 x) 1

where perteneceA (y:ys) n | y == c = y

| otherwise = perteneceA ys c

where c = head $ dropWhile (< y) $ sucLoomis3 n

-- Comparación de eficiencia

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

-- λ> convergencia1 (10^4)

-- 150056

-- (2.94 secs, 1,260,809,808 bytes)

-- λ> convergencia2 (10^4)

-- 150056

-- (0.03 secs, 700,240 bytes)

-- λ> convergencia3 (10^4)

-- 150056

-- (0.03 secs, 1,165,496 bytes)

-- λ> convergencia4 (10^4)

-- 150056

-- (0.02 secs, 1,119,648 bytes)

-- λ> convergencia2 (10^12)

-- 1000101125092

-- (1.81 secs, 714,901,080 bytes)

-- λ> convergencia3 (10^12)

-- 1000101125092

-- (1.92 secs, 744,932,184 bytes)

-- λ> convergencia4 (10^12)

-- 1000101125092

-- (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia

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

graficaConvergencia :: [Integer] -> IO ()

graficaConvergencia xs =

plotList [ Key Nothing

, Title "Convergencia de sucesiones de Loomis"

, XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))

, PNG "Las_sucesiones_de_Loomis_2.png"

]

[(x,convergencia2 x) | x <- xs]

Números de Perrin

PorJosé A. Alonso 19-mayo-202026-mayo-2020

Los números de Perrin se definen por la elación de recurrencia

   P(n) = P(n - 2) + P(n - 3) si n > 2,

1	P(n) = P(n - 2) + P(n - 3) si n > 2,

con los valores iniciales

   P(0) = 3, P(1) = 0 y P(2) = 2.

1	P(0) = 3, P(1) = 0 y P(2) = 2.

Definir la sucesión

   sucPerrin :: [Integer]

1	sucPerrin :: [Integer]

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

   λ> take 15 sucPerrin
   [3,0,2,3,2,5,5,7,10,12,17,22,29,39,51]
   λ> length (show (sucPerrin !! (2*10^5)))
   24425

λ> take 15 sucPerrin

[3,0,2,3,2,5,5,7,10,12,17,22,29,39,51]

λ> length (show (sucPerrin !! (2*10^5)))

24425

Comprobar con QuickCheck si se verifica la siguiente propiedad: para todo entero n > 1, el n-ésimo término de la sucesión de Perrin es divisible por n si y sólo si n es primo.

Soluciones

import Data.List (genericIndex, unfoldr)
import Data.Numbers.Primes (isPrime)
import Test.QuickCheck

-- 1ª solución
sucPerrin1 :: [Integer]
sucPerrin1 = 3 : 0 : 2 : zipWith (+) sucPerrin1 (tail sucPerrin1)

-- 2ª solución
sucPerrin2 :: [Integer]
sucPerrin2 = [x | (x,_,_) <- iterate op (3,0,2)]
  where op (a,b,c) = (b,c,a+b)
 
-- 3ª solución
sucPerrin3 :: [Integer]
sucPerrin3 =
  unfoldr (\(a, (b,c)) -> Just (a, (b,(c,a+b)))) (3,(0,2))

-- 4ª solución
sucPerrin4 :: [Integer]
sucPerrin4 = [vectorPerrin n ! n | n <- [0..]]

vectorPerrin :: Integer -> Array Integer Integer
vectorPerrin n = v where
  v = array (0,n) [(i,f i) | i <- [0..n]]
  f 0 = 3
  f 1 = 0
  f 2 = 2
  f i = v ! (i-2) + v ! (i-3)

-- Comparación de eficiencia
--    λ> length (show (sucPerrin1 !! (3*10^5)))
--    36638
--    (1.62 secs, 2,366,238,984 bytes)
--    λ> length (show (sucPerrin2 !! (3*10^5)))
--    36638
--    (1.40 secs, 2,428,701,384 bytes)
--    λ> length (show (sucPerrin3 !! (3*10^5)))
--    36638
--    (1.14 secs, 2,409,504,864 bytes)
--    λ> length (show (sucPerrin4 !! (3*10^5)))
--    36638
--    (1.78 secs, 2,585,400,776 bytes)


-- Usaremos la 3ª
sucPerrin :: [Integer]
sucPerrin = sucPerrin3

-- La propiedad es  
conjeturaPerrin :: Integer -> Property
conjeturaPerrin n =
  n > 1 ==>
  (perrin n `mod` n == 0) == isPrime n

-- (perrin n) es el n-ésimo término de la sucesión de Perrin. Por
-- ejemplo,
--    perrin 4  ==  2
--    perrin 5  ==  5
--    perrin 6  ==  5
perrin :: Integer -> Integer
perrin n = sucPerrin `genericIndex` n

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

-- Nota: Aunque QuickCheck no haya encontrado contraejemplos, la
-- propiedad no es cierta. Sólo lo es una de las implicaciones: si n es
-- primo, entonces el  n-ésimo término de la sucesión de Perrin es
-- divisible por n. La otra es falsa y los primeros contraejemplos son
--    271441, 904631, 16532714, 24658561, 27422714, 27664033, 46672291

import Data.List (genericIndex, unfoldr)

import Data.Numbers.Primes (isPrime)

import Test.QuickCheck

-- 1ª solución

sucPerrin1 :: [Integer]

sucPerrin1 = 3 : 0 : 2 : zipWith (+) sucPerrin1 (tail sucPerrin1)

-- 2ª solución

sucPerrin2 :: [Integer]

sucPerrin2 = [x | (x,_,_) <- iterate op (3,0,2)]

where op (a,b,c) = (b,c,a+b)

-- 3ª solución

sucPerrin3 :: [Integer]

sucPerrin3 =

unfoldr (\(a, (b,c)) -> Just (a, (b,(c,a+b)))) (3,(0,2))

-- 4ª solución

sucPerrin4 :: [Integer]

sucPerrin4 = [vectorPerrin n ! n | n <- [0..]]

vectorPerrin :: Integer -> Array Integer Integer

vectorPerrin n = v where

v = array (0,n) [(i,f i) | i <- [0..n]]

f 0 = 3

f 1 = 0

f 2 = 2

f i = v ! (i-2) + v ! (i-3)

-- Comparación de eficiencia

-- λ> length (show (sucPerrin1 !! (3*10^5)))

-- 36638

-- (1.62 secs, 2,366,238,984 bytes)

-- λ> length (show (sucPerrin2 !! (3*10^5)))

-- 36638

-- (1.40 secs, 2,428,701,384 bytes)

-- λ> length (show (sucPerrin3 !! (3*10^5)))

-- 36638

-- (1.14 secs, 2,409,504,864 bytes)

-- λ> length (show (sucPerrin4 !! (3*10^5)))

-- 36638

-- (1.78 secs, 2,585,400,776 bytes)

-- Usaremos la 3ª

sucPerrin :: [Integer]

sucPerrin = sucPerrin3

-- La propiedad es

conjeturaPerrin :: Integer -> Property

conjeturaPerrin n =

n > 1 ==>

(perrin n `mod` n == 0) == isPrime n

-- (perrin n) es el n-ésimo término de la sucesión de Perrin. Por

-- ejemplo,

-- perrin 4 == 2

-- perrin 5 == 5

-- perrin 6 == 5

perrin :: Integer -> Integer

perrin n = sucPerrin `genericIndex` n

-- La comprobación es

-- λ> quickCheck conjeturaPerrin

-- +++ OK, passed 100 tests.

-- Nota: Aunque QuickCheck no haya encontrado contraejemplos, la

-- propiedad no es cierta. Sólo lo es una de las implicaciones: si n es

-- primo, entonces el n-ésimo término de la sucesión de Perrin es

-- divisible por n. La otra es falsa y los primeros contraejemplos son

-- 271441, 904631, 16532714, 24658561, 27422714, 27664033, 46672291

Avistamientos de la pelota

PorJosé A. Alonso 4-marzo-202017-marzo-2020

Un niño está jugando con una pelota en el noveno piso de un edificio alto. La altura de este piso, h, es conocida. Deja caer la pelota por la ventana. La pelota rebota una r-ésima parte de su altura (por ejemplo, dos tercios de su altura). Su madre mira por una ventana a w metros del suelo (por ejemplo, a 1.5 metros). ¿Cuántas veces verá la madre a la pelota pasar frente a su ventana incluyendo cuando está cayendo y rebotando?

Se deben cumplir tres condiciones para que el experimento sea válido:

La altura «h» debe ser mayor que 0
El rebote «r» debe ser mayor que 0 y menor que 1
La altura de la ventana debe ser mayor que 0 y menor que h.

Definir la función

   numeroAvistamientos :: Double -> Double -> Double -> Integer

1	numeroAvistamientos :: Double -> Double -> Double -> Integer

tal que (numeroAvistamientos h r v) es el número de avistamientos de la pelota si se cumplen las tres condiciones anteriores y es -1 en caso contrario. Por ejemplo,

   numeroAvistamientos 3    0.66 1.5  ==  3
   numeroAvistamientos 30   0.66 1.5  ==  15
   numeroAvistamientos (-3) 0.66 1.5  ==  -1
   numeroAvistamientos 3    (-1) 1.5  ==  -1
   numeroAvistamientos 3    2    1.5  ==  -1
   numeroAvistamientos 3    0.5  (-1) ==  -1
   numeroAvistamientos 3    0.5  4    ==  -1

numeroAvistamientos 3 0.66 1.5 == 3

numeroAvistamientos 30 0.66 1.5 == 15

numeroAvistamientos (-3) 0.66 1.5 == -1

numeroAvistamientos 3 (-1) 1.5 == -1

numeroAvistamientos 3 2 1.5 == -1

numeroAvistamientos 3 0.5 (-1) == -1

numeroAvistamientos 3 0.5 4 == -1

Soluciones

import Data.List (genericLength)

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

numeroAvistamientos :: Double -> Double -> Double -> Integer
numeroAvistamientos h r v
  | adecuados h r v = 2 * n - 1 
  | otherwise      = -1
  where n = genericLength (takeWhile (>=v) (iterate (*r) h))

-- (adecuados h r v) se verifica si los datos cumplen las condiciones
-- para que el experimento sea válido.
adecuados :: Double -> Double -> Double -> Bool
adecuados h r v =
  h > 0 && 0 < r && r < 1 && 0 < v && v < h

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

numeroAvistamientos2 :: Double -> Double -> Double -> Integer
numeroAvistamientos2 h r v 
  | adecuados h r v = 2 + numeroAvistamientos2 (h * r) r v
  | otherwise       = -1

-- 3ª solución
numeroAvistamientos3 :: Double -> Double -> Double -> Integer
numeroAvistamientos3 h r v
  | adecuados h r v = 1 + 2 * floor (logBase r (v / h))
  | otherwise       = -1

import Data.List (genericLength)

-- 1ª solución

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

numeroAvistamientos :: Double -> Double -> Double -> Integer

numeroAvistamientos h r v

| adecuados h r v = 2 * n - 1

| otherwise = -1

where n = genericLength (takeWhile (>=v) (iterate (*r) h))

-- (adecuados h r v) se verifica si los datos cumplen las condiciones

-- para que el experimento sea válido.

adecuados :: Double -> Double -> Double -> Bool

adecuados h r v =

h > 0 && 0 < r && r < 1 && 0 < v && v < h

-- 2ª solución

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

numeroAvistamientos2 :: Double -> Double -> Double -> Integer

numeroAvistamientos2 h r v

| adecuados h r v = 2 + numeroAvistamientos2 (h * r) r v

| otherwise = -1

-- 3ª solución

numeroAvistamientos3 :: Double -> Double -> Double -> Integer

numeroAvistamientos3 h r v

| adecuados h r v = 1 + 2 * floor (logBase r (v / h))

| otherwise = -1

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Pensamiento

«Los patrones del matemático, como los del pintor o el poeta deben ser hermosos; las ideas, como los colores o las palabras deben encajar de manera armoniosa. La belleza es la primera prueba: no hay lugar permanente en este mundo para las matemáticas feas.»

G. H. Hardy.

Conjetura de Collatz generalizada

PorJosé A. Alonso 10-febrero-202017-febrero-2020

Sea p un número primo. Toma un número natural positivo, si es divisible entre un número primo menor que p divídelo entre el menor de dicho divisores, y en otro caso multiplícalo por p y súmale uno; si el resultado no es igual a uno, repite el proceso. Por ejemplo, para p = 7 y empezando en 42 el proceso es

   42
   -> 21   [= 42/2]
   -> 7    [= 21/3]
   -> 50   [= 7*7+1]
   -> 25   [= 50/5]
   -> 5    [= 25/5]
   -> 1    [= 5/5]

-> 21 [= 42/2]

-> 7 [= 21/3]

-> 50 [= 7*7+1]

-> 25 [= 50/5]

-> 5 [= 25/5]

-> 1 [= 5/5]

La conjetura de Collatz generalizada afirma que este proceso siempre acaba en un número finito de pasos.

Definir la función

   collatzGeneral :: Integer -> Integer -> [Integer]

1	collatzGeneral :: Integer -> Integer -> [Integer]

tal que (collatzGeneral p x) es la sucesión de los elementos obtenidos en el proceso anterior para el primo p enpezando en x. Por ejemplo,

   take 15 (collatzGeneral 7 42) == [42,21,7,50,25,5,1,8,4,2,1,8,4,2,1]
   take 15 (collatzGeneral 3  6) == [6,3,10,5,16,8,4,2,1,4,2,1,4,2,1]
   take 15 (collatzGeneral 5  6) == [6,3,1,6,3,1,6,3,1,6,3,1,6,3,1]
   take 15 (collatzGeneral 7  6) == [6,3,1,8,4,2,1,8,4,2,1,8,4,2,1]
   take 15 (collatzGeneral 9  6) == [6,3,1,10,5,1,10,5,1,10,5,1,10,5,1]

take 15 (collatzGeneral 7 42) == [42,21,7,50,25,5,1,8,4,2,1,8,4,2,1]

take 15 (collatzGeneral 3 6) == [6,3,10,5,16,8,4,2,1,4,2,1,4,2,1]

take 15 (collatzGeneral 5 6) == [6,3,1,6,3,1,6,3,1,6,3,1,6,3,1]

take 15 (collatzGeneral 7 6) == [6,3,1,8,4,2,1,8,4,2,1,8,4,2,1]

take 15 (collatzGeneral 9 6) == [6,3,1,10,5,1,10,5,1,10,5,1,10,5,1]

Comprobar con QuickCheck que se verifica la conjetura de Collatz generalizada; es decir, para todos enteros positivos n, x si p es el primo n-ésimo entonces 1 pertenece a (collatzGeneral p x).

Nota: El ejercicio etá basado en el artículo Los primos de la conjetura de Collatz publicado la semana pasada por Francisco R. Villatoro en su blog La Ciencia de la Mula Francis.

Soluciones

import Data.Numbers.Primes (primeFactors, primes)
import Test.QuickCheck

collatzGeneral :: Integer -> Integer -> [Integer]
collatzGeneral p x =
  iterate (siguiente p) x

siguiente :: Integer -> Integer -> Integer
siguiente p x 
  | null xs   = p * x + 1
  | otherwise = x `div` head xs
  where xs = takeWhile (<p) (primeFactors x)

prop_collatzGeneral :: Int -> Integer -> Property
prop_collatzGeneral n x =
  n > 0 && x > 0 ==>
  1 `elem` collatzGeneral p x
  where p = primes !! n 

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

import Data.Numbers.Primes (primeFactors, primes)

import Test.QuickCheck

collatzGeneral :: Integer -> Integer -> [Integer]

collatzGeneral p x =

iterate (siguiente p) x

siguiente :: Integer -> Integer -> Integer

siguiente p x

| null xs = p * x + 1

| otherwise = x `div` head xs

where xs = takeWhile (<p) (primeFactors x)

prop_collatzGeneral :: Int -> Integer -> Property

prop_collatzGeneral n x =

n > 0 && x > 0 ==>

1 `elem` collatzGeneral p x

where p = primes !! n

-- La comprobación es

-- λ> quickCheck prop_collatzGeneral

-- +++ OK, passed 100 tests.

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«Las matemáticas son la ciencia que utiliza palabras fáciles para ideas difíciles.»

Edward Kasner y James R. Newman

Triángulo de Bell

PorJosé A. Alonso 6-febrero-202013-febrero-2020

El triágulo de Bell es el triángulo numérico, cuya primera fila es [1] y en cada fila, el primer elemento es el último de la fila anterior y el elemento en la posición j se obtiene sumando el elemento anterior de su misma fila y de la fila anterior. Sus primeras filas son

   1 
   1   2
   2   3   5
   5   7  10  15
   15 20  27  37  52
   52 67  87 114 151 203

1 2

2 3 5

5 7 10 15

15 20 27 37 52

52 67 87 114 151 203

Definir la función

   trianguloDeBell :: [[Integer]]

1	trianguloDeBell :: [[Integer]]

tal que trianguloDeBell es la lista con las filas de dicho triángulo. Por ejemplo

   λ> take 5 trianguloDeBell
   [[1],[1,2],[2,3,5],[5,7,10,15],[15,20,27,37,52]]

1 2	λ> take 5 trianguloDeBell [[1],[1,2],[2,3,5],[5,7,10,15],[15,20,27,37,52]]

Comprobar con QuickCheck que los números que aparecen en la primera columna del triángulo coinciden con los números de Bell; es decir, el primer elemento de la n-ésima fila es el n-ésimo número de Bell.

Soluciones

import Data.List (genericIndex, genericLength)
import Test.QuickCheck

trianguloDeBell :: [[Integer]]
trianguloDeBell = iterate siguiente [1]

-- (siguiente xs) es la fila siguiente de xs en el triángulo de
-- Bell. Por ejemplo,
--    siguiente [1]     ==  [1,2]
--    siguiente [1,2]   ==  [2,3,5]
--    siguiente [2,3,5] ==  [5,7,10,15]
siguiente :: [Integer] -> [Integer]
siguiente xs = last xs : zipWith (+) xs (siguiente xs)

-- Propiedad
-- =========

-- La propiedad es
prop_TrianguloDeBell :: Integer -> Property
prop_TrianguloDeBell n =
  n > 0 ==> head (trianguloDeBell `genericIndex` n) == bell n

-- (bell n) es el n-ésimo número de Bell definido en el ejercicio
-- anterior.  
bell :: Integer -> Integer
bell n = genericLength (particiones [1..n])

particiones :: [a] -> [[[a]]]
particiones [] = [[]]
particiones (x:xs) =
  concat [([x] : yss) : inserta x yss | yss <- ysss]
  where ysss = particiones xs

inserta :: a -> [[a]] -> [[[a]]]
inserta _ []       = []
inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss] 

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=10}) prop_TrianguloDeBell
--    +++ OK, passed 100 tests.

import Data.List (genericIndex, genericLength)

import Test.QuickCheck

trianguloDeBell :: [[Integer]]

trianguloDeBell = iterate siguiente [1]

-- (siguiente xs) es la fila siguiente de xs en el triángulo de

-- Bell. Por ejemplo,

-- siguiente [1] == [1,2]

-- siguiente [1,2] == [2,3,5]

-- siguiente [2,3,5] == [5,7,10,15]

siguiente :: [Integer] -> [Integer]

siguiente xs = last xs : zipWith (+) xs (siguiente xs)

-- Propiedad

-- =========

-- La propiedad es

prop_TrianguloDeBell :: Integer -> Property

prop_TrianguloDeBell n =

n > 0 ==> head (trianguloDeBell `genericIndex` n) == bell n

-- (bell n) es el n-ésimo número de Bell definido en el ejercicio

-- anterior.

bell :: Integer -> Integer

bell n = genericLength (particiones [1..n])

particiones :: [a] -> [[[a]]]

particiones [] = [[]]

particiones (x:xs) =

concat [([x] : yss) : inserta x yss | yss <- ysss]

where ysss = particiones xs

inserta :: a -> [[a]] -> [[[a]]]

inserta _ [] = []

inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=10}) prop_TrianguloDeBell

-- +++ OK, passed 100 tests.

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

«La ciencia es lo que entendemos lo suficientemente bien como para explicarle a una computadora. El arte es todo lo demás.»

Donald Knuth.

Números sin 2 en base 3

PorJosé A. Alonso 22-enero-202029-enero-2020

Definir la sucesión

   numerosSin2EnBase3 :: [Integer]

1	numerosSin2EnBase3 :: [Integer]

cuyos términos son los números cuya representación en base 3 no contiene el dígito 2. Por ejemplo,

   λ> take 20 numerosSin2EnBase3
   [0,1,3,4,9,10,12,13,27,28,30,31,36,37,39,40,81,82,84,85]

1 2	λ> take 20 numerosSin2EnBase3 [0,1,3,4,9,10,12,13,27,28,30,31,36,37,39,40,81,82,84,85]

Se observa que

12 está en la sucesión ya que su representación en base 3 es 110 (porque 1·3² + 1·3¹ + 0.3⁰ = 12) y no contiene a 2.
14 no está en la sucesión ya que su representación en base 3 es 112 (porque 1·3² + 1·3¹ + 2.3⁰ = 14) y contiene a 2.

Comprobar con QuickCheck que las sucesiones numerosSin2EnBase3 y sucesionSin3enPA (del ejercicio anterior) son iguales; es decir, para todo número natural n, el n-ésimo término de numerosSin2EnBase3 es igual al n-ésimo término de sucesionSin3enPA.

Soluciones

import Data.List ((\\))
import Test.QuickCheck

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

numerosSin2EnBase3a :: [Integer]
numerosSin2EnBase3a =
  [n | n <- [0..]
     , 2 `notElem` (enBase3 n)]

-- (enBase3 n) es la representación de n en base 3. Por ejemplo,
--    enBase3 7   ==  [1,2]
--    enBase3 9   ==  [0,0,1]
--    enBase3 10  ==  [1,0,1]
--    enBase3 11  ==  [2,0,1]
enBase3 :: Integer -> [Integer]
enBase3 n | n < 3     = [n]
          | otherwise = r : enBase3 q
  where (q,r) = quotRem n 3

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

-- Se puede construir como un triángulo:
--    0
--    1
--    3 4
--    9 10 12 13
--    27 28 30 31 36 37 39 40
--    ....

numerosSin2EnBase3b :: [Integer]
numerosSin2EnBase3b = 0 : concat (iterate siguientes [1])
  where siguientes xs = concatMap (\x -> [3*x,3*x+1]) xs

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

-- La compración es
--    λ> numerosSin2EnBase3a !! (10^4)
--    1679697
--    (4.06 secs, 2,245,415,808 bytes)
--    λ> numerosSin2EnBase3b !! (10^4)
--    1679697
--    (0.03 secs, 2,109,912 bytes)

-- Definición
-- ==========

-- En lo que sigue usaremos la 2ª definición.
numerosSin2EnBase3 :: [Integer]
numerosSin2EnBase3 = numerosSin2EnBase3b

-- Propiedad
-- =========

-- La propiedad es
prop_equivalencia :: Int -> Property
prop_equivalencia n =
  n > 0 ==> sucesionSin3enPA !! n == numerosSin2EnBase3 !! n

-- sucesionSin3enPA donde cada uno de sus términos es el menor número
-- natural tal que no está en PA con cualesquiera dos términos
-- anteriores de la sucesión. 
sucesionSin3enPA :: [Integer]
sucesionSin3enPA = aux [] [0..] 
  where
    aux xs (y:ys) = y : aux (y:xs) (ys \\ [2 * y - x | x <- xs])

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

import Data.List ((\\))

import Test.QuickCheck

-- 1ª solución

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

numerosSin2EnBase3a :: [Integer]

numerosSin2EnBase3a =

[n | n <- [0..]

, 2 `notElem` (enBase3 n)]

-- (enBase3 n) es la representación de n en base 3. Por ejemplo,

-- enBase3 7 == [1,2]

-- enBase3 9 == [0,0,1]

-- enBase3 10 == [1,0,1]

-- enBase3 11 == [2,0,1]

enBase3 :: Integer -> [Integer]

enBase3 n | n < 3 = [n]

| otherwise = r : enBase3 q

where (q,r) = quotRem n 3

-- 2ª definición

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

-- Se puede construir como un triángulo:

-- 0

-- 1

-- 3 4

-- 9 10 12 13

-- 27 28 30 31 36 37 39 40

-- ....

numerosSin2EnBase3b :: [Integer]

numerosSin2EnBase3b = 0 : concat (iterate siguientes [1])

where siguientes xs = concatMap (\x -> [3*x,3*x+1]) xs

-- Comparación de eficiencia

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

-- La compración es

-- λ> numerosSin2EnBase3a !! (10^4)

-- 1679697

-- (4.06 secs, 2,245,415,808 bytes)

-- λ> numerosSin2EnBase3b !! (10^4)

-- 1679697

-- (0.03 secs, 2,109,912 bytes)

-- Definición

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

-- En lo que sigue usaremos la 2ª definición.

numerosSin2EnBase3 :: [Integer]

numerosSin2EnBase3 = numerosSin2EnBase3b

-- Propiedad

-- =========

-- La propiedad es

prop_equivalencia :: Int -> Property

prop_equivalencia n =

n > 0 ==> sucesionSin3enPA !! n == numerosSin2EnBase3 !! n

-- sucesionSin3enPA donde cada uno de sus términos es el menor número

-- natural tal que no está en PA con cualesquiera dos términos

-- anteriores de la sucesión.

sucesionSin3enPA :: [Integer]

sucesionSin3enPA = aux [] [0..]

where

aux xs (y:ys) = y : aux (y:xs) (ys \\ [2 * y - x | x <- xs])

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Otras soluciones

Se pueden escribir otras soluciones en los comentarios.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

Pensamiento

O que yo pueda asesinar un día
en mi alma, al despertar, esa persona
que me hizo el mundo mientras yo dormía.

Antonio Machado

La mayor potencia de dos no es divisor

PorJosé A. Alonso 7-enero-202014-enero-2020

Para cada número entero positivo n, se define el conjunto

   S(n) = {1, 2, 3, ..., n}

1	S(n) = {1, 2, 3, ..., n}

de los números desde el 1 hasta n.

Definir la función

   mayorPotenciaDeDosEnS :: Integer -> Integer

1	mayorPotenciaDeDosEnS :: Integer -> Integer

tal que (mayorPotenciaDeDosEnS n) es la mayor potencia de 2 en S(n). Por ejemplo,

   mayorPotenciaDeDosEnS 3  ==  2
   mayorPotenciaDeDosEnS 4  ==  4

1 2	mayorPotenciaDeDosEnS 3 == 2 mayorPotenciaDeDosEnS 4 == 4

Comprobar con QuickCheck que la mayor potencia de 2 en S(n) no divide a ningún otro elemento de S(n).

Soluciones

import Data.List (delete)
import Test.QuickCheck

mayorPotenciaDeDosEnS :: Integer -> Integer
mayorPotenciaDeDosEnS n =
  last (takeWhile (<=n) potenciasDeDos)

-- potenciasDeDos es la lista de las potencias de 2. Por ejemplo,
--    take 5 potenciasDeDos  ==  [1,2,4,8,16]
potenciasDeDos :: [Integer]
potenciasDeDos = iterate (*2) 1

-- La propiedad es
prop_mayorPotenciaDeDosEnS :: Integer -> Property
prop_mayorPotenciaDeDosEnS n =
  n > 0 ==> all (x `noDivide`) (delete x [1..n])
  where x = mayorPotenciaDeDosEnS n
        x `noDivide` y = y `mod` x /= 0

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

import Data.List (delete)

import Test.QuickCheck

mayorPotenciaDeDosEnS :: Integer -> Integer

mayorPotenciaDeDosEnS n =

last (takeWhile (<=n) potenciasDeDos)

-- potenciasDeDos es la lista de las potencias de 2. Por ejemplo,

-- take 5 potenciasDeDos == [1,2,4,8,16]

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- La propiedad es

prop_mayorPotenciaDeDosEnS :: Integer -> Property

prop_mayorPotenciaDeDosEnS n =

n > 0 ==> all (x `noDivide`) (delete x [1..n])

where x = mayorPotenciaDeDosEnS n

x `noDivide` y = y `mod` x /= 0

-- La comprobación es

-- λ> quickCheck prop_mayorPotenciaDeDosEnS

-- +++ OK, passed 100 tests.

Referencia

Basado en Greatest power of two not divisor de ProofWiki.

Pensamiento

¡Sólo tu figura,
como una centella blanca,
en mi noche oscura.

Antonio Machado

Cálculo de pi usando la fórmula de Vieta

PorJosé A. Alonso 16-diciembre-201923-diciembre-2019

La fórmula de Vieta para el cálculo de pi es la siguiente

Definir las funciones

   aproximacionPi :: Int -> Double
   errorPi :: Double -> Int

1 2	aproximacionPi :: Int -> Double errorPi :: Double -> Int

tales que

(aproximacionPi n) es la aproximación de pi usando n factores de la fórmula de Vieta. Por ejemplo,

     aproximacionPi  5  ==  3.140331156954753
     aproximacionPi 10  ==  3.1415914215112
     aproximacionPi 15  ==  3.141592652386592
     aproximacionPi 20  ==  3.1415926535886207
     aproximacionPi 25  ==  3.141592653589795

aproximacionPi 5 == 3.140331156954753

aproximacionPi 10 == 3.1415914215112

aproximacionPi 15 == 3.141592652386592

aproximacionPi 20 == 3.1415926535886207

aproximacionPi 25 == 3.141592653589795

(errorPi x) es el menor número de factores de la fórmula de Vieta necesarios para obtener pi con un error menor que x. Por ejemplo,

     errorPi 0.1        ==  2
     errorPi 0.01       ==  4
     errorPi 0.001      ==  6
     errorPi 0.0001     ==  7
     errorPi 1e-4       ==  7
     errorPi 1e-14      ==  24
     pi                 ==  3.141592653589793
     aproximacionPi 24  ==  3.1415926535897913

errorPi 0.1 == 2

errorPi 0.01 == 4

errorPi 0.001 == 6

errorPi 0.0001 == 7

errorPi 1e-4 == 7

errorPi 1e-14 == 24

pi == 3.141592653589793

aproximacionPi 24 == 3.1415926535897913

Soluciones

-- 1ª definición de aproximacionPi
aproximacionPi :: Int -> Double
aproximacionPi n = product [2 / aux x | x <- [0..n]]
  where
    aux 0 = 1
    aux 1 = sqrt 2
    aux n = sqrt (2 + aux (n-1))

-- 2ª definición de aproximacionPi
aproximacionPi2 :: Int -> Double
aproximacionPi2 n = product [2/x | x <- 1 : xs] 
  where xs = take n $ iterate (\x -> sqrt (2+x)) (sqrt 2)

-- 3ª definición de aproximaxionPi
aproximacionPi3 :: Int -> Double
aproximacionPi3 n =  product (2 : take n (map (2/) xs))
  where xs = sqrt 2 : [sqrt (2 + x) | x <- xs]

-- 1ª definición de errorPi
errorPi :: Double -> Int
errorPi x = head [n | n <- [1..]
                    , abs (pi - aproximacionPi n) < x]

-- 2ª definición de errorPi
errorPi2 :: Double -> Int
errorPi2 x = until aceptable (+1) 1
  where aceptable n = abs (pi - aproximacionPi n) < x

-- 1ª definición de aproximacionPi

aproximacionPi :: Int -> Double

aproximacionPi n = product [2 / aux x | x <- [0..n]]

where

aux 0 = 1

aux 1 = sqrt 2

aux n = sqrt (2 + aux (n-1))

-- 2ª definición de aproximacionPi

aproximacionPi2 :: Int -> Double

aproximacionPi2 n = product [2/x | x <- 1 : xs]

where xs = take n $ iterate (\x -> sqrt (2+x)) (sqrt 2)

-- 3ª definición de aproximaxionPi

aproximacionPi3 :: Int -> Double

aproximacionPi3 n = product (2 : take n (map (2/) xs))

where xs = sqrt 2 : [sqrt (2 + x) | x <- xs]

-- 1ª definición de errorPi

errorPi :: Double -> Int

errorPi x = head [n | n <- [1..]

, abs (pi - aproximacionPi n) < x]

-- 2ª definición de errorPi

errorPi2 :: Double -> Int

errorPi2 x = until aceptable (+1) 1

where aceptable n = abs (pi - aproximacionPi n) < x

Pensamiento

El tiempo que la barba me platea,
cavó mis ojos y agrandó mi frente,
va siendo en mi recuerdo transparente,
y mientras más al fondo, más clarea.

Antonio Machado

Las sucesiones de Loomis

PorJosé A. Alonso 15-mayo-201925-abril-2021

La sucesión de Loomis generada por un número entero positivo x es la sucesión cuyos términos se definen por

f(0) es x
f(n) es la suma de f(n-1) y el producto de los dígitos no nulos de f(n-1)

Los primeros términos de las primeras sucesiones de Loomis son

Generada por 1: 1, 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, …
Generada por 2: 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 3: 3, 6, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 4: 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, 138, …
Generada por 5: 5, 10, 11, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, …

Se observa que a partir de un término todas coinciden con la generada por 1. Dicho término se llama el punto de convergencia. Por ejemplo,

la generada por 2 converge a 2
la generada por 3 converge a 26
la generada por 4 converge a 4
la generada por 5 converge a 26

Definir las siguientes funciones

   sucLoomis           :: Integer -> [Integer]
   convergencia        :: Integer -> Integer
   graficaConvergencia :: [Integer] -> IO ()

sucLoomis :: Integer -> [Integer]

convergencia :: Integer -> Integer

graficaConvergencia :: [Integer] -> IO ()

tales que

(sucLoomis x) es la sucesión de Loomis generada por x. Por ejemplo,

     λ> take 15 (sucLoomis 1)
     [1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 2)
     [2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 3)
     [3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 4)
     [4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]
     λ> take 15 (sucLoomis 5)
     [5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 20)
     [20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]
     λ> take 15 (sucLoomis 100)
     [100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]
     λ> sucLoomis 1 !! (2*10^5)
     235180736652

λ> take 15 (sucLoomis 1)

[1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 2)

[2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 3)

[3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 4)

[4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]

λ> take 15 (sucLoomis 5)

[5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 20)

[20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]

λ> take 15 (sucLoomis 100)

[100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]

λ> sucLoomis 1 !! (2*10^5)

235180736652

(convergencia x) es el término de convergencia de la sucesioń de Loomis generada por x xon la geerada por 1. Por ejemplo,

     convergencia  2      ==  2
     convergencia  3      ==  26
     convergencia  4      ==  4
     convergencia 17      ==  38
     convergencia 19      ==  102
     convergencia 43      ==  162
     convergencia 27      ==  202
     convergencia 58      ==  474
     convergencia 63      ==  150056
     convergencia 81      ==  150056
     convergencia 89      ==  150056
     convergencia (10^12) ==  1000101125092

convergencia 2 == 2

convergencia 3 == 26

convergencia 4 == 4

convergencia 17 == 38

convergencia 19 == 102

convergencia 43 == 162

convergencia 27 == 202

convergencia 58 == 474

convergencia 63 == 150056

convergencia 81 == 150056

convergencia 89 == 150056

convergencia (10^12) == 1000101125092

(graficaConvergencia xs) dibuja la gráfica de los términos de convergencia de las sucesiones de Loomis generadas por los elementos de xs. Por ejemplo, (graficaConvergencia ([1..50]) dibuja

y graficaConvergencia ([1..148] \ [63,81,89,137]) dibuja

Soluciones

import Data.List               ((\\))
import Data.Char               (digitToInt)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG))

-- 1ª definición de sucLoomis
-- ==========================

sucLoomis :: Integer -> [Integer]
sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer
loomis x 0 = x
loomis x n = y + productoDigitosNoNulos y
  where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer
productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]
digitosNoNulos x =
  [read [c] | c <- show x, c /= '0']

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

sucLoomis2 :: Integer -> [Integer]
sucLoomis2 = iterate siguienteLoomis 

siguienteLoomis :: Integer -> Integer
siguienteLoomis y = y + productoDigitosNoNulos y

-- 3ª definición de sucLoomis
-- ==========================

sucLoomis3 :: Integer -> [Integer]
sucLoomis3 =
  iterate ((+) <*> product .
           map (toInteger . digitToInt) .
           filter (/= '0') . show)

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

--    λ> sucLoomis 1 !! 30000
--    6571272766
--    (2.45 secs, 987,955,944 bytes)
--    λ> sucLoomis2 1 !! 30000
--    6571272766
--    (2.26 secs, 979,543,328 bytes)
--    λ> sucLoomis3 1 !! 30000
--    6571272766
--    (0.31 secs, 88,323,832 bytes)

-- 1ª definición de convergencia
-- =============================

convergencia1 :: Integer -> Integer
convergencia1 x =
  head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool
noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]
sucLoomisDe1 = sucLoomis 1

pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)

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

convergencia2 :: Integer -> Integer
convergencia2 = aux (sucLoomis3 1) . sucLoomis3
 where aux as@(x:xs) bs@(y:ys) | x == y    = x
                               | x < y     = aux xs bs
                               | otherwise = aux as ys

-- 3ª definición de convergencia
-- =============================

convergencia3 :: Integer -> Integer
convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3
 
-- (interseccion xs ys) es la intersección entre las listas ordenadas xs
-- e ys. Por ejemplo,
--    λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))
--    [2,4,8,16,22,26,38,62,74,102]
interseccion :: Ord a => [a] -> [a] -> [a]
interseccion = aux
  where aux as@(x:xs) bs@(y:ys) = case compare x y of
                                    LT ->     aux xs bs
                                    EQ -> x : aux xs ys
                                    GT ->     aux as ys
        aux _         _         = []                           

-- 4ª definición de convergencia
-- =============================

convergencia4 :: Integer -> Integer
convergencia4 x = perteneceA (sucLoomis3 x) 1
  where perteneceA (y:ys) n | y == c    = y
                            | otherwise = perteneceA ys c
          where c = head $ dropWhile (< y) $ sucLoomis3 n

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

--    λ> convergencia1 (10^4)
--    150056
--    (2.94 secs, 1,260,809,808 bytes)
--    λ> convergencia2 (10^4)
--    150056
--    (0.03 secs, 700,240 bytes)
--    λ> convergencia3 (10^4)
--    150056
--    (0.03 secs, 1,165,496 bytes)
--    λ> convergencia4 (10^4)
--    150056
--    (0.02 secs, 1,119,648 bytes)
--    
--    λ> convergencia2 (10^12)
--    1000101125092
--    (1.81 secs, 714,901,080 bytes)
--    λ> convergencia3 (10^12)
--    1000101125092
--    (1.92 secs, 744,932,184 bytes)
--    λ> convergencia4 (10^12)
--    1000101125092
--    (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia
-- ==================================

graficaConvergencia :: [Integer] -> IO ()
graficaConvergencia xs =
  plotList [ Key Nothing
           , Title "Convergencia de sucesiones de Loomis"
           , XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))
           , PNG "Las_sucesiones_de_Loomis_2.png"
           ]
           [(x,convergencia2 x) | x <- xs]

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

130

131

132

133

134

135

136

137

138

139

140

141

142

143

import Data.List ((\\))

import Data.Char (digitToInt)

import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG))

-- 1ª definición de sucLoomis

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

sucLoomis :: Integer -> [Integer]

sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer

loomis x 0 = x

loomis x n = y + productoDigitosNoNulos y

where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer

productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]

digitosNoNulos x =

[read [c] | c <- show x, c /= '0']

-- 2ª definición de sucLoomis

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

sucLoomis2 :: Integer -> [Integer]

sucLoomis2 = iterate siguienteLoomis

siguienteLoomis :: Integer -> Integer

siguienteLoomis y = y + productoDigitosNoNulos y

-- 3ª definición de sucLoomis

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

sucLoomis3 :: Integer -> [Integer]

sucLoomis3 =

iterate ((+) <*> product .

map (toInteger . digitToInt) .

filter (/= '0') . show)

-- Comparación de eficiencia

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

-- λ> sucLoomis 1 !! 30000

-- 6571272766

-- (2.45 secs, 987,955,944 bytes)

-- λ> sucLoomis2 1 !! 30000

-- 6571272766

-- (2.26 secs, 979,543,328 bytes)

-- λ> sucLoomis3 1 !! 30000

-- 6571272766

-- (0.31 secs, 88,323,832 bytes)

-- 1ª definición de convergencia

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

convergencia1 :: Integer -> Integer

convergencia1 x =

head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool

noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]

sucLoomisDe1 = sucLoomis 1

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

x == head (dropWhile (<x) ys)

-- 2ª definición de convergencia

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

convergencia2 :: Integer -> Integer

convergencia2 = aux (sucLoomis3 1) . sucLoomis3

where aux as@(x:xs) bs@(y:ys) | x == y = x

| x < y = aux xs bs

| otherwise = aux as ys

-- 3ª definición de convergencia

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

convergencia3 :: Integer -> Integer

convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3

-- (interseccion xs ys) es la intersección entre las listas ordenadas xs

-- e ys. Por ejemplo,

-- λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))

-- [2,4,8,16,22,26,38,62,74,102]

interseccion :: Ord a => [a] -> [a] -> [a]

interseccion = aux

where aux as@(x:xs) bs@(y:ys) = case compare x y of

LT -> aux xs bs

EQ -> x : aux xs ys

GT -> aux as ys

aux _ _ = []

-- 4ª definición de convergencia

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

convergencia4 :: Integer -> Integer

convergencia4 x = perteneceA (sucLoomis3 x) 1

where perteneceA (y:ys) n | y == c = y

| otherwise = perteneceA ys c

where c = head $ dropWhile (< y) $ sucLoomis3 n

-- Comparación de eficiencia

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

-- λ> convergencia1 (10^4)

-- 150056

-- (2.94 secs, 1,260,809,808 bytes)

-- λ> convergencia2 (10^4)

-- 150056

-- (0.03 secs, 700,240 bytes)

-- λ> convergencia3 (10^4)

-- 150056

-- (0.03 secs, 1,165,496 bytes)

-- λ> convergencia4 (10^4)

-- 150056

-- (0.02 secs, 1,119,648 bytes)

-- λ> convergencia2 (10^12)

-- 1000101125092

-- (1.81 secs, 714,901,080 bytes)

-- λ> convergencia3 (10^12)

-- 1000101125092

-- (1.92 secs, 744,932,184 bytes)

-- λ> convergencia4 (10^12)

-- 1000101125092

-- (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia

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

graficaConvergencia :: [Integer] -> IO ()

graficaConvergencia xs =

plotList [ Key Nothing

, Title "Convergencia de sucesiones de Loomis"

, XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))

, PNG "Las_sucesiones_de_Loomis_2.png"

]

[(x,convergencia2 x) | x <- xs]

Pensamiento

Era una noche del mes
de mayo, azul y serena.
Sobre el agudo ciprés
brillaba la luna llena.

Antonio Machado

La conjetura de Collatz

PorJosé A. Alonso 9-abril-201926-marzo-2022

La conjetura de Collatz, conocida también como conjetura 3n+1, fue enunciada por Lothar Collatz en 1937 y, hasta la fecha, no se ha resuelto.

La conjetura hace referencia a una propiedad de las sucesiones de Siracusa. La sucesión de Siracusa de un número entero positivo x es la sucesión cuyo primer término es x y el siguiente de un término se obtiene dividiéndolo entre 2, si es par o multiplicándolo por 3 y sumándole 1, si es impar. Por ejemplo, la sucesión de Siracusa de 12 es

   12, 6, 3, 10, 5, 16, 8, 4, 2, 1, 4, 2, 1, 4, 2, 1, 4, 2, 1, 4, ....

1	12, 6, 3, 10, 5, 16, 8, 4, 2, 1, 4, 2, 1, 4, 2, 1, 4, 2, 1, 4, ....

La conjetura de Collatz afirma que para todo número entero positivo x, el 1 pertenece a la sucesión de Siracusa de x.

Definir las funciones

   siracusa        :: Integer -> [Integer]
   graficaSiracusa :: Int -> [Integer] -> IO ()

1 2	siracusa :: Integer -> [Integer] graficaSiracusa :: Int -> [Integer] -> IO ()

tales que

(siracusa x) es la sucesión de Siracusa de x. Por ejemplo,

     λ> take 20 (siracusa 12)
     [12,6,3,10,5,16,8,4,2,1,4,2,1,4,2,1,4,2,1,4]
     λ> take 20 (siracusa 22)
     [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1,4,2,1,4]

λ> take 20 (siracusa 12)

[12,6,3,10,5,16,8,4,2,1,4,2,1,4,2,1,4,2,1,4]

λ> take 20 (siracusa 22)

[22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1,4,2,1,4]

(graficaSiracusa n xs) dibuja los n primeros términos de las sucesiones de Siracusas de los elementos de xs. Por ejemplo, (graficaSiracusa 100 [27]) dibuja

y (graficaSiracusa 150 [1..1000]) dibuja

Comprobar con QuickCheck la conjetura de Collatz.

Soluciones

import Test.QuickCheck
import Graphics.Gnuplot.Simple

-- 1ª definición de siracusa
-- =========================

siracusa :: Integer -> [Integer]
siracusa n | even n    = n : siracusa (n `div` 2)
           | otherwise = n : siracusa (3*n+1)

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

siracusa2 :: Integer -> [Integer]
siracusa2 = iterate siguiente 
  where siguiente x | even x    = x `div` 2
                    | otherwise = 3*x+1

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

-- La comparación es
--    λ> siracusa 12 !! (10^6)
--    4
--    (0.55 secs, 362,791,008 bytes)
--    λ> siracusa 12 !! (2*10^6)
--    2
--    (1.05 secs, 725,456,376 bytes)
--    λ> siracusa2 12 !! (10^6)
--    4
--    (1.66 secs, 647,189,664 bytes)
--    λ> siracusa2 12 !! (2*10^6)
--    2
--    (3.11 secs, 1,294,286,792 bytes)

-- Definición de graficaSiracusa
-- =============================

graficaSiracusa :: Int -> [Integer] -> IO ()
graficaSiracusa n xs =
  plotLists [ Key Nothing
            , PNG "La_conjetura_de_Collatz.png"
            ]
            [take n (siracusa x) | x <- xs]

-- Comprobación de la conjetura
-- ============================

-- La conjetura es
conjeturaCollatz :: Positive Integer -> Bool
conjeturaCollatz (Positive n) =
  1 `elem` siracusa n

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

import Test.QuickCheck

import Graphics.Gnuplot.Simple

-- 1ª definición de siracusa

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

siracusa :: Integer -> [Integer]

siracusa n | even n = n : siracusa (n `div` 2)

| otherwise = n : siracusa (3*n+1)

-- 2ª definición de siracusa

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

siracusa2 :: Integer -> [Integer]

siracusa2 = iterate siguiente

where siguiente x | even x = x `div` 2

| otherwise = 3*x+1

-- Comparación de eficiencia

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

-- La comparación es

-- λ> siracusa 12 !! (10^6)

-- 4

-- (0.55 secs, 362,791,008 bytes)

-- λ> siracusa 12 !! (2*10^6)

-- 2

-- (1.05 secs, 725,456,376 bytes)

-- λ> siracusa2 12 !! (10^6)

-- 4

-- (1.66 secs, 647,189,664 bytes)

-- λ> siracusa2 12 !! (2*10^6)

-- 2

-- (3.11 secs, 1,294,286,792 bytes)

-- Definición de graficaSiracusa

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

graficaSiracusa :: Int -> [Integer] -> IO ()

graficaSiracusa n xs =

plotLists [ Key Nothing

, PNG "La_conjetura_de_Collatz.png"

]

[take n (siracusa x) | x <- xs]

-- Comprobación de la conjetura

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

-- La conjetura es

conjeturaCollatz :: Positive Integer -> Bool

conjeturaCollatz (Positive n) =

1 `elem` siracusa n

-- La comprobación es

-- λ> quickCheck conjeturaCollatz

-- +++ OK, passed 100 tests.

Pensamiento

Que el caminante es suma del camino …

Antonio Machado

Triángulo de Euler

PorJosé A. Alonso 29-marzo-20195-abril-2019

El triángulo de Euler se construye a partir de las siguientes relaciones

   A(n,1) = A(n,n) = 1
   A(n,m) = (n-m)A(n-1,m-1) + (m+1)A(n-1,m).

1 2	A(n,1) = A(n,n) = 1 A(n,m) = (n-m)A(n-1,m-1) + (m+1)A(n-1,m).

Sus primeros términos son

   1 
   1 1                                                       
   1 4   1                                            
   1 11  11    1                                    
   1 26  66    26    1                             
   1 57  302   302   57     1                    
   1 120 1191  2416  1191   120   1            
   1 247 4293  15619 15619  4293  247   1   
   1 502 14608 88234 156190 88234 14608 502 1

1 1

1 4 1

1 11 11 1

1 26 66 26 1

1 57 302 302 57 1

1 120 1191 2416 1191 120 1

1 247 4293 15619 15619 4293 247 1

1 502 14608 88234 156190 88234 14608 502 1

Definir las siguientes funciones:

  numeroEuler        :: Integer -> Integer -> Integer
  filaTrianguloEuler :: Integer -> [Integer]
  trianguloEuler     :: [[Integer]]

numeroEuler :: Integer -> Integer -> Integer

filaTrianguloEuler :: Integer -> [Integer]

trianguloEuler :: [[Integer]]

tales que

(numeroEuler n k) es el número de Euler A(n,k). Por ejemplo,

     numeroEuler 8 3  == 15619
     numeroEuler 20 6 == 21598596303099900
     length (show (numeroEuler 1000 500)) == 2567

numeroEuler 8 3 == 15619

numeroEuler 20 6 == 21598596303099900

length (show (numeroEuler 1000 500)) == 2567

(filaTrianguloEuler n) es la n-ésima fila del triángulo de Euler. Por ejemplo,

     filaTrianguloEuler 7  ==  [1,120,1191,2416,1191,120,1]
     filaTrianguloEuler 8  ==  [1,247,4293,15619,15619,4293,247,1]
     length (show (maximum (filaTrianguloEuler 1000)))  ==  2567

filaTrianguloEuler 7 == [1,120,1191,2416,1191,120,1]

filaTrianguloEuler 8 == [1,247,4293,15619,15619,4293,247,1]

length (show (maximum (filaTrianguloEuler 1000))) == 2567

trianguloEuler es la lista con las filas del triángulo de Euler

     λ> take 6 trianguloEuler
     [[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]
     λ> length (show (maximum (trianguloEuler !! 999)))
     2567

λ> take 6 trianguloEuler

[[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]

λ> length (show (maximum (trianguloEuler !! 999)))

2567

Soluciones

import Data.List  (genericLength, genericIndex)
import Data.Array (Array, (!), array)

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

trianguloEuler :: [[Integer]]
trianguloEuler = iterate siguiente [1]

-- (siguiente xs) es la fila siguiente a la xs en el triángulo de
-- Euler. Por ejemplo,
--    λ> siguiente [1]
--    [1,1]
--    λ> siguiente it
--    [1,4,1]
--    λ> siguiente it
--    [1,11,11,1]
siguiente :: [Integer] -> [Integer]
siguiente xs = zipWith (+) us vs
  where n = genericLength xs
        us = zipWith (*) (0:xs) [n+1,n..1]
        vs = zipWith (*) (xs++[0]) [1..n+1]

filaTrianguloEuler :: Integer -> [Integer]
filaTrianguloEuler n = trianguloEuler `genericIndex` (n-1)

numeroEuler :: Integer -> Integer -> Integer
numeroEuler n k = filaTrianguloEuler n `genericIndex` k

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

numeroEuler2 :: Integer -> Integer -> Integer
numeroEuler2 n 0 = 1
numeroEuler2 n m 
  | n == m    = 0
  | otherwise = (n-m) * numeroEuler2 (n-1) (m-1) + (m+1) * numeroEuler2 (n-1) m

filaTrianguloEuler2 :: Integer -> [Integer]
filaTrianguloEuler2 n = map (numeroEuler2 n) [0..n-1]

trianguloEuler2 :: [[Integer]]
trianguloEuler2 = map filaTrianguloEuler2 [1..]
                  
-- 3ª solución
-- ===========

numeroEuler3 :: Integer -> Integer -> Integer
numeroEuler3 n k = (matrizEuler n k) ! (n,k)

-- (matrizEuler n m) es la matriz de n+1 filas y m+1 columnsa formada
-- por los números de Euler. Por ejemplo,
--   λ> [[matrizEuler 6 6 ! (i,j) | j <- [0..i-1]] | i <- [1..6]]
--   [[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]
matrizEuler :: Integer -> Integer -> Array (Integer,Integer) Integer
matrizEuler n m = q
  where q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]
        f i 0 = 1
        f i j
          | i == j    = 0
          | otherwise = (i-j) * q!(i-1,j-1) + (j+1)* q!(i-1,j)

filaTrianguloEuler3 :: Integer -> [Integer]
filaTrianguloEuler3 n = map (numeroEuler3 n) [0..n-1]

trianguloEuler3 :: [[Integer]]
trianguloEuler3 = map filaTrianguloEuler3 [1..]

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

-- La comparación es
--   λ> numeroEuler 22 11
--   301958232385734088196
--   (0.01 secs, 118,760 bytes)
--   λ> numeroEuler2 22 11
--   301958232385734088196
--   (3.96 secs, 524,955,384 bytes)
--   λ> numeroEuler3 22 11
--   301958232385734088196
--   (0.01 secs, 356,296 bytes)
--   
--   λ> length (show (numeroEuler 800 400))
--   1976
--   (0.01 secs, 383,080 bytes)
--   λ> length (show (numeroEuler3 800 400))
--   1976
--   (2.13 secs, 508,780,696 bytes)

import Data.List (genericLength, genericIndex)

import Data.Array (Array, (!), array)

-- 1ª solución

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

trianguloEuler :: [[Integer]]

trianguloEuler = iterate siguiente [1]

-- (siguiente xs) es la fila siguiente a la xs en el triángulo de

-- Euler. Por ejemplo,

-- λ> siguiente [1]

-- [1,1]

-- λ> siguiente it

-- [1,4,1]

-- λ> siguiente it

-- [1,11,11,1]

siguiente :: [Integer] -> [Integer]

siguiente xs = zipWith (+) us vs

where n = genericLength xs

us = zipWith (*) (0:xs) [n+1,n..1]

vs = zipWith (*) (xs++[0]) [1..n+1]

filaTrianguloEuler :: Integer -> [Integer]

filaTrianguloEuler n = trianguloEuler `genericIndex` (n-1)

numeroEuler :: Integer -> Integer -> Integer

numeroEuler n k = filaTrianguloEuler n `genericIndex` k

-- 2ª solución

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

numeroEuler2 :: Integer -> Integer -> Integer

numeroEuler2 n 0 = 1

numeroEuler2 n m

| n == m = 0

| otherwise = (n-m) * numeroEuler2 (n-1) (m-1) + (m+1) * numeroEuler2 (n-1) m

filaTrianguloEuler2 :: Integer -> [Integer]

filaTrianguloEuler2 n = map (numeroEuler2 n) [0..n-1]

trianguloEuler2 :: [[Integer]]

trianguloEuler2 = map filaTrianguloEuler2 [1..]

-- 3ª solución

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

numeroEuler3 :: Integer -> Integer -> Integer

numeroEuler3 n k = (matrizEuler n k) ! (n,k)

-- (matrizEuler n m) es la matriz de n+1 filas y m+1 columnsa formada

-- por los números de Euler. Por ejemplo,

-- λ> [[matrizEuler 6 6 ! (i,j) | j <- [0..i-1]] | i <- [1..6]]

-- [[1],[1,1],[1,4,1],[1,11,11,1],[1,26,66,26,1],[1,57,302,302,57,1]]

matrizEuler :: Integer -> Integer -> Array (Integer,Integer) Integer

matrizEuler n m = q

where q = array ((0,0),(n,m)) [((i,j), f i j) | i <- [0..n], j <- [0..m]]

f i 0 = 1

f i j

| i == j = 0

| otherwise = (i-j) * q!(i-1,j-1) + (j+1)* q!(i-1,j)

filaTrianguloEuler3 :: Integer -> [Integer]

filaTrianguloEuler3 n = map (numeroEuler3 n) [0..n-1]

trianguloEuler3 :: [[Integer]]

trianguloEuler3 = map filaTrianguloEuler3 [1..]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> numeroEuler 22 11

-- 301958232385734088196

-- (0.01 secs, 118,760 bytes)

-- λ> numeroEuler2 22 11

-- 301958232385734088196

-- (3.96 secs, 524,955,384 bytes)

-- λ> numeroEuler3 22 11

-- 301958232385734088196

-- (0.01 secs, 356,296 bytes)

-- λ> length (show (numeroEuler 800 400))

-- 1976

-- (0.01 secs, 383,080 bytes)

-- λ> length (show (numeroEuler3 800 400))

-- 1976

-- (2.13 secs, 508,780,696 bytes)

Pensamiento

Señor San Jerónimo,
suelte usted la piedra
con que se machaca.
Me pegó con ella.

Antonio Machado

Números cíclopes

PorJosé A. Alonso 12-marzo-201926-marzo-2022

Un número cíclope es un número natural cuya representación binaria sólo tiene un cero en el centro. Por ejemplo,

     0      es ciclope porque su representación binaria es 0       
     1   no es ciclope porque su representación binaria es 1       
     5      es ciclope porque su representación binaria es 101     
     9   no es ciclope porque su representación binaria es 1001    
    10   no es ciclope porque su representación binaria es 1010    
    27      es ciclope porque su representación binaria es 11011   
    85   no es ciclope porque su representación binaria es 1010101 
   101   no es ciclope porque su representación binaria es 1100101 
   111   no es ciclope porque su representación binaria es 1101111 
   119      es ciclope porque su representación binaria es 1110111

0 es ciclope porque su representación binaria es 0

1 no es ciclope porque su representación binaria es 1

5 es ciclope porque su representación binaria es 101

9 no es ciclope porque su representación binaria es 1001

10 no es ciclope porque su representación binaria es 1010

27 es ciclope porque su representación binaria es 11011

85 no es ciclope porque su representación binaria es 1010101

101 no es ciclope porque su representación binaria es 1100101

111 no es ciclope porque su representación binaria es 1101111

119 es ciclope porque su representación binaria es 1110111

Definir las funciones

   esCiclope       :: Integer -> Bool
   ciclopes        :: [Integer]
   graficaCiclopes :: Int -> IO ()

esCiclope :: Integer -> Bool

ciclopes :: [Integer]

graficaCiclopes :: Int -> IO ()

tales que

(esCiclope n) se verifica si el número natual n es cíclope. Por ejemplo,

      esCiclope 0    ==  True
      esCiclope 1    ==  False
      esCiclope 5    ==  True
      esCiclope 9    ==  False
      esCiclope 10   ==  False
      esCiclope 27   ==  True
      esCiclope 85   ==  False
      esCiclope 101  ==  False
      esCiclope 111  ==  False
      esCiclope 119  ==  True

esCiclope 0 == True

esCiclope 1 == False

esCiclope 5 == True

esCiclope 9 == False

esCiclope 10 == False

esCiclope 27 == True

esCiclope 85 == False

esCiclope 101 == False

esCiclope 111 == False

esCiclope 119 == True

ciclopes es la lista de los número cíclopes. Por ejemplo,

     λ> take 12 ciclopes
     [0,5,27,119,495,2015,8127,32639,130815,523775,2096127,8386559]
     λ> length (show (ciclopes !! (10^5)))
     60207

λ> take 12 ciclopes

[0,5,27,119,495,2015,8127,32639,130815,523775,2096127,8386559]

λ> length (show (ciclopes !! (10^5)))

60207

(graficaCiclopes n) dibuja la gráfica del último dígito de los n primeros números cíclopes. Por ejemplo, (graficaCiclopes n) dibuja

Soluciones

import Graphics.Gnuplot.Simple

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

--    esCiclope 5  ==  True
--    esCiclope 6  ==  False
esCiclope :: Integer -> Bool
esCiclope n =
  esCiclopeBinario (decimalAbinario n)

--    decimalAbinario 4  ==  [0,0,1]
--    decimalAbinario 5  ==  [1,0,1]
--    decimalAbinario 6  ==  [0,1,1]
decimalAbinario :: Integer -> [Integer]
decimalAbinario 0 = [0]
decimalAbinario 1 = [1]
decimalAbinario n = r : decimalAbinario q
  where (q,r) = quotRem n 2

--    esCiclopeBinario [1,1,0,1,1]  ==  True
--    esCiclopeBinario [1,1,0,1]  ==  False
--    esCiclopeBinario [1,1,2,1,1]  ==  False
--    esCiclopeBinario [2,2,0,2,2]  ==  False
esCiclopeBinario :: [Integer] -> Bool
esCiclopeBinario xs =
  odd n && xs == ys ++ 0 : ys
  where n  = length xs
        m  = n `div` 2
        ys = replicate m 1

--    take 8 ciclopes  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes :: [Integer]
ciclopes = filter esCiclope [0..]

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

--    take 8 ciclopes2  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes2 :: [Integer]
ciclopes2 =
  [binarioAdecimal (replicate n 1 ++ 0 : replicate n 1) | n <- [0..]]

--    binarioAdecimal [0,1,1]  ==  6
binarioAdecimal :: [Integer] -> Integer
binarioAdecimal [x]    = x
binarioAdecimal (x:xs) = x + 2 * binarioAdecimal xs

esCiclope2 :: Integer -> Bool
esCiclope2 n =
  n `pertenece` ciclopes2

pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)

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

--    take 8 ciclopes3  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes3 :: [Integer]
ciclopes3 =
  [sum [2^k | k <- [0..n-1]] + sum [2^k | k <- [n+1..n+n]] | n <- [0..]]

esCiclope3 :: Integer -> Bool
esCiclope3 n =
  n `pertenece` ciclopes3

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

--    take 8 ciclopes3  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes4 :: [Integer]
ciclopes4 =
  [2^(2*n+1) - 1 - 2^n | n <- [0..]]

esCiclope4 :: Integer -> Bool
esCiclope4 n =
  n `pertenece` ciclopes4


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

--    take 8 ciclopes5  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes5 :: [Integer]
ciclopes5 =
  [2*4^n - 1 - 2^n | n <- [0..]]

esCiclope5 :: Integer -> Bool
esCiclope5 n =
  n `pertenece` ciclopes5

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

--    take 8 ciclopes6  ==  [0,5,27,119,495,2015,8127,32639]
ciclopes6 :: [Integer]
ciclopes6 =
  [2*x*x - 1 - x | x <- iterate (*2) 1]
  
esCiclope6 :: Integer -> Bool
esCiclope6 n =
  n `pertenece` ciclopes6



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

--    λ> ciclopes !! 9
--    523775
--    (6.68 secs, 4,696,734,960 bytes)
--    λ> ciclopes2 !! 9
--    523775
--    (0.00 secs, 134,664 bytes)
--    λ> ciclopes3 !! 9
--    523775
--    (0.00 secs, 150,920 bytes)
--    λ> ciclopes4 !! 9
--    523775
--    (0.01 secs, 131,936 bytes)
--    λ> ciclopes5 !! 9
--    523775
--    (0.00 secs, 132,064 bytes)
--
--    λ> length (show (ciclopes2 !! (3*10^4)))
--    18063
--    (0.65 secs, 486,437,480 bytes)
--    λ> length (show (ciclopes3 !! (3*10^4)))
--    18063
--    (2.94 secs, 1,188,645,584 bytes)
--    λ> length (show (ciclopes4 !! (3*10^4)))
--    18063
--    (0.02 secs, 6,769,592 bytes)
--    λ> length (show (ciclopes5 !! (3*10^4)))
--    18063
--    (0.02 secs, 6,773,552 bytes)
--
--    λ> length (show (ciclopes2 !! (10^5)))
--    60207
--    (6.42 secs, 5,148,671,368 bytes)
--    λ> length (show (ciclopes4 !! (10^5)))
--    60207
--    (0.07 secs, 22,291,480 bytes)
--    λ> length (show (ciclopes5 !! (10^5)))
--    60207
--    (0.04 secs, 22,316,216 bytes)
--    
--    λ> length (show (ciclopes4 !! (5*10^6)))
--    3010301
--    (2.34 secs, 1,116,327,832 bytes)
--    λ> length (show (ciclopes5 !! (5*10^6)))
--    3010301
--    (2.39 secs, 1,099,177,056 bytes)

-- Definición de graficaCiclopes
-- =============================

graficaCiclopes :: Int -> IO ()
graficaCiclopes n =
  plotList [ Key Nothing
           -- , PNG "Numeros_ciclopes.png"
           ]
           [x `mod` 10 | x <- take n ciclopes5]

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

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

import Graphics.Gnuplot.Simple

-- 1ª solución

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

-- esCiclope 5 == True

-- esCiclope 6 == False

esCiclope :: Integer -> Bool

esCiclope n =

esCiclopeBinario (decimalAbinario n)

-- decimalAbinario 4 == [0,0,1]

-- decimalAbinario 5 == [1,0,1]

-- decimalAbinario 6 == [0,1,1]

decimalAbinario :: Integer -> [Integer]

decimalAbinario 0 = [0]

decimalAbinario 1 = [1]

decimalAbinario n = r : decimalAbinario q

where (q,r) = quotRem n 2

-- esCiclopeBinario [1,1,0,1,1] == True

-- esCiclopeBinario [1,1,0,1] == False

-- esCiclopeBinario [1,1,2,1,1] == False

-- esCiclopeBinario [2,2,0,2,2] == False

esCiclopeBinario :: [Integer] -> Bool

esCiclopeBinario xs =

odd n && xs == ys ++ 0 : ys

where n = length xs

m = n `div` 2

ys = replicate m 1

-- take 8 ciclopes == [0,5,27,119,495,2015,8127,32639]

ciclopes :: [Integer]

ciclopes = filter esCiclope [0..]

-- 2ª solución

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

-- take 8 ciclopes2 == [0,5,27,119,495,2015,8127,32639]

ciclopes2 :: [Integer]

ciclopes2 =

[binarioAdecimal (replicate n 1 ++ 0 : replicate n 1) | n <- [0..]]

-- binarioAdecimal [0,1,1] == 6

binarioAdecimal :: [Integer] -> Integer

binarioAdecimal [x] = x

binarioAdecimal (x:xs) = x + 2 * binarioAdecimal xs

esCiclope2 :: Integer -> Bool

esCiclope2 n =

n `pertenece` ciclopes2

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

x == head (dropWhile (<x) ys)

-- 3ª solución

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

-- take 8 ciclopes3 == [0,5,27,119,495,2015,8127,32639]

ciclopes3 :: [Integer]

ciclopes3 =

[sum [2^k | k <- [0..n-1]] + sum [2^k | k <- [n+1..n+n]] | n <- [0..]]

esCiclope3 :: Integer -> Bool

esCiclope3 n =

n `pertenece` ciclopes3

-- 4ª solución

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

-- take 8 ciclopes3 == [0,5,27,119,495,2015,8127,32639]

ciclopes4 :: [Integer]

ciclopes4 =

[2^(2*n+1) - 1 - 2^n | n <- [0..]]

esCiclope4 :: Integer -> Bool

esCiclope4 n =

n `pertenece` ciclopes4

-- 5ª solución

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

-- take 8 ciclopes5 == [0,5,27,119,495,2015,8127,32639]

ciclopes5 :: [Integer]

ciclopes5 =

[2*4^n - 1 - 2^n | n <- [0..]]

esCiclope5 :: Integer -> Bool

esCiclope5 n =

n `pertenece` ciclopes5

-- 6ª solución

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

-- take 8 ciclopes6 == [0,5,27,119,495,2015,8127,32639]

ciclopes6 :: [Integer]

ciclopes6 =

[2*x*x - 1 - x | x <- iterate (*2) 1]

esCiclope6 :: Integer -> Bool

esCiclope6 n =

n `pertenece` ciclopes6

-- Comparación de eficiencia

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

-- λ> ciclopes !! 9

-- 523775

-- (6.68 secs, 4,696,734,960 bytes)

-- λ> ciclopes2 !! 9

-- 523775

-- (0.00 secs, 134,664 bytes)

-- λ> ciclopes3 !! 9

-- 523775

-- (0.00 secs, 150,920 bytes)

-- λ> ciclopes4 !! 9

-- 523775

-- (0.01 secs, 131,936 bytes)

-- λ> ciclopes5 !! 9

-- 523775

-- (0.00 secs, 132,064 bytes)

-- λ> length (show (ciclopes2 !! (3*10^4)))

-- 18063

-- (0.65 secs, 486,437,480 bytes)

-- λ> length (show (ciclopes3 !! (3*10^4)))

-- 18063

-- (2.94 secs, 1,188,645,584 bytes)

-- λ> length (show (ciclopes4 !! (3*10^4)))

-- 18063

-- (0.02 secs, 6,769,592 bytes)

-- λ> length (show (ciclopes5 !! (3*10^4)))

-- 18063

-- (0.02 secs, 6,773,552 bytes)

-- λ> length (show (ciclopes2 !! (10^5)))

-- 60207

-- (6.42 secs, 5,148,671,368 bytes)

-- λ> length (show (ciclopes4 !! (10^5)))

-- 60207

-- (0.07 secs, 22,291,480 bytes)

-- λ> length (show (ciclopes5 !! (10^5)))

-- 60207

-- (0.04 secs, 22,316,216 bytes)

-- λ> length (show (ciclopes4 !! (5*10^6)))

-- 3010301

-- (2.34 secs, 1,116,327,832 bytes)

-- λ> length (show (ciclopes5 !! (5*10^6)))

-- 3010301

-- (2.39 secs, 1,099,177,056 bytes)

-- Definición de graficaCiclopes

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

graficaCiclopes :: Int -> IO ()

graficaCiclopes n =

plotList [ Key Nothing

-- , PNG "Numeros_ciclopes.png"

]

[x `mod` 10 | x <- take n ciclopes5]

Pensamiento

¿Sabes cuando el agua suena,
si es agua de cumbre o valle,
de plaza, jardín o huerta?
Cantores, dejad
palmas y jaleo
para los demás.

Antonio Machado

Mezcla de listas

PorJosé A. Alonso 19-febrero-201926-febrero-2019

Definir la función

   mezcla :: [[a]] -> [a]

1	mezcla :: [[a]] -> [a]

tal que (mezcla xss) es la lista tomando sucesivamente los elementos de xss en la misma posición. Cuando una de las listas de xss es vacía, se continua con las restantes. por ejemplo,

   mezcla [[1,2],[3..7],[8..10]]            ==  [1,3,8,2,4,9,5,10,6,7]
   mezcla ["Estamos","en","2019"]           ==  "Ee2sn0t1a9mos"
   take 9 (mezcla [[3,6..],[5,7..],[0,1]])  ==  [3,5,0,6,7,1,9,9,12]

mezcla [[1,2],[3..7],[8..10]] == [1,3,8,2,4,9,5,10,6,7]

mezcla ["Estamos","en","2019"] == "Ee2sn0t1a9mos"

take 9 (mezcla [[3,6..],[5,7..],[0,1]]) == [3,5,0,6,7,1,9,9,12]

Soluciones

import Data.List (transpose)

-- 1ª solución
mezcla :: [[a]] -> [a]
mezcla xss = aux (filter (not . null) xss)
  where
    aux []  = []
    aux yss = map head yss ++ mezcla (map tail yss)

-- 2ª solución
mezcla2 :: [[a]] -> [a]
mezcla2 = aux . filter (not . null)
  where
    aux []  = []
    aux yss = map head yss ++ mezcla (map tail yss)

-- 3ª solución
mezcla3 :: [[a]] -> [a]
mezcla3 = concatMap primeros . takeWhile (not . null) . iterate restos
  where primeros = map head . filter (not . null)
        restos   = map tail . filter (not . null)

-- 4ª solución
mezcla4 :: [[a]] -> [a]
mezcla4 = concat . transpose

import Data.List (transpose)

-- 1ª solución

mezcla :: [[a]] -> [a]

mezcla xss = aux (filter (not . null) xss)

where

aux [] = []

aux yss = map head yss ++ mezcla (map tail yss)

-- 2ª solución

mezcla2 :: [[a]] -> [a]

mezcla2 = aux . filter (not . null)

where

aux [] = []

aux yss = map head yss ++ mezcla (map tail yss)

-- 3ª solución

mezcla3 :: [[a]] -> [a]

mezcla3 = concatMap primeros . takeWhile (not . null) . iterate restos

where primeros = map head . filter (not . null)

restos = map tail . filter (not . null)

-- 4ª solución

mezcla4 :: [[a]] -> [a]

mezcla4 = concat . transpose

Pensamiento

Cuatro cosas tiene el hombre
que no sirven en la mar:
ancla, gobernalle y remos,
y miedo de naufragar.

Antonio Machado

Triángulo de Pascal binario

PorJosé A. Alonso 31-enero-20197-febrero-2019

Los triángulos binarios de Pascal se formas a partir de una lista de ceros y unos usando las reglas del triángulo de Pascal, donde cada uno de los números es suma módulo dos de los dos situados en diagonal por encima suyo. Por ejemplo, los triángulos binarios de Pascal correspondientes a [1,0,1,1,1] y [1,0,1,1,0] son

   1 0 1 1 1   1 0 1 1 0     
    1 1 0 0     1 1 0 1  
     0 1 0       0 1 1   
      1 1         1 0    
       0           1

1 0 1 1 1 1 0 1 1 0

1 1 0 0 1 1 0 1

0 1 0 0 1 1

1 1 1 0

0 1

Sus finales, desde el extremo inferior al extremos superior derecho, son [0,1,0,0,1] y [1,0,1,1,0], respectivamente.

Una lista es Pascal capicúa si es igual a los finales de su triángulo binario de Pascal. Por ejemplo, [1,0,1,1,0] es Pascal capicúa.

Definir las funciones

   trianguloPascalBinario :: [Int] -> [[Int]]
   pascalCapicuas         :: Int -> [[Int]]
   nPascalCapicuas        :: Int -> Integer

trianguloPascalBinario :: [Int] -> [[Int]]

pascalCapicuas :: Int -> [[Int]]

nPascalCapicuas :: Int -> Integer

tales que

(trianguloPascalBinario xs) es el triágulo binario de Pascal correspondiente a la lista xs. Por ejemplo,

     λ> trianguloPascalBinario [1,0,1,1,1]
     [[1,0,1,1,1],[1,1,0,0],[0,1,0],[1,1],[0]]
     λ> trianguloPascalBinario [1,0,1,1,0]
     [[1,0,1,1,0],[1,1,0,1],[0,1,1],[1,0],[1]]

λ> trianguloPascalBinario [1,0,1,1,1]

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

λ> trianguloPascalBinario [1,0,1,1,0]

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

(pascalCapicuas n) es la lista de listas de Pascal capicúas de n elementos. Por ejemplo,

     λ> pascalCapicuas 2
     [[0,0],[1,0]]
     λ> pascalCapicuas 3
     [[0,0,0],[0,1,0],[1,0,0],[1,1,0]]
     λ> pascalCapicuas 4
     [[0,0,0,0],[0,1,1,0],[1,0,0,0],[1,1,1,0]]

λ> pascalCapicuas 2

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

λ> pascalCapicuas 3

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

λ> pascalCapicuas 4

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

(nPascalCapicuas n) es el número de listas de Pascal capicúas de n elementos. Por ejemplo,

     λ> nPascalCapicuas 2
     2
     λ> nPascalCapicuas 3
     4
     λ> nPascalCapicuas 4
     4
     λ> nPascalCapicuas 400
     1606938044258990275541962092341162602522202993782792835301376
     λ> length (show (nPascalCapicuas (10^5)))
     15052
     λ> length (show (nPascalCapicuas (10^6)))
     150515
     λ> length (show (nPascalCapicuas (10^7)))
     1505150

λ> nPascalCapicuas 2

λ> nPascalCapicuas 3

λ> nPascalCapicuas 4

λ> nPascalCapicuas 400

1606938044258990275541962092341162602522202993782792835301376

λ> length (show (nPascalCapicuas (10^5)))

15052

λ> length (show (nPascalCapicuas (10^6)))

150515

λ> length (show (nPascalCapicuas (10^7)))

1505150

Soluciones

import Data.List (genericLength, unfoldr)

-- Definición de trianguloPascalBinario
-- ====================================

trianguloPascalBinario :: [Int] -> [[Int]]
trianguloPascalBinario xs =
  takeWhile (not . null) (iterate siguiente xs)

-- (siguiente xs) es la línea siguiente a la xs en el triángulo binario
-- de Pascal. Por ejemplo,
--    λ> siguiente [1,0,1,1,1]
--    [1,1,0,0]
--    λ> siguiente it
--    [0,1,0]
--    λ> siguiente it
--    [1,1]
--    λ> siguiente it
--    [0]
--    λ> siguiente it
--    []
--    λ> siguiente it
--    []
siguiente :: [Int] -> [Int]
siguiente xs = [(x + y) `mod` 2 | (x,y) <- zip xs (tail xs)]

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

trianguloPascalBinario2 :: [Int] -> [[Int]]
trianguloPascalBinario2 = unfoldr f 
  where f [] = Nothing
        f xs = Just (xs, siguiente xs)
 
-- Definición de pascalCapicuas
-- ============================

pascalCapicuas :: Int -> [[Int]]
pascalCapicuas n =
  [xs | xs <- inicios n
      , esPascalCapicua xs]

-- (inicios n) es la lista de longitud n formadas por ceros y unos. Por
-- ejemplo, 
--    λ> inicios 0
--    [[]]
--    λ> inicios 1
--    [[0],[1]]
--    λ> inicios 2
--    [[0,0],[0,1],[1,0],[1,1]]
--    λ> inicios 3
--    [[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]
inicios :: Int -> [[Int]]
inicios 0 = [[]]
inicios n = map (0:) xss ++ map (1:) xss
  where xss = inicios (n-1)

-- Otra forma de definir inicios es
inicios2 :: Int -> [[Int]]
inicios2 n = sucInicios !! n
  where sucInicios    = iterate siguiente [[]]
        siguiente xss = map (0:) xss ++ map (1:) xss

-- (esPascalCapicua xs) se verifica si xs es una lista de Pascal
-- capicúa. Por ejemplo, 
--    esPascalCapicua [1,0,1,1,0]  ==  True
--    esPascalCapicua [1,0,1,1,1]  ==  False
esPascalCapicua :: [Int] -> Bool
esPascalCapicua xs =
  xs == finalesTrianguloPascalBinario xs

-- (finalesTrianguloPascalBinario xs) es la inversa de la lista de los
-- finales del triángulo binarios de xs. Por ejemplo,
--    λ> finalesTrianguloPascalBinario [1,0,1,1,1]
--    [0,1,0,0,1]
finalesTrianguloPascalBinario :: [Int] -> [Int]
finalesTrianguloPascalBinario =
  reverse . map last . trianguloPascalBinario

-- 1ª definición de nPascalCapicuas
-- ================================

nPascalCapicuas :: Int -> Integer
nPascalCapicuas =
  genericLength . pascalCapicuas

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

nPascalCapicuas2 :: Int -> Integer
nPascalCapicuas2 n =
  2 ^ ((n + 1) `div` 2)

import Data.List (genericLength, unfoldr)

-- Definición de trianguloPascalBinario

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

trianguloPascalBinario :: [Int] -> [[Int]]

trianguloPascalBinario xs =

takeWhile (not . null) (iterate siguiente xs)

-- (siguiente xs) es la línea siguiente a la xs en el triángulo binario

-- de Pascal. Por ejemplo,

-- λ> siguiente [1,0,1,1,1]

-- [1,1,0,0]

-- λ> siguiente it

-- [0,1,0]

-- λ> siguiente it

-- [1,1]

-- λ> siguiente it

-- [0]

-- λ> siguiente it

-- []

-- λ> siguiente it

-- []

siguiente :: [Int] -> [Int]

siguiente xs = [(x + y) `mod` 2 | (x,y) <- zip xs (tail xs)]

-- 2ª definición de trianguloPascalBinario

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

trianguloPascalBinario2 :: [Int] -> [[Int]]

trianguloPascalBinario2 = unfoldr f

where f [] = Nothing

f xs = Just (xs, siguiente xs)

-- Definición de pascalCapicuas

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

pascalCapicuas :: Int -> [[Int]]

pascalCapicuas n =

[xs | xs <- inicios n

, esPascalCapicua xs]

-- (inicios n) es la lista de longitud n formadas por ceros y unos. Por

-- ejemplo,

-- λ> inicios 0

-- [[]]

-- λ> inicios 1

-- [[0],[1]]

-- λ> inicios 2

-- [[0,0],[0,1],[1,0],[1,1]]

-- λ> inicios 3

-- [[0,0,0],[0,0,1],[0,1,0],[0,1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1]]

inicios :: Int -> [[Int]]

inicios 0 = [[]]

inicios n = map (0:) xss ++ map (1:) xss

where xss = inicios (n-1)

-- Otra forma de definir inicios es

inicios2 :: Int -> [[Int]]

inicios2 n = sucInicios !! n

where sucInicios = iterate siguiente [[]]

siguiente xss = map (0:) xss ++ map (1:) xss

-- (esPascalCapicua xs) se verifica si xs es una lista de Pascal

-- capicúa. Por ejemplo,

-- esPascalCapicua [1,0,1,1,0] == True

-- esPascalCapicua [1,0,1,1,1] == False

esPascalCapicua :: [Int] -> Bool

esPascalCapicua xs =

xs == finalesTrianguloPascalBinario xs

-- (finalesTrianguloPascalBinario xs) es la inversa de la lista de los

-- finales del triángulo binarios de xs. Por ejemplo,

-- λ> finalesTrianguloPascalBinario [1,0,1,1,1]

-- [0,1,0,0,1]

finalesTrianguloPascalBinario :: [Int] -> [Int]

finalesTrianguloPascalBinario =

reverse . map last . trianguloPascalBinario

-- 1ª definición de nPascalCapicuas

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

nPascalCapicuas :: Int -> Integer

nPascalCapicuas =

genericLength . pascalCapicuas

-- 2ª definición de nPascalCapicuas

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

nPascalCapicuas2 :: Int -> Integer

nPascalCapicuas2 n =

2 ^ ((n + 1) `div` 2)

Pensamiento

La envidia de la virtud
hizo a Caín criminal.
¡Gloria a Caín! Hoy el vicio
es lo que se envidia más.

Antonio Machado

Grado exponencial

PorJosé A. Alonso 19-diciembre-201826-diciembre-2018

El grado exponencial de un número n es el menor número x mayor que 1 tal que n es una subcadena de $n^x$ . Por ejemplo, el grado exponencial de 2 es 5 ya que 2 es una subcadena de 32 (que es $2^5$ ) y no es subcadena de las anteriores potencias de 2 (2, 4 y 16). El grado exponencial de 25 es 2 porque 25 es una subcadena de 625 (que es $25^2$ ).

Definir la función

   gradoExponencial :: Integer -> Integer

1	gradoExponencial :: Integer -> Integer

tal que (gradoExponencial n) es el grado exponencial de n. Por ejemplo,

   gradoExponencial 2      ==  5
   gradoExponencial 25     ==  2
   gradoExponencial 15     ==  26
   gradoExponencial 1093   ==  100
   gradoExponencial 10422  ==  200
   gradoExponencial 11092  ==  300

gradoExponencial 2 == 5

gradoExponencial 25 == 2

gradoExponencial 15 == 26

gradoExponencial 1093 == 100

gradoExponencial 10422 == 200

gradoExponencial 11092 == 300

Soluciones

import Test.QuickCheck
import Data.List (genericLength, isInfixOf)

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

gradoExponencial :: Integer -> Integer
gradoExponencial n =
  head [e | e <- [2..]
          , show n `isInfixOf` show (n^e)]

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

gradoExponencial2 :: Integer -> Integer
gradoExponencial2 n =
  2 + genericLength (takeWhile noSubcadena (potencias n))
  where c             = show n
        noSubcadena x = not (c `isInfixOf`show x)

-- (potencias n) es la lista de las potencias de n a partir de n^2. Por
-- ejemplo, 
--    λ> take 10 (potencias 2)
--    [4,8,16,32,64,128,256,512,1024,2048]
potencias :: Integer -> [Integer]
potencias n =
  iterate (*n) (n^2)

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

gradoExponencial3 :: Integer -> Integer
gradoExponencial3 n = aux 2
  where aux x
          | cs `isInfixOf` show (n^x) = x
          | otherwise                 = aux (x+1)
        cs = show n

-- Equivalencia
-- ============

-- La propiedad es
prop_gradosExponencial_equiv :: (Positive Integer) -> Bool
prop_gradosExponencial_equiv (Positive n) =
  gradoExponencial n == gradoExponencial2 n &&
  gradoExponencial n == gradoExponencial3 n

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

import Test.QuickCheck

import Data.List (genericLength, isInfixOf)

-- 1ª solución

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

gradoExponencial :: Integer -> Integer

gradoExponencial n =

head [e | e <- [2..]

, show n `isInfixOf` show (n^e)]

-- 2ª solución

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

gradoExponencial2 :: Integer -> Integer

gradoExponencial2 n =

2 + genericLength (takeWhile noSubcadena (potencias n))

where c = show n

noSubcadena x = not (c `isInfixOf`show x)

-- (potencias n) es la lista de las potencias de n a partir de n^2. Por

-- ejemplo,

-- λ> take 10 (potencias 2)

-- [4,8,16,32,64,128,256,512,1024,2048]

potencias :: Integer -> [Integer]

potencias n =

iterate (*n) (n^2)

-- 3ª solución

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

gradoExponencial3 :: Integer -> Integer

gradoExponencial3 n = aux 2

where aux x

| cs `isInfixOf` show (n^x) = x

| otherwise = aux (x+1)

cs = show n

-- Equivalencia

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

-- La propiedad es

prop_gradosExponencial_equiv :: (Positive Integer) -> Bool

prop_gradosExponencial_equiv (Positive n) =

gradoExponencial n == gradoExponencial2 n &&

gradoExponencial n == gradoExponencial3 n

-- La comprobación es

-- λ> quickCheck prop_gradosExponencial_equiv

-- +++ OK, passed 100 tests.

Referencia

Basado en la sucesión A045537 de la OEIS.

Pensamiento

«De cada diez novedades que pretenden descubrirnos, nueve son
tonterías. La décima y última, que no es necedad, resulta a última hora
que tampoco es nueva.»

Antonio Machado

Números construidos con los dígitos de un conjunto dado

PorJosé A. Alonso 8-mayo-201815-mayo-2018

Definir las siguientes funciones

   numerosCon      :: [Integer] -> [Integer]
   numeroDeDigitos :: [Integer] -> Integer -> Int

1 2	numerosCon :: [Integer] -> [Integer] numeroDeDigitos :: [Integer] -> Integer -> Int

tales que

(numerosCon ds) es la lista de los números que se pueden construir con los dígitos de ds (cuyos elementos son distintos elementos del 1 al 9) . Por ejemplo,

     λ> take 22 (numerosCon [1,4,6,9])
     [1,4,6,9,11,14,16,19,41,44,46,49,61,64,66,69,91,94,96,99,111,114]
     λ> take 15 (numerosCon [4,6,9])
     [4,6,9,44,46,49,64,66,69,94,96,99,444,446,449]
     λ> take 15 (numerosCon [6,9])
     [6,9,66,69,96,99,666,669,696,699,966,969,996,999,6666]

λ> take 22 (numerosCon [1,4,6,9])

[1,4,6,9,11,14,16,19,41,44,46,49,61,64,66,69,91,94,96,99,111,114]

λ> take 15 (numerosCon [4,6,9])

[4,6,9,44,46,49,64,66,69,94,96,99,444,446,449]

λ> take 15 (numerosCon [6,9])

[6,9,66,69,96,99,666,669,696,699,966,969,996,999,6666]

(numeroDeDigitos ds k) es el número de dígitos que tiene el k-ésimo elemento (empezando a contar en 0) de la sucesión (numerosCon ds). Por ejemplo,

     numeroDeDigitos [1,4,6,9]   3  ==  1
     numeroDeDigitos [1,4,6,9]   6  ==  2
     numeroDeDigitos [1,4,6,9]  22  ==  3
     numeroDeDigitos [4,6,9]    15  ==  3
     numeroDeDigitos [6,9]      15  ==  4
     numeroDeDigitos [1,4,6,9] (10^(10^5))  ==  166097
     numeroDeDigitos   [4,6,9] (10^(10^5))  ==  209590
     numeroDeDigitos     [6,9] (10^(10^5))  ==  332192

numeroDeDigitos [1,4,6,9] 3 == 1

numeroDeDigitos [1,4,6,9] 6 == 2

numeroDeDigitos [1,4,6,9] 22 == 3

numeroDeDigitos [4,6,9] 15 == 3

numeroDeDigitos [6,9] 15 == 4

numeroDeDigitos [1,4,6,9] (10^(10^5)) == 166097

numeroDeDigitos [4,6,9] (10^(10^5)) == 209590

numeroDeDigitos [6,9] (10^(10^5)) == 332192

Soluciones

import Data.List (genericIndex, genericLength)

-- Definición de numerosCon
-- ========================

numerosCon :: [Integer] -> [Integer]
numerosCon xs = [n | n <- [0..]
                   , n `tieneSusDigitosEn` xs]

-- (tieneSusDigitosEn xs n) se verifica si los dígitos de n están contenidos en
-- xs. Por ejemplo,
--    4149 `tieneSusDigitosEn` [1,4,6,9]  ==  True
--    4143 `tieneSusDigitosEn` [1,4,6,9]  ==  False
tieneSusDigitosEn :: Integer -> [Integer] -> Bool
tieneSusDigitosEn n xs =
  digitos n `esSubconjunto` xs

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos n = [read [c] | c <- show n]

-- (esSubconjunto xs ys) se verifica si xs es subconjunto de ys. Por
-- ejemplo, 
--    esSubconjunto [3,2,5] [4,2,5,7,3]  ==  True
--    esSubconjunto [3,2,5] [4,2,5,7]  ==  False
esSubconjunto :: Eq a => [a] -> [a] -> Bool
esSubconjunto xs ys = all (`elem` ys) xs

-- 1ª definición de numeroDeDigitos
-- ================================

numeroDeDigitos :: [Integer] -> Integer -> Int
numeroDeDigitos xs n =
  length (show (numerosCon xs `genericIndex` n))

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

-- Observando que si el conjunto de dígitos tiene n elementos, entonces
-- hay n^k números con k dígitos.

numeroDeDigitos2 :: [Integer] -> Integer -> Int
numeroDeDigitos2 xs n =
  1 + length (takeWhile (<= n) (sumasDePotencias (genericLength xs)))

-- (potencia n) son las potencias de n. Por ejemplo,
--    take 5 (potencias 3)  ==  [3,9,27,81,243]
potencias :: Integer -> [Integer]
potencias k = iterate (*k) k 

-- (sumasDePotencias n) es la lista de las sumas acumuladas de las
-- potencias de n. Por ejemplo,
--    take 5 (sumasDePotencias 3)  ==  [3,12,39,120,363]
sumasDePotencias :: Integer -> [Integer]
sumasDePotencias k = scanl1 (+) (potencias k)

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

--    λ> numeroDeDigitos [1,4,6,9] 2000
--    6
--    (3.98 secs, 1,424,390,064 bytes)
--    λ> numeroDeDigitos2 [1,4,6,9] 2000
--    6
--    (0.01 secs, 127,464 bytes)

import Data.List (genericIndex, genericLength)

-- Definición de numerosCon

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

numerosCon :: [Integer] -> [Integer]

numerosCon xs = [n | n <- [0..]

, n `tieneSusDigitosEn` xs]

-- (tieneSusDigitosEn xs n) se verifica si los dígitos de n están contenidos en

-- xs. Por ejemplo,

-- 4149 `tieneSusDigitosEn` [1,4,6,9] == True

-- 4143 `tieneSusDigitosEn` [1,4,6,9] == False

tieneSusDigitosEn :: Integer -> [Integer] -> Bool

tieneSusDigitosEn n xs =

digitos n `esSubconjunto` xs

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Integer]

digitos n = [read [c] | c <- show n]

-- (esSubconjunto xs ys) se verifica si xs es subconjunto de ys. Por

-- ejemplo,

-- esSubconjunto [3,2,5] [4,2,5,7,3] == True

-- esSubconjunto [3,2,5] [4,2,5,7] == False

esSubconjunto :: Eq a => [a] -> [a] -> Bool

esSubconjunto xs ys = all (`elem` ys) xs

-- 1ª definición de numeroDeDigitos

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

numeroDeDigitos :: [Integer] -> Integer -> Int

numeroDeDigitos xs n =

length (show (numerosCon xs `genericIndex` n))

-- 2ª definición de numeroDeDigitos

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

-- Observando que si el conjunto de dígitos tiene n elementos, entonces

-- hay n^k números con k dígitos.

numeroDeDigitos2 :: [Integer] -> Integer -> Int

numeroDeDigitos2 xs n =

1 + length (takeWhile (<= n) (sumasDePotencias (genericLength xs)))

-- (potencia n) son las potencias de n. Por ejemplo,

-- take 5 (potencias 3) == [3,9,27,81,243]

potencias :: Integer -> [Integer]

potencias k = iterate (*k) k

-- (sumasDePotencias n) es la lista de las sumas acumuladas de las

-- potencias de n. Por ejemplo,

-- take 5 (sumasDePotencias 3) == [3,12,39,120,363]

sumasDePotencias :: Integer -> [Integer]

sumasDePotencias k = scanl1 (+) (potencias k)

-- Comparación de eficiencia

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

-- λ> numeroDeDigitos [1,4,6,9] 2000

-- 6

-- (3.98 secs, 1,424,390,064 bytes)

-- λ> numeroDeDigitos2 [1,4,6,9] 2000

-- 6

-- (0.01 secs, 127,464 bytes)

Número de triangulaciones de un polígono

PorJosé A. Alonso 7-mayo-201825-abril-2021

Una triangulación de un polígono es una división del área en un conjunto de triángulos, de forma que la unión de todos ellos es igual al polígono original, y cualquier par de triángulos es disjunto o comparte únicamente un vértice o un lado. En el caso de polígonos convexos, la cantidad de triangulaciones posibles depende únicamente del número de vértices del polígono.

Si llamamos T(n) al número de triangulaciones de un polígono de n vértices, se verifica la siguiente relación de recurrencia:

    T(2) = 1
    T(n) = T(2)*T(n-1) + T(3)*T(n-2) + ... + T(n-1)*T(2)

1 2	T(2) = 1 T(n) = T(2)T(n-1) + T(3)T(n-2) + ... + T(n-1)*T(2)

Definir la función

   numeroTriangulaciones :: Integer -> Integer

1	numeroTriangulaciones :: Integer -> Integer

tal que (numeroTriangulaciones n) es el número de triangulaciones de un polígono convexo de n vértices. Por ejemplo,

   numeroTriangulaciones 3  == 1
   numeroTriangulaciones 5  == 5
   numeroTriangulaciones 6  == 14
   numeroTriangulaciones 7  == 42
   numeroTriangulaciones 50 == 131327898242169365477991900
   length (show (numeroTriangulaciones   800)) ==  476
   length (show (numeroTriangulaciones  1000)) ==  597
   length (show (numeroTriangulaciones 10000)) == 6014

numeroTriangulaciones 3 == 1

numeroTriangulaciones 5 == 5

numeroTriangulaciones 6 == 14

numeroTriangulaciones 7 == 42

numeroTriangulaciones 50 == 131327898242169365477991900

length (show (numeroTriangulaciones 800)) == 476

length (show (numeroTriangulaciones 1000)) == 597

length (show (numeroTriangulaciones 10000)) == 6014

Soluciones

import Data.Array (Array, (!), array)
import Data.List  (genericIndex)
import qualified Data.Vector as V

-- 1ª solución (por recursión)
-- ===========================

numeroTriangulaciones :: Integer -> Integer
numeroTriangulaciones 2 = 1
numeroTriangulaciones n = sum (zipWith (*) ts (reverse ts))
  where ts = [numeroTriangulaciones k | k <- [2..n-1]]

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

--    λ> map numeroTriangulaciones2 [2..15]
--    [1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900]
numeroTriangulaciones2 :: Integer -> Integer
numeroTriangulaciones2 n = 
  head (sucNumeroTriangulacionesInversas `genericIndex` (n-2))

--    λ> mapM_ print (take 10 sucNumeroTriangulacionesInversas)
--    [1]
--    [1,1]
--    [2,1,1]
--    [5,2,1,1]
--    [14,5,2,1,1]
--    [42,14,5,2,1,1]
--    [132,42,14,5,2,1,1]
--    [429,132,42,14,5,2,1,1]
--    [1430,429,132,42,14,5,2,1,1]
--    [4862,1430,429,132,42,14,5,2,1,1]
sucNumeroTriangulacionesInversas :: [[Integer]]        
sucNumeroTriangulacionesInversas = iterate f [1]
  where f ts = sum (zipWith (*) ts (reverse ts)) : ts

-- 3ª solución (con programación dinámica)
-- =======================================

numeroTriangulaciones3 :: Integer -> Integer
numeroTriangulaciones3 n = vectorTriang n ! n

--    λ> vectorTriang 9
--    array (2,9) [(2,1),(3,1),(4,2),(5,5),(6,14),(7,42),(8,132),(9,429)]
vectorTriang :: Integer -> Array Integer Integer
vectorTriang n = v
  where v = array (2,n) [(i, f i) | i <-[2..n]]
        f 2 = 1
        f i = sum [v!j*v!(i-j+1) | j <-[2..i-1]]

-- 4ª solución (con los números de Catalan)
-- ========================================

-- Al calcular por primeros números de triangulaciones se obtiene
--    λ> map numeroTriangulaciones [2..12]
--    [1,1,2,5,14,42,132,429,1430,4862,16796]
-- Se observa que se corresponden con los números de Catalan
-- http://bit.ly/2FOc1S1
-- 
-- El n-ésimo número de Catalan es
--    (2n)! / (n! * (n+1)!)
-- El número de triangulaciones de un polígono de n lados es el
-- (n-2)-ésimo número de Catalan.

numeroTriangulaciones4 :: Integer -> Integer
numeroTriangulaciones4 n = numeroCatalan (n-2) 

numeroCatalan :: Integer -> Integer
numeroCatalan n =
  factorial (2*n) `div` (factorial (n+1) * factorial n)

factorial :: Integer -> Integer
factorial n = product [1..n]

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

numeroTriangulaciones5 :: Integer -> Integer
numeroTriangulaciones5 n = v V.! (m-2)
   where v = V.constructN m
           (\w -> if   V.null w then 1
                  else V.sum (V.zipWith (*) w (V.reverse w)))
         m = fromIntegral n


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

numeroTriangulaciones6 :: Integer -> Integer
numeroTriangulaciones6 n = nCr (2*n-4, n-2) `div` (n-1)
  where nCr (n,m)   = factorial n `div` (factorial (n-m) * factorial m)
        factorial n = product [1..n]

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

--    λ> numeroTriangulaciones 22
--    6564120420
--    (3.97 secs, 668,070,936 bytes)
--    λ> numeroTriangulaciones2 22
--    6564120420
--    (0.01 secs, 180,064 bytes)
--    λ> numeroTriangulaciones3 22
--    6564120420
--    (0.01 secs, 285,792 bytes)
--    
--    λ> length (show (numeroTriangulaciones2 800))
--    476
--    (0.59 secs, 125,026,824 bytes)
--    λ> length (show (numeroTriangulaciones3 800))
--    476
--    (1.95 secs, 334,652,936 bytes)
--    λ> length (show (numeroTriangulaciones4 800))
--    476
--    (0.01 secs, 2,960,088 bytes)
--    λ> length (show (numeroTriangulaciones5 800))
--    476
--    (0.65 secs, 200,415,640 bytes)
--    λ> length (show (numeroTriangulaciones6 800))
--    476
--    (0.01 secs, 2,960,224 bytes)
--    
--    λ> length (show (numeroTriangulaciones4 (10^4)))
--    6014
--    (1.80 secs, 542,364,320 bytes)
--    λ> length (show (numeroTriangulaciones6 (10^4)))
--    6014
--    (1.87 secs, 542,351,136 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

import Data.Array (Array, (!), array)

import Data.List (genericIndex)

import qualified Data.Vector as V

-- 1ª solución (por recursión)

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

numeroTriangulaciones :: Integer -> Integer

numeroTriangulaciones 2 = 1

numeroTriangulaciones n = sum (zipWith (*) ts (reverse ts))

where ts = [numeroTriangulaciones k | k <- [2..n-1]]

-- 2ª solución

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

-- λ> map numeroTriangulaciones2 [2..15]

-- [1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900]

numeroTriangulaciones2 :: Integer -> Integer

numeroTriangulaciones2 n =

head (sucNumeroTriangulacionesInversas `genericIndex` (n-2))

-- λ> mapM_ print (take 10 sucNumeroTriangulacionesInversas)

-- [1]

-- [1,1]

-- [2,1,1]

-- [5,2,1,1]

-- [14,5,2,1,1]

-- [42,14,5,2,1,1]

-- [132,42,14,5,2,1,1]

-- [429,132,42,14,5,2,1,1]

-- [1430,429,132,42,14,5,2,1,1]

-- [4862,1430,429,132,42,14,5,2,1,1]

sucNumeroTriangulacionesInversas :: [[Integer]]

sucNumeroTriangulacionesInversas = iterate f [1]

where f ts = sum (zipWith (*) ts (reverse ts)) : ts

-- 3ª solución (con programación dinámica)

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

numeroTriangulaciones3 :: Integer -> Integer

numeroTriangulaciones3 n = vectorTriang n ! n

-- λ> vectorTriang 9

-- array (2,9) [(2,1),(3,1),(4,2),(5,5),(6,14),(7,42),(8,132),(9,429)]

vectorTriang :: Integer -> Array Integer Integer

vectorTriang n = v

where v = array (2,n) [(i, f i) | i <-[2..n]]

f 2 = 1

f i = sum [v!j*v!(i-j+1) | j <-[2..i-1]]

-- 4ª solución (con los números de Catalan)

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

-- Al calcular por primeros números de triangulaciones se obtiene

-- λ> map numeroTriangulaciones [2..12]

-- [1,1,2,5,14,42,132,429,1430,4862,16796]

-- Se observa que se corresponden con los números de Catalan

-- http://bit.ly/2FOc1S1

-- El n-ésimo número de Catalan es

-- (2n)! / (n! * (n+1)!)

-- El número de triangulaciones de un polígono de n lados es el

-- (n-2)-ésimo número de Catalan.

numeroTriangulaciones4 :: Integer -> Integer

numeroTriangulaciones4 n = numeroCatalan (n-2)

numeroCatalan :: Integer -> Integer

numeroCatalan n =

factorial (2*n) `div` (factorial (n+1) * factorial n)

factorial :: Integer -> Integer

factorial n = product [1..n]

-- 5ª solución

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

numeroTriangulaciones5 :: Integer -> Integer

numeroTriangulaciones5 n = v V.! (m-2)

where v = V.constructN m

(\w -> if V.null w then 1

else V.sum (V.zipWith (*) w (V.reverse w)))

m = fromIntegral n

-- 6ª solución

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

numeroTriangulaciones6 :: Integer -> Integer

numeroTriangulaciones6 n = nCr (2*n-4, n-2) `div` (n-1)

where nCr (n,m) = factorial n `div` (factorial (n-m) * factorial m)

factorial n = product [1..n]

-- Comparación de eficiencia

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

-- λ> numeroTriangulaciones 22

-- 6564120420

-- (3.97 secs, 668,070,936 bytes)

-- λ> numeroTriangulaciones2 22

-- 6564120420

-- (0.01 secs, 180,064 bytes)

-- λ> numeroTriangulaciones3 22

-- 6564120420

-- (0.01 secs, 285,792 bytes)

-- λ> length (show (numeroTriangulaciones2 800))

-- 476

-- (0.59 secs, 125,026,824 bytes)

-- λ> length (show (numeroTriangulaciones3 800))

-- 476

-- (1.95 secs, 334,652,936 bytes)

-- λ> length (show (numeroTriangulaciones4 800))

-- 476

-- (0.01 secs, 2,960,088 bytes)

-- λ> length (show (numeroTriangulaciones5 800))

-- 476

-- (0.65 secs, 200,415,640 bytes)

-- λ> length (show (numeroTriangulaciones6 800))

-- 476

-- (0.01 secs, 2,960,224 bytes)

-- λ> length (show (numeroTriangulaciones4 (10^4)))

-- 6014

-- (1.80 secs, 542,364,320 bytes)

-- λ> length (show (numeroTriangulaciones6 (10^4)))

-- 6014

-- (1.87 secs, 542,351,136 bytes)

Las sucesiones de Loomis

PorJosé A. Alonso 30-abril-201825-abril-2021

La sucesión de Loomis generada por un número entero positivo x es la sucesión cuyos términos se definen por

f(0) es x
f(n) es la suma de f(n-1) y el producto de los dígitos no nulos de f(n-1)

Los primeros términos de las primeras sucesiones de Loomis son

Generada por 1: 1, 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, …
Generada por 2: 2, 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 3: 3, 6, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, …
Generada por 4: 4, 8, 16, 22, 26, 38, 62, 74, 102, 104, 108, 116, 122, 126, 138, …
Generada por 5: 5, 10, 11, 12, 14, 18, 26, 38, 62, 74, 102, 104, 108, 116, 122, …

Se observa que a partir de un término todas coinciden con la generada por 1. Dicho término se llama el punto de convergencia. Por ejemplo,

la generada por 2 converge a 2
la generada por 3 converge a 26
la generada por 4 converge a 4
la generada por 5 converge a 26

Definir las siguientes funciones

   sucLoomis           :: Integer -> [Integer]
   convergencia        :: Integer -> Integer
   graficaConvergencia :: [Integer] -> IO ()

sucLoomis :: Integer -> [Integer]

convergencia :: Integer -> Integer

graficaConvergencia :: [Integer] -> IO ()

tales que

(sucLoomis x) es la sucesión de Loomis generada por x. Por ejemplo,

     λ> take 15 (sucLoomis 1)
     [1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 2)
     [2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 3)
     [3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]
     λ> take 15 (sucLoomis 4)
     [4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]
     λ> take 15 (sucLoomis 5)
     [5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]
     λ> take 15 (sucLoomis 20)
     [20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]
     λ> take 15 (sucLoomis 100)
     [100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]
     λ> sucLoomis 1 !! (2*10^5)
     235180736652

λ> take 15 (sucLoomis 1)

[1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 2)

[2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 3)

[3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]

λ> take 15 (sucLoomis 4)

[4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]

λ> take 15 (sucLoomis 5)

[5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]

λ> take 15 (sucLoomis 20)

[20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]

λ> take 15 (sucLoomis 100)

[100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]

λ> sucLoomis 1 !! (2*10^5)

235180736652

(convergencia x) es el término de convergencia de la sucesioń de Loomis generada por x xon la geerada por 1. Por ejemplo,

     convergencia  2      ==  2
     convergencia  3      ==  26
     convergencia  4      ==  4
     convergencia 17      ==  38
     convergencia 19      ==  102
     convergencia 43      ==  162
     convergencia 27      ==  202
     convergencia 58      ==  474
     convergencia 63      ==  150056
     convergencia 81      ==  150056
     convergencia 89      ==  150056
     convergencia (10^12) ==  1000101125092

convergencia 2 == 2

convergencia 3 == 26

convergencia 4 == 4

convergencia 17 == 38

convergencia 19 == 102

convergencia 43 == 162

convergencia 27 == 202

convergencia 58 == 474

convergencia 63 == 150056

convergencia 81 == 150056

convergencia 89 == 150056

convergencia (10^12) == 1000101125092

(graficaConvergencia xs) dibuja la gráfica de los términos de convergencia de las sucesiones de Loomis generadas por los elementos de xs. Por ejemplo, (graficaConvergencia ([1..50]) dibuja

y graficaConvergencia ([1..148] \ [63,81,89,137]) dibuja

Soluciones

import Data.List               ((\\))
import Data.Char               (digitToInt)
import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG))

-- 1ª definición de sucLoomis
-- ==========================

sucLoomis :: Integer -> [Integer]
sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer
loomis x 0 = x
loomis x n = y + productoDigitosNoNulos y
  where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer
productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]
digitosNoNulos x =
  [read [c] | c <- show x, c /= '0']

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

sucLoomis2 :: Integer -> [Integer]
sucLoomis2 = iterate siguienteLoomis 

siguienteLoomis :: Integer -> Integer
siguienteLoomis y = y + productoDigitosNoNulos y

-- 3ª definición de sucLoomis
-- ==========================

sucLoomis3 :: Integer -> [Integer]
sucLoomis3 =
  iterate ((+) <*> product .
           map (toInteger . digitToInt) .
           filter (/= '0') . show)


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

--    λ> sucLoomis 1 !! 30000
--    6571272766
--    (2.45 secs, 987,955,944 bytes)
--    λ> sucLoomis2 1 !! 30000
--    6571272766
--    (2.26 secs, 979,543,328 bytes)
--    λ> sucLoomis3 1 !! 30000
--    6571272766
--    (0.31 secs, 88,323,832 bytes)

-- 1ª definición de convergencia
-- =============================

convergencia1 :: Integer -> Integer
convergencia1 x =
  head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool
noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]
sucLoomisDe1 = sucLoomis 1

pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)

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

convergencia2 :: Integer -> Integer
convergencia2 = aux (sucLoomis3 1) . sucLoomis3
 where aux as@(x:xs) bs@(y:ys) | x == y    = x
                               | x < y     = aux xs bs
                               | otherwise = aux as ys

-- 3ª definición de convergencia
-- =============================

convergencia3 :: Integer -> Integer
convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3
 
-- (interseccion xs ys) es la intersección entre las listas ordenadas xs
-- e ys. Por ejemplo,
--    λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))
--    [2,4,8,16,22,26,38,62,74,102]
interseccion :: Ord a => [a] -> [a] -> [a]
interseccion = aux
  where aux as@(x:xs) bs@(y:ys) = case compare x y of
                                    LT ->     aux xs bs
                                    EQ -> x : aux xs ys
                                    GT ->     aux as ys
        aux _         _         = []                           

-- 4ª definición de convergencia
-- =============================

convergencia4 :: Integer -> Integer
convergencia4 x = perteneceA (sucLoomis3 x) 1
  where perteneceA (y:ys) n | y == c    = y
                            | otherwise = perteneceA ys c
          where c = head $ dropWhile (< y) $ sucLoomis3 n

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

--    λ> convergencia1 (10^4)
--    150056
--    (2.94 secs, 1,260,809,808 bytes)
--    λ> convergencia2 (10^4)
--    150056
--    (0.03 secs, 700,240 bytes)
--    λ> convergencia3 (10^4)
--    150056
--    (0.03 secs, 1,165,496 bytes)
--    λ> convergencia4 (10^4)
--    150056
--    (0.02 secs, 1,119,648 bytes)
--    
--    λ> convergencia2 (10^12)
--    1000101125092
--    (1.81 secs, 714,901,080 bytes)
--    λ> convergencia3 (10^12)
--    1000101125092
--    (1.92 secs, 744,932,184 bytes)
--    λ> convergencia4 (10^12)
--    1000101125092
--    (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia
-- ==================================

graficaConvergencia :: [Integer] -> IO ()
graficaConvergencia xs =
  plotList [ Key Nothing
           , Title "Convergencia de sucesiones de Loomis"
           , XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))
           , PNG "Las_sucesiones_de_Loomis_2.png"
           ]
           [(x,convergencia2 x) | x <- xs]

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

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

import Data.List ((\\))

import Data.Char (digitToInt)

import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG))

-- 1ª definición de sucLoomis

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

sucLoomis :: Integer -> [Integer]

sucLoomis x = map (loomis x) [0..]

loomis :: Integer -> Integer -> Integer

loomis x 0 = x

loomis x n = y + productoDigitosNoNulos y

where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer

productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]

digitosNoNulos x =

[read [c] | c <- show x, c /= '0']

-- 2ª definición de sucLoomis

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

sucLoomis2 :: Integer -> [Integer]

sucLoomis2 = iterate siguienteLoomis

siguienteLoomis :: Integer -> Integer

siguienteLoomis y = y + productoDigitosNoNulos y

-- 3ª definición de sucLoomis

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

sucLoomis3 :: Integer -> [Integer]

sucLoomis3 =

iterate ((+) <*> product .

map (toInteger . digitToInt) .

filter (/= '0') . show)

-- Comparación de eficiencia

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

-- λ> sucLoomis 1 !! 30000

-- 6571272766

-- (2.45 secs, 987,955,944 bytes)

-- λ> sucLoomis2 1 !! 30000

-- 6571272766

-- (2.26 secs, 979,543,328 bytes)

-- λ> sucLoomis3 1 !! 30000

-- 6571272766

-- (0.31 secs, 88,323,832 bytes)

-- 1ª definición de convergencia

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

convergencia1 :: Integer -> Integer

convergencia1 x =

head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool

noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]

sucLoomisDe1 = sucLoomis 1

pertenece :: Integer -> [Integer] -> Bool

pertenece x ys =

x == head (dropWhile (<x) ys)

-- 2ª definición de convergencia

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

convergencia2 :: Integer -> Integer

convergencia2 = aux (sucLoomis3 1) . sucLoomis3

where aux as@(x:xs) bs@(y:ys) | x == y = x

| x < y = aux xs bs

| otherwise = aux as ys

-- 3ª definición de convergencia

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

convergencia3 :: Integer -> Integer

convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3

-- (interseccion xs ys) es la intersección entre las listas ordenadas xs

-- e ys. Por ejemplo,

-- λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2))

-- [2,4,8,16,22,26,38,62,74,102]

interseccion :: Ord a => [a] -> [a] -> [a]

interseccion = aux

where aux as@(x:xs) bs@(y:ys) = case compare x y of

LT -> aux xs bs

EQ -> x : aux xs ys

GT -> aux as ys

aux _ _ = []

-- 4ª definición de convergencia

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

convergencia4 :: Integer -> Integer

convergencia4 x = perteneceA (sucLoomis3 x) 1

where perteneceA (y:ys) n | y == c = y

| otherwise = perteneceA ys c

where c = head $ dropWhile (< y) $ sucLoomis3 n

-- Comparación de eficiencia

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

-- λ> convergencia1 (10^4)

-- 150056

-- (2.94 secs, 1,260,809,808 bytes)

-- λ> convergencia2 (10^4)

-- 150056

-- (0.03 secs, 700,240 bytes)

-- λ> convergencia3 (10^4)

-- 150056

-- (0.03 secs, 1,165,496 bytes)

-- λ> convergencia4 (10^4)

-- 150056

-- (0.02 secs, 1,119,648 bytes)

-- λ> convergencia2 (10^12)

-- 1000101125092

-- (1.81 secs, 714,901,080 bytes)

-- λ> convergencia3 (10^12)

-- 1000101125092

-- (1.92 secs, 744,932,184 bytes)

-- λ> convergencia4 (10^12)

-- 1000101125092

-- (1.82 secs, 941,053,328 bytes)

-- Definición de graficaConvergencia

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

graficaConvergencia :: [Integer] -> IO ()

graficaConvergencia xs =

plotList [ Key Nothing

, Title "Convergencia de sucesiones de Loomis"

, XRange (fromIntegral (minimum xs),fromIntegral (maximum xs))

, PNG "Las_sucesiones_de_Loomis_2.png"

]

[(x,convergencia2 x) | x <- xs]

Sucesión de antecesores y sucesores

PorJosé A. Alonso 2-abril-20189-abril-2018

Definir la lista

   antecesoresYsucesores :: [[Integer]]

1	antecesoresYsucesores :: [[Integer]]

cuyos elementos son

   [[1],[0,2],[-1,1,1,3],[-2,2,0,0,2,0,2,2,4],...]

1	[[1],[0,2],[-1,1,1,3],[-2,2,0,0,2,0,2,2,4],...]

donde cada una de las listas se obtiene de la anterior sustituyendo cada elemento por su antecesor y su sucesor; es decir, el 1 por el 0 y el 2, el 0 por el -1 y el 1, el 2 por el 1 y el 3, etc. Por ejemplo,

   λ> take 4 antecesoresYsucesores
   [[1],[0,2],[-1,1,1,3],[-2,0,0,2,0,2,2,4]]

1 2	λ> take 4 antecesoresYsucesores [[1],[0,2],[-1,1,1,3],[-2,0,0,2,0,2,2,4]]

Comprobar con Quickcheck que la suma de los elementos de la lista n-ésima de antecesoresYsucesores es 2^n.

Nota. Limitar la búsqueda a ejemplos pequeños usando

   quickCheckWith (stdArgs {maxSize=7}) prop_suma

1	quickCheckWith (stdArgs {maxSize=7}) prop_suma

Soluciones

import Test.QuickCheck

-- 1ª solución
antecesoresYsucesores :: [[Integer]]       
antecesoresYsucesores = 
  [1] : map (concatMap (\x -> [x-1,x+1])) antecesoresYsucesores

-- 2ª solución
antecesoresYsucesores2 :: [[Integer]]       
antecesoresYsucesores2 = 
  iterate (concatMap (\x -> [x-1,x+1])) [1]

-- La propiedad es
prop_suma :: (Positive Int) -> Bool
prop_suma (Positive n) =
  sum (antecesoresYsucesores2 !! n) == 2^n

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=7}) prop_suma
--    +++ OK, passed 100 tests.

import Test.QuickCheck

-- 1ª solución

antecesoresYsucesores :: [[Integer]]

antecesoresYsucesores =

[1] : map (concatMap (\x -> [x-1,x+1])) antecesoresYsucesores

-- 2ª solución

antecesoresYsucesores2 :: [[Integer]]

antecesoresYsucesores2 =

iterate (concatMap (\x -> [x-1,x+1])) [1]

-- La propiedad es

prop_suma :: (Positive Int) -> Bool

prop_suma (Positive n) =

sum (antecesoresYsucesores2 !! n) == 2^n

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=7}) prop_suma

-- +++ OK, passed 100 tests.

Generación de progresiones geométricas

PorJosé A. Alonso 26-febrero-20186-marzo-2018

Definir la función

   geometrica :: Int -> Int -> Int -> [Int]

1	geometrica :: Int -> Int -> Int -> [Int]

tal que (geometrica a b c) es la lista de los términos de la progresión geométrica cuyo primer término es a, su segundo término es b (que se supone que es múltiplo de a) y los términos son menores o iguales que c. Por ejemplo,

   geometrica 1 3  27   ==  [1,3,9,27]
   geometrica 2 6  100  ==  [2,6,18,54]
   geometrica 3 12 57   ==  [3,12,48]
   geometrica 4 20 253  ==  [4,20,100]
   geometrica 5 25 625  ==  [5,25,125,625]
   geometrica 6 42 42   ==  [6,42]

geometrica 1 3 27 == [1,3,9,27]

geometrica 2 6 100 == [2,6,18,54]

geometrica 3 12 57 == [3,12,48]

geometrica 4 20 253 == [4,20,100]

geometrica 5 25 625 == [5,25,125,625]

geometrica 6 42 42 == [6,42]

Soluciones

-- 1ª definición
geometrica :: Int -> Int -> Int -> [Int]
geometrica a b c =
  takeWhile (<=c) (iterate (*r) a)
  where r = b `div` a

-- 2ª definición
geometrica2 :: Int -> Int -> Int -> [Int]
geometrica2 a b c = aux a b 
  where aux a b 
          | a > c     = []
          | otherwise = a : aux b (b * r)
        r = b `div` a

-- 1ª definición

geometrica :: Int -> Int -> Int -> [Int]

geometrica a b c =

takeWhile (<=c) (iterate (*r) a)

where r = b `div` a

-- 2ª definición

geometrica2 :: Int -> Int -> Int -> [Int]

geometrica2 a b c = aux a b

where aux a b

| a > c = []

| otherwise = a : aux b (b * r)

r = b `div` a

Menor potencia de 2 que comienza por n

PorJosé A. Alonso 22-febrero-201826-marzo-2022

Definir las funciones

   menorPotencia            :: Integer -> (Integer,Integer)
   graficaMenoresExponentes :: Integer -> IO ()

1 2	menorPotencia :: Integer -> (Integer,Integer) graficaMenoresExponentes :: Integer -> IO ()

tales que

(menorPotencia n) es el par (k,m) donde m es la menor potencia de 2 que empieza por n y k es su exponentes (es decir, 2^k = m). Por ejemplo,

     menorPotencia 3             ==  (5,32)
     menorPotencia 7             ==  (46,70368744177664)
     fst (menorPotencia 982)     ==  3973
     fst (menorPotencia 32627)   ==  28557
     fst (menorPotencia 158426)  ==  40000

menorPotencia 3 == (5,32)

menorPotencia 7 == (46,70368744177664)

fst (menorPotencia 982) == 3973

fst (menorPotencia 32627) == 28557

fst (menorPotencia 158426) == 40000

(graficaMenoresExponentes n) dibuja la gráfica de los exponentes de 2 en las menores potencias de los n primeros números enteros positivos. Por ejemplo, (graficaMenoresExponentes 200) dibuja

Soluciones

import Data.List               (isPrefixOf)
import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)

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

menorPotencia :: Integer -> (Integer,Integer)
menorPotencia n =
  head [(k,m) | (k,m) <- zip [0..] potenciasDe2
              , cs `isPrefixOf` show m]
  where cs = show n

-- potenciasDe 2 es la lista de las potencias de dos. Por ejemplo,
--    take 12 potenciasDe2  ==  [1,2,4,8,16,32,64,128,256,512,1024,2048]
potenciasDe2 :: [Integer]
potenciasDe2 = iterate (*2) 1

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

menorPotencia2 :: Integer -> (Integer,Integer)
menorPotencia2 n = aux (0,1)
  where aux (k,m) | cs `isPrefixOf` show m = (k,m)
                  | otherwise              = aux (k+1,2*m)
        cs = show n

-- 3ª definición 
-- =============

menorPotencia3 :: Integer -> (Integer,Integer)
menorPotencia3 n =
  until (isPrefixOf n1 . show . snd) (\(x,y) -> (x+1,2*y)) (0,1)
  where n1 = show n

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

--    λ> maximum [fst (menorPotencia n) | n <- [1..1000]]
--    3973
--    (3.69 secs, 1,094,923,696 bytes)
--    λ> maximum [fst (menorPotencia2 n) | n <- [1..1000]]
--    3973
--    (5.13 secs, 1,326,382,872 bytes)
--    λ> maximum [fst (menorPotencia3 n) | n <- [1..1000]]
--    3973
--    (4.71 secs, 1,240,498,128 bytes)

graficaMenoresExponentes :: Integer -> IO ()
graficaMenoresExponentes n =
  plotList [ Key Nothing
           , PNG "Menor_potencia_de_2_que_comienza_por_n.png"
           ]
           (map (fst . menorPotencia) [1..n])

import Data.List (isPrefixOf)

import Graphics.Gnuplot.Simple (Attribute (Key, PNG), plotList)

-- 1ª definición

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

menorPotencia :: Integer -> (Integer,Integer)

menorPotencia n =

head [(k,m) | (k,m) <- zip [0..] potenciasDe2

, cs `isPrefixOf` show m]

where cs = show n

-- potenciasDe 2 es la lista de las potencias de dos. Por ejemplo,

-- take 12 potenciasDe2 == [1,2,4,8,16,32,64,128,256,512,1024,2048]

potenciasDe2 :: [Integer]

potenciasDe2 = iterate (*2) 1

-- 2ª definición

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

menorPotencia2 :: Integer -> (Integer,Integer)

menorPotencia2 n = aux (0,1)

where aux (k,m) | cs `isPrefixOf` show m = (k,m)

| otherwise = aux (k+1,2*m)

cs = show n

-- 3ª definición

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

menorPotencia3 :: Integer -> (Integer,Integer)

menorPotencia3 n =

until (isPrefixOf n1 . show . snd) (\(x,y) -> (x+1,2*y)) (0,1)

where n1 = show n

-- Comparación de eficiencia

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

-- λ> maximum [fst (menorPotencia n) | n <- [1..1000]]

-- 3973

-- (3.69 secs, 1,094,923,696 bytes)

-- λ> maximum [fst (menorPotencia2 n) | n <- [1..1000]]

-- 3973

-- (5.13 secs, 1,326,382,872 bytes)

-- λ> maximum [fst (menorPotencia3 n) | n <- [1..1000]]

-- 3973

-- (4.71 secs, 1,240,498,128 bytes)

graficaMenoresExponentes :: Integer -> IO ()

graficaMenoresExponentes n =

plotList [ Key Nothing

, PNG "Menor_potencia_de_2_que_comienza_por_n.png"

]

(map (fst . menorPotencia) [1..n])

Celdas interiores de una retícula

PorJosé A. Alonso 5-febrero-201812-febrero-2018

Las celdas de una retícula cuadrada se numeran consecutivamente. Por ejemplo, la numeración de la retícula cuadrada de lado 4 es

   1, 2, 3, 4
   5, 6, 7, 8
   9,10,11,12
  13,14,15,16

1, 2, 3, 4

5, 6, 7, 8

9,10,11,12

13,14,15,16

Los números de sus celdas interiores son 6,7,10,11.

Definir la función

   interiores :: Int -> [Int]

1	interiores :: Int -> [Int]

tal que (interiores n) es la lista de los números de las celdas interiores de la retícula cuadrada de lado n. Por ejemplo,

   interiores 4  == [6,7,10,11]
   interiores 5  == [7,8,9,12,13,14,17,18,19]
   interiores 6  == [8,9,10,11,14,15,16,17,20,21,22,23,26,27,28,29]
   interiores 2  == []
   length (interiores 2018)  == 4064256

interiores 4 == [6,7,10,11]

interiores 5 == [7,8,9,12,13,14,17,18,19]

interiores 6 == [8,9,10,11,14,15,16,17,20,21,22,23,26,27,28,29]

interiores 2 == []

length (interiores 2018) == 4064256

Comprobar con QuickCheck que el número de celdas interiores de la retícula cuadrada de lado n, con n > 1, es (n-2)^2.

Soluciones

import Test.QuickCheck
import Data.List.Split (divvy)

-- 1ª solución
interiores :: Int -> [Int]
interiores n = [i | i <- [n..n*n-n], i `mod` n > 1]

-- 2ª solución
interiores2 :: Int -> [Int]
interiores2 n = aux [n+1..n^2-n]
  where aux xss@(x:xs) = take (n-2) xs ++ aux (drop n xss)
        aux []         = []

-- 3ª solución 
interiores3 :: Int -> [Int]
interiores3 n = concat (divvy (n-2) n [n+2..n*(n-1)-1])

-- 4ª solución
interiores4 :: Int -> [Int]
interiores4 n = concat [map (+(n*k)) [2..n-1] | k <- [1..n-2]]

-- 5ª solución
interiores5 :: Int -> [Int]
interiores5 n = concat (take (n-2) (iterate (map (+n)) [n+2..2*n-1]))

-- La propiedad es
prop_interiores :: Int -> Property
prop_interiores n =
  n > 1 ==> length (interiores n) == (n-2)^2

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

import Test.QuickCheck

import Data.List.Split (divvy)

-- 1ª solución

interiores :: Int -> [Int]

interiores n = [i | i <- [n..n*n-n], i `mod` n > 1]

-- 2ª solución

interiores2 :: Int -> [Int]

interiores2 n = aux [n+1..n^2-n]

where aux xss@(x:xs) = take (n-2) xs ++ aux (drop n xss)

aux [] = []

-- 3ª solución

interiores3 :: Int -> [Int]

interiores3 n = concat (divvy (n-2) n [n+2..n*(n-1)-1])

-- 4ª solución

interiores4 :: Int -> [Int]

interiores4 n = concat [map (+(n*k)) [2..n-1] | k <- [1..n-2]]

-- 5ª solución

interiores5 :: Int -> [Int]

interiores5 n = concat (take (n-2) (iterate (map (+n)) [n+2..2*n-1]))

-- La propiedad es

prop_interiores :: Int -> Property

prop_interiores n =

n > 1 ==> length (interiores n) == (n-2)^2

-- La comprobación es

-- λ> quickCheck prop_interiores

-- +++ OK, passed 100 tests.

Fractal hexagonal

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

Escribir, usando CodeWorld, un programa para dibujar el fractal hexagonal que se muestra en la siguiente animación

Las 4 primeras fases de la animación son

Fase 0:
Fase 1:
Fase 2:
Fase 3:

Nota: Este ejercicio ha sido propuesto por Agustín Martín Aguera.

Soluciones

import CodeWorld

main :: IO()
main = animationOf (hexagono . s)

hexagono :: Int -> Picture
hexagono 0 =
  colored red $ solidPolygon [(9,0),(4.5,c),(-4.5,c),(-9,0),(-4.5,-c),(4.5,-c)]
  where c = 9 * sin (pi / 3)
hexagono n =
  pictures (hex : take 6 (iterate (rotated (pi / 3)) (translated 6 0 hex)))
  where hex = scaled (1/3) (1/3) $ hexagono (n-1)

s :: Double -> Int
s t = mod (floor t) 5

import CodeWorld

main :: IO()

main = animationOf (hexagono . s)

hexagono :: Int -> Picture

hexagono 0 =

colored red $ solidPolygon [(9,0),(4.5,c),(-4.5,c),(-9,0),(-4.5,-c),(4.5,-c)]

where c = 9 * sin (pi / 3)

hexagono n =

pictures (hex : take 6 (iterate (rotated (pi / 3)) (translated 6 0 hex)))

where hex = scaled (1/3) (1/3) $ hexagono (n-1)

s :: Double -> Int

s t = mod (floor t) 5

Enumeración de los números enteros

PorJosé A. Alonso 9-enero-201825-marzo-2022

Definir la sucesión

   enteros :: [Int]

1	enteros :: [Int]

tal que sus elementos son los números enteros comenzando en el 0 e intercalando los positivos y los negativos. Por ejemplo,

   ghci> take 23 enteros
   [0,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10,11,-11]

1 2	ghci> take 23 enteros [0,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8,9,-9,10,-10,11,-11]

Comprobar con QuickCheck que el n-ésimo término de la sucesión es
(1-(2*n+1)*(-1)^n)/4.

Nota. En la comprobación usar

   quickCheckWith (stdArgs {maxSize=7}) prop_enteros

1	quickCheckWith (stdArgs {maxSize=7}) prop_enteros

Soluciones

import Test.QuickCheck
import Control.Applicative ((<**>))

-- 1ª definición
enteros :: [Int]
enteros = 0 : concat [[n,-n] | n <- [1..]]

-- 2ª definición
enteros2 :: [Int]
enteros2 = 0 : [y | x <- [1..], y <- [x, -x]]

-- 3ª definición
enteros3 :: [Int]
enteros3 = iterate siguiente 0
  where siguiente i | i > 0     = -i
                    | otherwise = 1 - i

-- 4ª definición
enteros4 :: [Int]
enteros4 = iterate (\i -> if i > 0 then -i else 1-i) 0

-- 5ª definición
enteros5 :: [Int]
enteros5 = 0 : [f x | x <- [1..], f <- [id, negate]]

-- 6ª definición
enteros6 :: [Int]
enteros6 = 0 : ([1..] <**> [id, negate])

-- La propiedad es
prop_enteros :: Int -> Property
prop_enteros n = 
    n >= 0 ==> enteros !! n == (1-(2*n+1)*(-1)^n) `div` 4

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_enteros
--    +++ OK, passed 100 tests.

import Test.QuickCheck

import Control.Applicative ((<**>))

-- 1ª definición

enteros :: [Int]

enteros = 0 : concat [[n,-n] | n <- [1..]]

-- 2ª definición

enteros2 :: [Int]

enteros2 = 0 : [y | x <- [1..], y <- [x, -x]]

-- 3ª definición

enteros3 :: [Int]

enteros3 = iterate siguiente 0

where siguiente i | i > 0 = -i

| otherwise = 1 - i

-- 4ª definición

enteros4 :: [Int]

enteros4 = iterate (\i -> if i > 0 then -i else 1-i) 0

-- 5ª definición

enteros5 :: [Int]

enteros5 = 0 : [f x | x <- [1..], f <- [id, negate]]

-- 6ª definición

enteros6 :: [Int]

enteros6 = 0 : ([1..] <**> [id, negate])

-- La propiedad es

prop_enteros :: Int -> Property

prop_enteros n =

n >= 0 ==> enteros !! n == (1-(2*n+1)*(-1)^n) `div` 4

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_enteros

-- +++ OK, passed 100 tests.

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

Soluciones

Soluciones

Soluciones

Nuevas soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Referencia

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Referencia

Pensamiento

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Entradas recientes

Buscar

Correo electrónico