abril 2021 – Exercitium

Números potencias perfectas de la suma de sus dígitos

PorJosé A. Alonso 30-abril-20217-mayo-2021

El número 2401 es una potencia de la suma de sus dígitos, ya que dicha suma es 7 y 7^4 = 2401.

Definir la lista

   potenciaSumaDigitos :: [Integer]

1	potenciaSumaDigitos :: [Integer]

cuyos elementos son los números que son potencias de las sumas de sus dígitos. Por ejemplo,

   λ> take 17 potenciaSumaDigitos
   [0,1,2,3,4,5,6,7,8,9,81,512,2401,4913,5832,17576,19683]

1 2	λ> take 17 potenciaSumaDigitos [0,1,2,3,4,5,6,7,8,9,81,512,2401,4913,5832,17576,19683]

Soluciones

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

potenciaSumaDigitos :: [Integer]
potenciaSumaDigitos = 0 : filter esPotenciaSumaDigitos [0..]

-- (esPotenciaSumaDigitos n) se verifica si n es una potencia de la suma
-- de sus dígitos. Por ejemplo,
--    esPotenciaSumaDigitos 2401  ==  True
--    esPotenciaSumaDigitos 2402  ==  False
esPotenciaSumaDigitos :: Integer -> Bool
esPotenciaSumaDigitos n =
  or [n == x^k | k <- [1..n]]
  where x = sumaDigitos n

-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,
--    sumaDigitos 2021  ==  5
sumaDigitos :: Integer -> Integer
sumaDigitos = sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 2021  ==  [2,0,2,1]
digitos :: Integer -> [Integer]
digitos x = [read [c] | c <- show x]

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

potenciaSumaDigitos2 :: [Integer]
potenciaSumaDigitos2 = 0 : 1 : filter esPotenciaSumaDigitos2 [2..]

-- (esPotenciaSumaDigitos2 n) se verifica si n es una potencia de la suma
-- de sus dígitos. Por ejemplo,
--    esPotenciaSumaDigitos2 2401  ==  True
--    esPotenciaSumaDigitos2 2402  ==  False
esPotenciaSumaDigitos2 :: Integer -> Bool
esPotenciaSumaDigitos2 n =
  n == x^k
  where x = sumaDigitos n
        k = round (logBase (fromIntegral x) (fromIntegral n))

-- 1ª solución

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

potenciaSumaDigitos :: [Integer]

potenciaSumaDigitos = 0 : filter esPotenciaSumaDigitos [0..]

-- (esPotenciaSumaDigitos n) se verifica si n es una potencia de la suma

-- de sus dígitos. Por ejemplo,

-- esPotenciaSumaDigitos 2401 == True

-- esPotenciaSumaDigitos 2402 == False

esPotenciaSumaDigitos :: Integer -> Bool

esPotenciaSumaDigitos n =

or [n == x^k | k <- [1..n]]

where x = sumaDigitos n

-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,

-- sumaDigitos 2021 == 5

sumaDigitos :: Integer -> Integer

sumaDigitos = sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 2021 == [2,0,2,1]

digitos :: Integer -> [Integer]

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

-- 2ª solución

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

potenciaSumaDigitos2 :: [Integer]

potenciaSumaDigitos2 = 0 : 1 : filter esPotenciaSumaDigitos2 [2..]

-- (esPotenciaSumaDigitos2 n) se verifica si n es una potencia de la suma

-- de sus dígitos. Por ejemplo,

-- esPotenciaSumaDigitos2 2401 == True

-- esPotenciaSumaDigitos2 2402 == False

esPotenciaSumaDigitos2 :: Integer -> Bool

esPotenciaSumaDigitos2 n =

n == x^k

where x = sumaDigitos n

k = round (logBase (fromIntegral x) (fromIntegral n))

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>

Órbita con raíz entera (OME1997 P4)

PorJosé A. Alonso 29-abril-20216-mayo-2021

El enunciado del problema 4 de la OME (Olimpiada Matemática Española) del 1997 es

Sea p un número primo. Determinar todos los enteros k tales que sqrt(k² – k*p) es natural.

Definir las funciones

   orbita        :: Integer -> [Integer]
   orbitaDePrimo :: Integer -> [Integer]

1 2	orbita :: Integer -> [Integer] orbitaDePrimo :: Integer -> [Integer]

tales que

(orbita n) es la lista de todos los enteros k tales que sqrt(k² – k*n) es natural. Por ejemplo,

     take 4  (orbita 6)   == [0,-2,6,8]
     take 5  (orbita 36)  == [0,-12,36,48,-64]
     take 6  (orbita 9)   == [0,-3,9,12,-16,25]
     take 8  (orbita 27)  == [0,-9,27,36,-48,75,-169,196]
     take 10 (orbita 111) == [0,-37,111,148,-289,400,-972,1083,-3025,3136]

take 4 (orbita 6) == [0,-2,6,8]

take 5 (orbita 36) == [0,-12,36,48,-64]

take 6 (orbita 9) == [0,-3,9,12,-16,25]

take 8 (orbita 27) == [0,-9,27,36,-48,75,-169,196]

take 10 (orbita 111) == [0,-37,111,148,-289,400,-972,1083,-3025,3136]

(orbitaDePrimo p) es la lista de todos los enteros k tales que sqrt(k² – k*p) es natural, suponiendo que p es un número primo. Por ejemplo,

     orbitaDePrimo 5                  == [0,-4,5,9]
     orbitaDePrimo (primes !! (10^6)) == [0,15485867,-59953011442489,59953026928356]

1 2	orbitaDePrimo 5 == [0,-4,5,9] orbitaDePrimo (primes !! (10^6)) == [0,15485867,-59953011442489,59953026928356]

Soluciones

import Data.Numbers.Primes (primes)

orbita :: Integer -> [Integer]
orbita n =
  [k | k <- enteros,
       k^2 - k*n >= 0,
       esCuadrado (k^2 - k*n)]

-- entero es la lista de los números enteros. Por ejemplo,
--    λ> take 20 enteros
--    [0,-1,1,-2,2,-3,3,-4,4,-5,5,-6,6,-7,7,-8,8,-9,9,-10]
enteros :: [Integer]
enteros = 0 : concat [[-n,n] | n <- [1..]]

-- (esCuadrado x) se verifica si x es un cuadrado perfecto. Por
-- ejemplo,
--    esCuadrado 16  ==  True
--    esCuadrado 27  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x =
  (raizEntera x)^2 == x

-- (raizEntera x) es el mayor entero cuyo cuadrado es menor o igual que
-- x. Por ejemplo,
--    raizEntera 16  ==  4
--    raizEntera 27  ==  5
raizEntera :: Integer -> Integer
raizEntera x = aux (1,x)
    where aux (a,b) | d == x    = c
                    | c == a    = c
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c)
              where c = (a+b) `div` 2
                    d = c^2

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

orbitaDePrimo1 :: Integer -> [Integer]
orbitaDePrimo1 2 = take 2 (orbita 2)
orbitaDePrimo1 p = take 4 (orbita p)

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

-- Basada en los siguientes cálculos
--    orbitaDePrimo1 2  == [0,2]
--    orbitaDePrimo1 3  == [0,-1,3,4]
--    orbitaDePrimo1 5  == [0,-4,5,9]
--    orbitaDePrimo1 7  == [0, 7,  -9, 16]
--    orbitaDePrimo1 11 == [0,11, -25, 36]
--    orbitaDePrimo1 13 == [0,13, -36, 49]
--    orbitaDePrimo1 17 == [0,17, -64, 81]
--    orbitaDePrimo1 19 == [0,19, -81,100]
--    orbitaDePrimo1 23 == [0,23,-121,144]

orbitaDePrimo2 :: Integer -> [Integer]
orbitaDePrimo2 p
  | p == 2    = [0,2]
  | p <= 5    = [0, -((p-1) `div` 2)^2, p, ((p+1) `div` 2)^2]
  | otherwise = [0, p, -((p-1) `div` 2)^2, ((p+1) `div` 2)^2]

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

-- La comprobación es
--    λ> and [orbitaDePrimo1 n == orbitaDePrimo2 n | n <- take 30 primes]
--    True

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

-- La comparación es
--    λ> orbitaDePrimo1 (primes !! 100)
--    [0,547,-74529,75076]
--    (4.94 secs, 4,471,368,256 bytes)
--    λ> orbitaDePrimo2 (primes !! 100)
--    [0,547,-74529,75076]
--    (0.01 secs, 302,096 bytes)

import Data.Numbers.Primes (primes)

orbita :: Integer -> [Integer]

orbita n =

[k | k <- enteros,

k^2 - k*n >= 0,

esCuadrado (k^2 - k*n)]

-- entero es la lista de los números enteros. Por ejemplo,

-- λ> take 20 enteros

-- [0,-1,1,-2,2,-3,3,-4,4,-5,5,-6,6,-7,7,-8,8,-9,9,-10]

enteros :: [Integer]

enteros = 0 : concat [[-n,n] | n <- [1..]]

-- (esCuadrado x) se verifica si x es un cuadrado perfecto. Por

-- ejemplo,

-- esCuadrado 16 == True

-- esCuadrado 27 == False

esCuadrado :: Integer -> Bool

esCuadrado x =

(raizEntera x)^2 == x

-- (raizEntera x) es el mayor entero cuyo cuadrado es menor o igual que

-- x. Por ejemplo,

-- raizEntera 16 == 4

-- raizEntera 27 == 5

raizEntera :: Integer -> Integer

raizEntera x = aux (1,x)

where aux (a,b) | d == x = c

| c == a = c

| d < x = aux (c,b)

| otherwise = aux (a,c)

where c = (a+b) `div` 2

d = c^2

-- 1ª definición de orbitaDePrimo

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

orbitaDePrimo1 :: Integer -> [Integer]

orbitaDePrimo1 2 = take 2 (orbita 2)

orbitaDePrimo1 p = take 4 (orbita p)

-- 2ª definición de orbitaDePrimo

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

-- Basada en los siguientes cálculos

-- orbitaDePrimo1 2 == [0,2]

-- orbitaDePrimo1 3 == [0,-1,3,4]

-- orbitaDePrimo1 5 == [0,-4,5,9]

-- orbitaDePrimo1 7 == [0, 7, -9, 16]

-- orbitaDePrimo1 11 == [0,11, -25, 36]

-- orbitaDePrimo1 13 == [0,13, -36, 49]

-- orbitaDePrimo1 17 == [0,17, -64, 81]

-- orbitaDePrimo1 19 == [0,19, -81,100]

-- orbitaDePrimo1 23 == [0,23,-121,144]

orbitaDePrimo2 :: Integer -> [Integer]

orbitaDePrimo2 p

| p == 2 = [0,2]

| p <= 5 = [0, -((p-1) `div` 2)^2, p, ((p+1) `div` 2)^2]

| otherwise = [0, p, -((p-1) `div` 2)^2, ((p+1) `div` 2)^2]

-- Comprobación de equivalencia

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

-- La comprobación es

-- λ> and [orbitaDePrimo1 n == orbitaDePrimo2 n | n <- take 30 primes]

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> orbitaDePrimo1 (primes !! 100)

-- [0,547,-74529,75076]

-- (4.94 secs, 4,471,368,256 bytes)

-- λ> orbitaDePrimo2 (primes !! 100)

-- [0,547,-74529,75076]

-- (0.01 secs, 302,096 bytes)

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>

Números iguales a potencias de las sumas de sus cifras (OME1999 P2)

PorJosé A. Alonso 28-abril-20215-mayo-2021

El enunciado del problema 2 de la OME (Olimpiada Matemática Española) del 1998 es

Hallar todos los números naturales de 4 cifras, escritos en base 10, que sean iguales al cubo de la suma de sus cifras.

Definir la función

   especiales :: Integer -> Integer -> [Integer]

1	especiales :: Integer -> Integer -> [Integer]

tal que (especiales a b) es la lista de los números de a cifras que son iguales la suma de sus cifras elevada a b. Por ejemplo,

   especiales 5 3  ==  [17576,19683]
   especiales 6 4  ==  [234256,390625,614656]

1 2	especiales 5 3 == [17576,19683] especiales 6 4 == [234256,390625,614656]

Usando la función anterior, calcular las soluciones del problema de la Olimpiada.

Soluciones

import Data.Char (digitToInt)

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

especiales :: Integer -> Integer -> [Integer]
especiales a b =
  [n | n <- [10^(a-1)..10^a-1],
       n == (sumaDigitos n)^b]

-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,
--    sumaDigitos 2021  ==  5
sumaDigitos :: Integer -> Integer
sumaDigitos = sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 2021  ==  [2,0,2,1]
digitos :: Integer -> [Integer]
digitos x = [read [c] | c <- show x]

-- Cálculo de la solución del problema de la Olimpiada:
--    λ> especiales 4 3
--    [4913,5832]

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

especiales2 :: Integer -> Integer -> [Integer]
especiales2 c e = [z | z <- map (^e) [a..min (9*c) b], z == (f z)^e]
  where [c', e'] = map fromIntegral [c,e]
        [a , b ] = [ceiling (10**((c'+p)/e')) | p <- [-1,0]]
        f = sum . map (toInteger . digitToInt) . show

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

-- La comparación es
--    λ> especiales 6 4
--    [234256,390625,614656]
--    (7.41 secs, 21,808,919,208 bytes)
--    λ> especiales2 6 4
--    [234256,390625,614656]
--    (0.01 secs, 168,072 bytes)

import Data.Char (digitToInt)

-- 1ª solución

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

especiales :: Integer -> Integer -> [Integer]

especiales a b =

[n | n <- [10^(a-1)..10^a-1],

n == (sumaDigitos n)^b]

-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,

-- sumaDigitos 2021 == 5

sumaDigitos :: Integer -> Integer

sumaDigitos = sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 2021 == [2,0,2,1]

digitos :: Integer -> [Integer]

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

-- Cálculo de la solución del problema de la Olimpiada:

-- λ> especiales 4 3

-- [4913,5832]

-- 2ª solución

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

especiales2 :: Integer -> Integer -> [Integer]

especiales2 c e = [z | z <- map (^e) [a..min (9*c) b], z == (f z)^e]

where [c', e'] = map fromIntegral [c,e]

[a , b ] = [ceiling (10**((c'+p)/e')) | p <- [-1,0]]

f = sum . map (toInteger . digitToInt) . show

-- Comparación de eficiencia

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

-- La comparación es

-- λ> especiales 6 4

-- [234256,390625,614656]

-- (7.41 secs, 21,808,919,208 bytes)

-- λ> especiales2 6 4

-- [234256,390625,614656]

-- (0.01 secs, 168,072 bytes)

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>

Máximos de una función recursiva (OME2002 P3)

PorJosé A. Alonso 27-abril-20214-mayo-2021

El enunciado del problema 5 de la OME (Olimpiada Matemática Española) del 2002 es

La función g se define sobre los números naturales y satisface las condiciones:

g(1) = 1

g(2n) = g(n)

g(2n + 1) = g(2n) + 1

Sea n un número natural tal que 1 ≤ n ≤ 2002. Calcula el valor máximo M de g(n). Calcula también cuántos valores de n satisfacen g(n) = M.

Los valores de la función g para n de 1 a 30 son

   1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4

1	1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4

Definir la función

   maximoG :: Integer -> Integer

1	maximoG :: Integer -> Integer

tal que (maximoG m) es el máximo de los valores de g(n) para n en {1, 2,…, m}. Por ejemplo,

   maximoG 30           ==  4
   maximoG (10^(10^5))  ==  332192

1 2	maximoG 30 == 4 maximoG (10^(10^5)) == 332192

Usando la función maximoG, calcular los valores pedidos en el problema.

Soluciones

import Data.List (genericLength, genericTake, group)
import Test.QuickCheck (Property, (==>), quickCheck)

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

maximoG :: Integer -> Integer
maximoG m = maximum (genericTake m sucesionG)

-- sucesionG es la lista de los valores de g. Por ejemplo,
--    λ> take 30 sucesionG
--    [1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4]
sucesionG :: [Integer]
sucesionG = map g [1..]

-- (g n) es el valor de g(n).
g :: Integer -> Integer
g 1 = 1
g n | even n    = g (n `div` 2)
    | otherwise = g (n `div` 2) + 1

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

-- Observando los siguientes cálculos
--   λ> map maximoG [1..40]
--   [1,1,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5]
--   λ> take 10 (map length (group (map maximoG [1..])))
--   [2,4,8,16,32,64,128,256,512,1024]

maximoG2 :: Integer -> Integer
maximoG2 m = head [x | x <- [1..], m + 1 < 2^x] - 1

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

maximoG3 :: Integer -> Integer
maximoG3 m = genericLength (takeWhile (<m+2) potenciasDeDos) - 1

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

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

maximoG4 :: Integer -> Integer
maximoG4 m = floor (logBase 2 (fromIntegral (m+1)))

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

-- La propiedad es
prop_maximoG :: Integer -> Property
prop_maximoG m =
  m > 0 ==>
  all (== (maximoG m))
      [ maximoG2 m,
        maximoG3 m,
        maximoG4 m]

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

-- Nota: Aunque QuickCheck no ha encontrado ningún contraejemplo, la
-- definición maximoG4 que usa números decimales falla para números muy
-- grandes. Por ejemplo,
--    λ> maximoG4 (10^308)
--    1023
--    λ> maximoG4 (10^309)
--    1797693134862315907729305190789024733617976978942306572734300...
--    λ> maximoG3 (10^308)
--    1023
--    λ> maximoG3 (10^309)
--    1026

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

-- La comparación es
--    λ> maximoG (10^6)
--    19
--    (8.80 secs, 6,015,772,760 bytes)
--    λ> maximoG2 (10^6)
--    19
--    (0.02 secs, 106,752 bytes)
--    λ> maximoG3 (10^6)
--    19
--    (0.02 secs, 102,592 bytes)
--    λ> maximoG4 (10^6)
--    19
--    (0.01 secs, 98,464 bytes)
--
--    λ> maximoG2 (10^308)
--    1023
--    (0.03 secs, 3,266,096 bytes)
--    λ> maximoG3 (10^308)
--    1023
--    (0.02 secs, 266,856 bytes)
--    λ> maximoG4 (10^308)
--    1023
--    (0.02 secs, 103,176 bytes)
--
--    λ> maximoG2 (10^16789)
--    55771
--    (1.70 secs, 1,201,022,600 bytes)
--    λ> maximoG3 (10^16789)
--    55771
--    (0.24 secs, 214,872,864 bytes)

-- Cálculos del problema
-- =====================

-- El máximo se calcula como sigue:
--    λ> maximum (take 2002 sucesionG)
--    10
-- Por tanto, el máximo es 10.

-- Los valores de n tales que g(n) es el máximo se calcula como sigue:
--    λ> [n | n <- [1..2002], g n == 10]
--    [1023,1535,1791,1919,1983]

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

import Data.List (genericLength, genericTake, group)

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª solución

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

maximoG :: Integer -> Integer

maximoG m = maximum (genericTake m sucesionG)

-- sucesionG es la lista de los valores de g. Por ejemplo,

-- λ> take 30 sucesionG

-- [1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4]

sucesionG :: [Integer]

sucesionG = map g [1..]

-- (g n) es el valor de g(n).

g :: Integer -> Integer

g 1 = 1

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

| otherwise = g (n `div` 2) + 1

-- 2ª solución

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

-- Observando los siguientes cálculos

-- λ> map maximoG [1..40]

-- [1,1,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5]

-- λ> take 10 (map length (group (map maximoG [1..])))

-- [2,4,8,16,32,64,128,256,512,1024]

maximoG2 :: Integer -> Integer

maximoG2 m = head [x | x <- [1..], m + 1 < 2^x] - 1

-- 3ª solución

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

maximoG3 :: Integer -> Integer

maximoG3 m = genericLength (takeWhile (<m+2) potenciasDeDos) - 1

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

-- 4ª solución

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

maximoG4 :: Integer -> Integer

maximoG4 m = floor (logBase 2 (fromIntegral (m+1)))

-- Comprobación de equivalencia

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

-- La propiedad es

prop_maximoG :: Integer -> Property

prop_maximoG m =

m > 0 ==>

all (== (maximoG m))

[ maximoG2 m,

maximoG3 m,

maximoG4 m]

-- La comprobación es

-- λ> quickCheck prop_maximoG

-- +++ OK, passed 100 tests.

-- Nota: Aunque QuickCheck no ha encontrado ningún contraejemplo, la

-- definición maximoG4 que usa números decimales falla para números muy

-- grandes. Por ejemplo,

-- λ> maximoG4 (10^308)

-- 1023

-- λ> maximoG4 (10^309)

-- 1797693134862315907729305190789024733617976978942306572734300...

-- λ> maximoG3 (10^308)

-- 1023

-- λ> maximoG3 (10^309)

-- 1026

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximoG (10^6)

-- 19

-- (8.80 secs, 6,015,772,760 bytes)

-- λ> maximoG2 (10^6)

-- 19

-- (0.02 secs, 106,752 bytes)

-- λ> maximoG3 (10^6)

-- 19

-- (0.02 secs, 102,592 bytes)

-- λ> maximoG4 (10^6)

-- 19

-- (0.01 secs, 98,464 bytes)

-- λ> maximoG2 (10^308)

-- 1023

-- (0.03 secs, 3,266,096 bytes)

-- λ> maximoG3 (10^308)

-- 1023

-- (0.02 secs, 266,856 bytes)

-- λ> maximoG4 (10^308)

-- 1023

-- (0.02 secs, 103,176 bytes)

-- λ> maximoG2 (10^16789)

-- 55771

-- (1.70 secs, 1,201,022,600 bytes)

-- λ> maximoG3 (10^16789)

-- 55771

-- (0.24 secs, 214,872,864 bytes)

-- Cálculos del problema

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

-- El máximo se calcula como sigue:

-- λ> maximum (take 2002 sucesionG)

-- 10

-- Por tanto, el máximo es 10.

-- Los valores de n tales que g(n) es el máximo se calcula como sigue:

-- λ> [n | n <- [1..2002], g n == 10]

-- [1023,1535,1791,1919,1983]

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>

Productos de cuatro consecutivos (OME2006 P5)

PorJosé A. Alonso 26-abril-20213-mayo-2021

El enunciado del problema 5 de la OME (Olimpiada Matemática Española) del 2006 es

Probar que el producto de cuatro naturales consecutivos no puede ser ni cuadrado ni cubo perfecto.

Definir la lista

   productos :: [Integer]

1	productos :: [Integer]

cuyos elementos son los productos de cuatro enteros positivos consecutivos. Por ejemplo,

   λ> take 12 productos
   [24,120,360,840,1680,3024,5040,7920,11880,17160,24024,32760]

1 2	λ> take 12 productos [24,120,360,840,1680,3024,5040,7920,11880,17160,24024,32760]

Comprobar con QuickCheck que los elementos de la lista productos no son ni cuadrados ni cubos perfectos.

Soluciones

import Test.QuickCheck

productos :: [Integer]
productos =
  [product [n..n+3] | n <- [1..]]

-- La propiedad es
prop_productos :: Int -> Property
prop_productos n =
  n >= 0 ==>
  not (esCuadrado x) && not (esCubo x)
  where x = productos !! n

-- (esCuadrado x) se verifica si x es un cuadrado perfecto. Por
-- ejemplo,
--    esCuadrado 16  ==  True
--    esCuadrado 27  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x = (raizEntera 2 x)^2 == x

-- (esCubo x) se verifica si x es un cubo perfecto. Por ejemplo,
--    esCubo 8  ==  True
--    esCubo 9  ==  False
esCubo :: Integer -> Bool
esCubo x = (raizEntera 3 x)^3 == x

-- (raizEntera n x) es el mayor entero cuya potencia n-ésima es menor o
-- igual que x. Por ejemplo,
--    raizEntera 2 15  ==  3
--    raizEntera 2 16  ==  4
--    raizEntera 2 17  ==  4
raizEntera :: Int -> Integer -> Integer
raizEntera n x = aux (1,x)
    where aux (a,b) | d == x    = c
                    | c == a    = c
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c)
              where c = (a+b) `div` 2
                    d = c^n

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

import Test.QuickCheck

productos :: [Integer]

productos =

[product [n..n+3] | n <- [1..]]

-- La propiedad es

prop_productos :: Int -> Property

prop_productos n =

n >= 0 ==>

not (esCuadrado x) && not (esCubo x)

where x = productos !! n

-- (esCuadrado x) se verifica si x es un cuadrado perfecto. Por

-- ejemplo,

-- esCuadrado 16 == True

-- esCuadrado 27 == False

esCuadrado :: Integer -> Bool

esCuadrado x = (raizEntera 2 x)^2 == x

-- (esCubo x) se verifica si x es un cubo perfecto. Por ejemplo,

-- esCubo 8 == True

-- esCubo 9 == False

esCubo :: Integer -> Bool

esCubo x = (raizEntera 3 x)^3 == x

-- (raizEntera n x) es el mayor entero cuya potencia n-ésima es menor o

-- igual que x. Por ejemplo,

-- raizEntera 2 15 == 3

-- raizEntera 2 16 == 4

-- raizEntera 2 17 == 4

raizEntera :: Int -> Integer -> Integer

raizEntera n x = aux (1,x)

where aux (a,b) | d == x = c

| c == a = c

| d < x = aux (c,b)

| otherwise = aux (a,c)

where c = (a+b) `div` 2

d = c^n

-- La comprobación es

-- λ> quickCheck prop_productos

-- +++ OK, passed 100 tests.

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>

Mayores potencias de 5 que dividen a la sucesión (OME2014 P4)

PorJosé A. Alonso 23-abril-202130-abril-2021

El enunciado del problema 4 de la OME (Olimpiada Matemática Española) del 2014 es

Sea {x(n)} la sucesión de enteros positivos definida por x(1) = 2 y x(n+1) = 2*x(n)^3+x(n) para todo n >= 1. Determinar la mayor potencia de 5 que divide al número x(2014)^2+1.

Definir la función

   mayorExponente :: Integer -> Integer

1	mayorExponente :: Integer -> Integer

tal que (mayorExponente n) es el mayor m tal que 5^m divide al número x(n)^2+1.

Soluciones

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

mayorExponente :: Integer -> Integer
mayorExponente n =
  mayorExponenteDe5QueDivide ((termino n)^2 + 1)

-- (termino n) es el término n-ésimo de la sucesión. Por ejemplo,
--    termino 2  ==  18
--    termino 3  ==  11682
--    termino 4  ==  3188464624818
termino :: Integer -> Integer
termino 1 = 2
termino n = 2*x^3+x
  where x = termino (n-1)

-- (mayorExponenteDe5QueDivide n) es el mayor exponente de 5 que divide a n. Por
-- ejemplo,
--    mayorExponenteDe5QueDivide 50  ==  2
mayorExponenteDe5QueDivide :: Integer -> Integer
mayorExponenteDe5QueDivide n
  | n `mod` 5 /= 0 = 0
  | otherwise      = 1 + mayorExponenteDe5QueDivide (n `div` 5)

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

-- Con el siguente cálculo
--    λ> [mayorExponente n | n <- [1..5]]
--    [1,2,3,4,5]
-- se observa que el mayor exponente de 5 que divide a x(n)^2+1 es n.

mayorExponente2 :: Integer -> Integer
mayorExponente2 = id

-- 1ª solución

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

mayorExponente :: Integer -> Integer

mayorExponente n =

mayorExponenteDe5QueDivide ((termino n)^2 + 1)

-- (termino n) es el término n-ésimo de la sucesión. Por ejemplo,

-- termino 2 == 18

-- termino 3 == 11682

-- termino 4 == 3188464624818

termino :: Integer -> Integer

termino 1 = 2

termino n = 2*x^3+x

where x = termino (n-1)

-- (mayorExponenteDe5QueDivide n) es el mayor exponente de 5 que divide a n. Por

-- ejemplo,

-- mayorExponenteDe5QueDivide 50 == 2

mayorExponenteDe5QueDivide :: Integer -> Integer

mayorExponenteDe5QueDivide n

| n `mod` 5 /= 0 = 0

| otherwise = 1 + mayorExponenteDe5QueDivide (n `div` 5)

-- 2ª solución

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

-- Con el siguente cálculo

-- λ> [mayorExponente n | n <- [1..5]]

-- [1,2,3,4,5]

-- se observa que el mayor exponente de 5 que divide a x(n)^2+1 es n.

mayorExponente2 :: Integer -> Integer

mayorExponente2 = id

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>

Permutaciones divisibles (OME2016 P5)

PorJosé A. Alonso 22-abril-202129-abril-2021

El enunciado del problema 5 de la OME (Olimpiada Matemática Española) del 2016 es

De entre todas las permutaciones (a(1), a(2),…, a(n)) del conjunto {1, 2,…, n},(n ≥ 1 entero), se consideran las que cumplen que 2(a(1) + a(2) +···+ a(m)) es divisible por m, para cada m = 1, 2,…, n. Calcular el número total de estas permutaciones.

Llamaremos permutaciones divisibles a las que cumplen la propiedad anterior. Por ejemplo, [2,3,4,1] es una permutación divisible de {1,2,3,4} ya que es una permutación del conjunto y se cumplen las condiciones:

2*2 = 4 es divisible por 1,
2*(2+3) = 10 es divisible por 2
2*(2+3+4) = 18 es divisible por 3.
2*(2+3+4+1) = 20 es divisible por 4.

Definir las siguientes funciones:

   permutacionesDivisibles  :: Integer -> [[Integer]]
   nPermutacionesDivisibles :: Integer -> Integer

1 2	permutacionesDivisibles :: Integer -> [[Integer]] nPermutacionesDivisibles :: Integer -> Integer

tales que

(permutacionesDivisibles n) es la lista de las permutaciones divisibles de {1,2,…,n}. Por ejemplo,

     λ> permutacionesDivisibles 2
     [[1,2],[2,1]]
     λ> permutacionesDivisibles 3
     [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
     λ> permutacionesDivisibles 4
     [[1,2,3,4],[1,3,2,4],[2,1,3,4],[2,3,1,4],[2,3,4,1],[2,4,3,1],
      [3,1,2,4],[3,2,1,4],[3,2,4,1],[3,4,2,1],[4,2,3,1],[4,3,2,1]]
     λ> length (permutacionesDivisibles 20)
     786432

λ> permutacionesDivisibles 2

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

λ> permutacionesDivisibles 3

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

λ> permutacionesDivisibles 4

[[1,2,3,4],[1,3,2,4],[2,1,3,4],[2,3,1,4],[2,3,4,1],[2,4,3,1],

[3,1,2,4],[3,2,1,4],[3,2,4,1],[3,4,2,1],[4,2,3,1],[4,3,2,1]]

λ> length (permutacionesDivisibles 20)

786432

(nPermutacionesDivisibles n) es el número de permutaciones divisibles de {1,2,…,n}. Por ejemplo,

     nPermutacionesDivisibles 4  ==  12
     nPermutacionesDivisibles (10^8) `mod` (10^9)  ==  340332032

1 2	nPermutacionesDivisibles 4 == 12 nPermutacionesDivisibles (10^8) `mod` (10^9) == 340332032

Soluciones

import Data.List (genericLength, permutations, sort)

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

permutacionesDivisibles :: Integer -> [[Integer]]
permutacionesDivisibles n =
  sort (filter aux (permutations [1..n]))
  where
    aux xs = and [(2*x) `mod` n == 0 | (x,n) <- zip (sumasParciales xs) [1..]]

-- (sumasParciales xs) es la lista de las suas parciales de xs. Por ejemplo,
--    sumasParciales [1..9]  ==  [1,3,6,10,15,21,28,36,45]
sumasParciales :: [Integer] -> [Integer]
sumasParciales = scanl1 (+)

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

permutacionesDivisibles2 :: Integer -> [[Integer]]
permutacionesDivisibles2 = sort . aux
  where aux n
          | n < 4     = permutations [1..n]
          | otherwise = [xs ++ [n] | xs <- xss] ++
                        [map (+1) xs ++ [1] | xs <- xss]
          where xss = aux (n-1)

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

-- La comprobación para los n primeros valores es
--    λ> and [permutacionesDivisibles2 n == permutacionesDivisibles n | n <- [1..9]]
--    True

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

-- La comparación es
--    λ> length (permutacionesDivisibles 10)
--    768
--    (8.42 secs, 10,420,281,776 bytes)
--    λ> length (permutacionesDivisibles2 10)
--    768
--    (0.02 secs, 2,250,152 bytes)
--
--    λ> length (permutacionesDivisibles2 20)
--    786432
--    (14.33 secs, 4,458,839,736 bytes)

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

--    nPermutacionesDivisibles 5  ==  24
nPermutacionesDivisibles :: Integer -> Integer
nPermutacionesDivisibles =
  genericLength . permutacionesDivisibles

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

nPermutacionesDivisibles2 :: Integer -> Integer
nPermutacionesDivisibles2 =
  genericLength . permutacionesDivisibles2

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

-- Observando los siguientes cálculos:
--    λ> [nPermutacionesDivisibles2 n | n <- [1..12]]
--    [1,2,6,12,24,48,96,192,384,768,1536,3072]
--    λ> 1 : 2 : [3*2^(n-2) | n <- [3..12]]
--    [1,2,6,12,24,48,96,192,384,768,1536,3072]

nPermutacionesDivisibles3 :: Integer -> Integer
nPermutacionesDivisibles3 n
  | n < 3     = n
  | otherwise = 3*2^(n-2)

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

-- La comparación es
--    λ> nPermutacionesDivisibles 10
--    768
--    (7.95 secs, 10,704,422,592 bytes)
--    λ> nPermutacionesDivisibles2 10
--    768
--    (0.01 secs, 2,269,872 bytes)
--    λ> nPermutacionesDivisibles3 10
--    768
--    (0.01 secs, 102,560 bytes)
--
--    λ> nPermutacionesDivisibles2 20
--    786432
--    (13.00 secs, 4,477,717,968 bytes)
--    λ> nPermutacionesDivisibles3 20
--    786432
--    (0.01 secs, 106,848 bytes)

import Data.List (genericLength, permutations, sort)

-- 1ª definición de permutacionesDivisibles

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

permutacionesDivisibles :: Integer -> [[Integer]]

permutacionesDivisibles n =

sort (filter aux (permutations [1..n]))

where

aux xs = and [(2*x) `mod` n == 0 | (x,n) <- zip (sumasParciales xs) [1..]]

-- (sumasParciales xs) es la lista de las suas parciales de xs. Por ejemplo,

-- sumasParciales [1..9] == [1,3,6,10,15,21,28,36,45]

sumasParciales :: [Integer] -> [Integer]

sumasParciales = scanl1 (+)

-- 2ª definición de permutacionesDivisibles

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

permutacionesDivisibles2 :: Integer -> [[Integer]]

permutacionesDivisibles2 = sort . aux

where aux n

| n < 4 = permutations [1..n]

| otherwise = [xs ++ [n] | xs <- xss] ++

[map (+1) xs ++ [1] | xs <- xss]

where xss = aux (n-1)

-- Comprobación de equivalencia

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

-- La comprobación para los n primeros valores es

-- λ> and [permutacionesDivisibles2 n == permutacionesDivisibles n | n <- [1..9]]

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (permutacionesDivisibles 10)

-- 768

-- (8.42 secs, 10,420,281,776 bytes)

-- λ> length (permutacionesDivisibles2 10)

-- 768

-- (0.02 secs, 2,250,152 bytes)

-- λ> length (permutacionesDivisibles2 20)

-- 786432

-- (14.33 secs, 4,458,839,736 bytes)

-- 1ª definición de nPermutacionesDivisibles

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

-- nPermutacionesDivisibles 5 == 24

nPermutacionesDivisibles :: Integer -> Integer

nPermutacionesDivisibles =

genericLength . permutacionesDivisibles

-- 2ª definición de nPermutacionesDivisibles

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

nPermutacionesDivisibles2 :: Integer -> Integer

nPermutacionesDivisibles2 =

genericLength . permutacionesDivisibles2

-- 3ª definición de nPermutacionesDivisibles

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

-- Observando los siguientes cálculos:

-- λ> [nPermutacionesDivisibles2 n | n <- [1..12]]

-- [1,2,6,12,24,48,96,192,384,768,1536,3072]

-- λ> 1 : 2 : [3*2^(n-2) | n <- [3..12]]

-- [1,2,6,12,24,48,96,192,384,768,1536,3072]

nPermutacionesDivisibles3 :: Integer -> Integer

nPermutacionesDivisibles3 n

| n < 3 = n

| otherwise = 3*2^(n-2)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> nPermutacionesDivisibles 10

-- 768

-- (7.95 secs, 10,704,422,592 bytes)

-- λ> nPermutacionesDivisibles2 10

-- 768

-- (0.01 secs, 2,269,872 bytes)

-- λ> nPermutacionesDivisibles3 10

-- 768

-- (0.01 secs, 102,560 bytes)

-- λ> nPermutacionesDivisibles2 20

-- 786432

-- (13.00 secs, 4,477,717,968 bytes)

-- λ> nPermutacionesDivisibles3 20

-- 786432

-- (0.01 secs, 106,848 bytes)

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>

Números fibonaccianos

PorJosé A. Alonso 21-abril-202128-abril-2021

El enunciado del segundo problema de este mes de la RSME es el siguiente:

Un número de al menos tres cifras se denomina fibonacciano si sus cifras, a partir de la tercera, son iguales a la suma de las dos cifras anteriores. Por ejemplo, 5279 es un número fibonacciano, pues su tercera cifra, 7, es suma de las dos anteriores (5+2) y su cuarta cifra, 9, también (2+7).

Te daremos el problema por válido si respondes bien a estas dos cuestiones:
a) ¿cuántas cifras como máximo puede tener un número fibonacciano?
b) ¿cuántos números fibonaccianos hay?

En la definición de fibonacciano la suma de las cifras tiene que menor que 10, pero podemos generalizarlo sustituyendo 10 por número n. Dichos números de llaman fibonaccianos generalizados acotados por n. Por ejemplo, 571219315081 es un fibonacciano generalizado acotado por 100 ya que la sucesión de sus dígitos es 5, 7, 12 (= 5+7), 19 (= 7+12), 31 (= 12+19) 50 (=19+31) y 81 (=31+50).

Definir las funciones

   esFibonacciano :: Integer -> Bool
   fibonaccianos  :: [Integer]
   fibonaccianosG :: Integer -> [Integer]

esFibonacciano :: Integer -> Bool

fibonaccianos :: [Integer]

fibonaccianosG :: Integer -> [Integer]

tales que

(esFibonacciano n) se verifica si n es un número fibonacciano. Por ejemplo,

     esFibonacciano 5279    ==  True
     esFibonacciano 527916  ==  False

1 2	esFibonacciano 5279 == True esFibonacciano 527916 == False

fibonaccianos es la lista de los números fibonaccianos. Por ejemplo,

     λ> take 60 fibonaccianos
     [101,112,123,134,145,156,167,178,189,202,213,224,235,246,257,268,
      279,303,314,325,336,347,358,369,404,415,426,437,448,459,505,516,
      527,538,549,606,617,628,639,707,718,729,808,819,909,1011,1123,
      1235,1347,1459,2022,2134,2246,2358,3033,3145,3257,3369,4044,4156]

λ> take 60 fibonaccianos

[101,112,123,134,145,156,167,178,189,202,213,224,235,246,257,268,

279,303,314,325,336,347,358,369,404,415,426,437,448,459,505,516,

527,538,549,606,617,628,639,707,718,729,808,819,909,1011,1123,

1235,1347,1459,2022,2134,2246,2358,3033,3145,3257,3369,4044,4156]

(fibonaccianosG n) es la lista de los números fibonaccianos generalizados acotados por n. Por ejemplo,

     λ> take 60 (fibonaccianosG 100)
     [101,112,123,134,145,156,167,178,189,202,213,224,235,246,257,268,
      279,303,314,325,336,347,358,369,404,415,426,437,448,459,505,516,
      527,538,549,606,617,628,639,707,718,729,808,819,909,1011,1123,
      1235,1347,1459,1910,2022,2134,2246,2358,2810,2911,3033,3145,3257]
     λ> take 12 (drop 60 (fibonaccianosG 10))
     [4268,5055,5167,5279,6066,6178,7077,7189,8088,9099,10112,11235]
     λ> take 12 (drop 60 (fibonaccianosG 100))
     [3369,3710,3811,3912,4044,4156,4268,4610,4711,4812,4913,5055]
     λ> length (fibonaccianosG (10^40))
     16888
     λ> length (show (last (fibonaccianosG (10^40))))
     3943

λ> take 60 (fibonaccianosG 100)

[101,112,123,134,145,156,167,178,189,202,213,224,235,246,257,268,

279,303,314,325,336,347,358,369,404,415,426,437,448,459,505,516,

527,538,549,606,617,628,639,707,718,729,808,819,909,1011,1123,

1235,1347,1459,1910,2022,2134,2246,2358,2810,2911,3033,3145,3257]

λ> take 12 (drop 60 (fibonaccianosG 10))

[4268,5055,5167,5279,6066,6178,7077,7189,8088,9099,10112,11235]

λ> take 12 (drop 60 (fibonaccianosG 100))

[3369,3710,3811,3912,4044,4156,4268,4610,4711,4812,4913,5055]

λ> length (fibonaccianosG (10^40))

16888

λ> length (show (last (fibonaccianosG (10^40))))

3943

Usando las funciones anteriores, calcular cuántas cifras como máximo puede tener un número fibonacciano y cuántos números fibonaccianos hay.

Soluciones

import Data.List (inits, isPrefixOf, sort)

-- Definición de esFibonacciano
-- ============================

esFibonacciano :: Integer -> Bool
esFibonacciano n =
  n > 99 && ds `isPrefixOf` drop 2 fs
  where (a:b:ds) = digitos n
        fs = a : b : zipWith (+) fs (tail fs)

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Int]
digitos n =
  [read [c] | c <- show n]

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

fibonaccianos :: [Integer]
fibonaccianos =
  filter esFibonacciano [100..10112358]

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

fibonaccianos2 :: [Integer]
fibonaccianos2 =
  sort (concat [aux a b | a <- [1..9], b <- [0..9]])
  where
    aux a b = [digitosAnumero zs | zs <- drop 3 (inits (takeWhile (<10) (fibs a b)))]

-- (fibs a b) es la sucesión de números de Fibonacci cuyos dos primeros
-- términos son a y b. Por ejemplo,
--    take 9 (fibs 2 4)  ==  [2,4,6,10,16,26,42,68,110]
--    take 9 (fibs 3 6)  ==  [3,6,9,15,24,39,63,102,165]
fibs :: Integer -> Integer -> [Integer]
fibs a b = fs
  where fs = a : b : zipWith (+) fs (tail fs)

-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por
-- ejemplo,
--    digitosAnumero [8,1,6,4,9]  ==  81649
digitosAnumero :: [Integer] -> Integer
digitosAnumero xs =
  read (concatMap show xs)

-- fibonaccianosG
-- ==============

fibonaccianosG :: Integer -> [Integer]
fibonaccianosG n =
  sort (concat [fibonaccianosGAux n a b | a <- [1..9], b <- [0..9]])

fibonaccianosGAux :: Integer -> Integer -> Integer -> [Integer]
fibonaccianosGAux n a b =
  [digitosAnumero zs | zs <- drop 3 (inits (takeWhile (<n) (fibs a b)))]

-- Comprobación de la generalización
--    λ> fibonaccianos2 == fibonaccianosG 10
--    True

--    λ> length (fibonaccianosG (10^40))
--    16888
--    (2.41 secs, 10,546,873,616 bytes)
--    λ> length (show (last (fibonaccianosG (10^40))))
--    3943
--    (2.41 secs, 10,547,101,856 bytes)

-- Cálculos
-- ========

-- El cálculo del máximo número de cifras de los números fibonaccianos
-- es
--      λ> maximum [length (show n) | n <- fibonaccianos2]
--      8
--      λ> length (show (last fibonaccianos2))
--      8

-- El cálculo de la cantidad de números fibonaccianos es
--      λ> length fibonaccianos2
--      84

import Data.List (inits, isPrefixOf, sort)

-- Definición de esFibonacciano

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

esFibonacciano :: Integer -> Bool

esFibonacciano n =

n > 99 && ds `isPrefixOf` drop 2 fs

where (a:b:ds) = digitos n

fs = a : b : zipWith (+) fs (tail fs)

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

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

digitos :: Integer -> [Int]

digitos n =

[read [c] | c <- show n]

-- 1ª definición de fibonaccianos

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

fibonaccianos :: [Integer]

fibonaccianos =

filter esFibonacciano [100..10112358]

-- 2ª definición de fibonaccianos

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

fibonaccianos2 :: [Integer]

fibonaccianos2 =

sort (concat [aux a b | a <- [1..9], b <- [0..9]])

where

aux a b = [digitosAnumero zs | zs <- drop 3 (inits (takeWhile (<10) (fibs a b)))]

-- (fibs a b) es la sucesión de números de Fibonacci cuyos dos primeros

-- términos son a y b. Por ejemplo,

-- take 9 (fibs 2 4) == [2,4,6,10,16,26,42,68,110]

-- take 9 (fibs 3 6) == [3,6,9,15,24,39,63,102,165]

fibs :: Integer -> Integer -> [Integer]

fibs a b = fs

where fs = a : b : zipWith (+) fs (tail fs)

-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por

-- ejemplo,

-- digitosAnumero [8,1,6,4,9] == 81649

digitosAnumero :: [Integer] -> Integer

digitosAnumero xs =

read (concatMap show xs)

-- fibonaccianosG

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

fibonaccianosG :: Integer -> [Integer]

fibonaccianosG n =

sort (concat [fibonaccianosGAux n a b | a <- [1..9], b <- [0..9]])

fibonaccianosGAux :: Integer -> Integer -> Integer -> [Integer]

fibonaccianosGAux n a b =

[digitosAnumero zs | zs <- drop 3 (inits (takeWhile (<n) (fibs a b)))]

-- Comprobación de la generalización

-- λ> fibonaccianos2 == fibonaccianosG 10

-- True

-- λ> length (fibonaccianosG (10^40))

-- 16888

-- (2.41 secs, 10,546,873,616 bytes)

-- λ> length (show (last (fibonaccianosG (10^40))))

-- 3943

-- (2.41 secs, 10,547,101,856 bytes)

-- Cálculos

-- ========

-- El cálculo del máximo número de cifras de los números fibonaccianos

-- es

-- λ> maximum [length (show n) | n <- fibonaccianos2]

-- 8

-- λ> length (show (last fibonaccianos2))

-- 8

-- El cálculo de la cantidad de números fibonaccianos es

-- λ> length fibonaccianos2

-- 84

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>

Cuadriseguidos y números encadenados

PorJosé A. Alonso 20-abril-202127-abril-2021

El enunciado del primer problema de este mes de la RSME es el siguiente:

Un entero positivo de dos o más cifras se denomina cuadriseguido si cada par de dígitos consecutivos que tenga es un cuadrado perfecto. Por ejemplo,

364 es cuadriseguido, pues 36 = 6^2 y 64 = 8^2

3642 no lo es porque 42 no es un cuadrado perfecto.

Obtén todos los números cuadriseguidos posibles.

El concepto de cuadriseguido se puede generalizar como sigue: Un entero positivo n de dos o más cifras se denomina encadenado respecto de una lista de números de dos dígitos xs si cada par de dígitos consecutivos que tenga es un elemento distinto de xs. Por ejemplo,

364 es encadenado respecto de xs = [36,64,15], porque 36 y 64 pertenecen a xs
3642 no es encadenado respecto de xs = [36,64,15], porque 42 no pertenece a xs

Definir la función

   encadenados :: [Integer] -> [Integer]

1	encadenados :: [Integer] -> [Integer]

tal que (encadenados xs) es la lista de los números encadenados respecto de xs. Por ejemplo,

   λ> encadenados [12,23,31]
   [12,23,31,123,231,312,1231,2312,3123]
   λ> encadenados [12,22,31]
   [12,22,31,122,312,3122]
   λ> take 14 (encadenados [n^2 | n <- [4..9]])
   [16,25,36,49,64,81,164,364,649,816,1649,3649,8164,81649]
   λ> length (encadenados [10..42])
   911208

λ> encadenados [12,23,31]

[12,23,31,123,231,312,1231,2312,3123]

λ> encadenados [12,22,31]

[12,22,31,122,312,3122]

λ> take 14 (encadenados [n^2 | n <- [4..9]])

[16,25,36,49,64,81,164,364,649,816,1649,3649,8164,81649]

λ> length (encadenados [10..42])

911208

Calcular todos los números cuadriseguidos posibles usando la función encadenados.

Soluciones

import Data.List (delete, sort)
import Data.Tree (Tree (Node), drawTree)
import Test.QuickCheck (Gen, choose, sublistOf, quickCheck)

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

encadenados :: [Integer] -> [Integer]
encadenados xs =
  filter (esEncadenado xs) [10..10^(2 * length xs) - 1]

-- (esEncadenado xs n) se verifica si n es un número encadenado respecto
-- de xs. Por ejemplo,
--    esEncadenado [36,64,15] 364   ==  True
--    esEncadenado [36,64,15] 3642  ==  False
--    esEncadenado [36,63] 3636     ==  False
esEncadenado :: [Integer] -> Integer -> Bool
esEncadenado xs n =
  dosConsecutivos n `contenido` xs

-- (dosConsecutivos n) es la lista de los números formados por dos
-- dígitos consecutivos de xs. Por ejemplo,
--    dosConsecutivos 81649  ==  [81,16,64,49]
dosConsecutivos :: Integer -> [Integer]
dosConsecutivos n =
  map read [[x,y] | (x,y) <- zip xs (tail xs)]
  where xs = show n

-- Otra definición alternativa
dosConsecutivos2 :: Integer -> [Integer]
dosConsecutivos2 = reverse . aux
  where aux n
          | n < 10    = []
          | otherwise = n `mod` 100 : aux (n `div` 10)

-- (contenido xs ys) se verifica si xs está contenido en ys. Por
-- ejemplo,
--    contenido [2,5] [3,5,2]  ==  True
--    contenido [2,5,5] [3,5,2]  ==  False
contenido :: [Integer] -> [Integer] -> Bool
contenido [] _      = True
contenido (x:xs) ys = x `elem` ys && xs `contenido` (delete x ys)

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

encadenados2 :: [Integer] -> [Integer]
encadenados2 xs =
  sort (map (digitosAnumero . cadenaReducida) (tail (nodos (arbolCadenas ps))))
  where ps = map (`divMod` 10) xs

-- (arbolCadenas ps) es el árbol de las cadenas formadas con los
-- elementos de ps. Por ejemplo,
--    λ> putStrLn (drawTree (fmap show (arbolCadenas [(1,2),(2,3),(3,1)])))
--    []
--    |
--    +- [(1,2)]
--    |  |
--    |  `- [(3,1),(1,2)]
--    |     |
--    |     `- [(2,3),(3,1),(1,2)]
--    |
--    +- [(2,3)]
--    |  |
--    |  `- [(1,2),(2,3)]
--    |     |
--    |     `- [(3,1),(1,2),(2,3)]
--    |
--    `- [(3,1)]
--       |
--       `- [(2,3),(3,1)]
--          |
--          `- [(1,2),(2,3),(3,1)]
arbolCadenas :: Eq a => [(a,a)] -> Tree [(a,a)]
arbolCadenas ps = aux []
  where
    aux xs = Node xs (map aux (extensiones xs))
    extensiones [] =
      [[p] | p <- ps]
    extensiones ((x,y):rs) =
      [(a,b):(x,y):rs | (a,b) <- ps,
                        b == x,
                        (a,b) `notElem` ((x,y):rs)]

-- (nodos a) es la lista de los nodos del árbol a. Por ejemplo,
--    λ> nodos (arbolCadenas [(1,6),(6,4),(8,1)])
--    [[],[(1,6)],[(8,1),(1,6)],[(6,4)],[(1,6),(6,4)],[(8,1),(1,6),(6,4)],[(8,1)]]
nodos :: Tree [(a,a)] -> [[(a,a)]]
nodos (Node x ys) =
  x : concatMap nodos ys

-- (cadenaReducida ps) es la lista de los elementos la cadena ps donde
-- los enlaces solo se escriben una vez. Por ejemplo,
--    cadenaReducida [(8,1),(1,6),(6,4),(4,9)]  ==  [8,1,6,4,9]
cadenaReducida :: [(a,a)] -> [a]
cadenaReducida [] = []
cadenaReducida ((x,y):ps) = x : y : map snd ps

-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por
-- ejemplo,
--    digitosAnumero [8,1,6,4,9]  ==  81649
digitosAnumero :: [Integer] -> Integer
digitosAnumero xs =
  read (concatMap show xs)

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

encadenados3 :: [Integer] -> [Integer]
encadenados3 xs =
  sort (map read (aux [(p,delete p ps) | p <- ps]))
  where
    ps = map show xs
    aux [] = []
    aux ((as,qs):yss)
      | null zss  = as : aux yss
      | otherwise = as : aux (zss ++ yss)
      where zss = extensiones (as,qs)
    extensiones (x:xs,cs) =
      [(a:x:xs,delete [a,b] cs) | [a,b] <- cs, b == x]

-- Cálculo de cuadriseguidos
-- =========================

-- El cálculo es
--    λ> encadenados2 [n^2 | n <- [4..9]]
--    [16,25,36,49,64,81,164,364,649,816,1649,3649,8164,81649]

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

-- La propiedad es
prop_encadenados :: Gen Bool
prop_encadenados = do
  n <- choose (2,9)
  xs <- sublistOf [10..99]
  let ys = take n xs
      as = encadenados3 ys
      m  = length as
  return (take m (encadenados ys) == as &&
          encadenados2 ys == as)

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

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

-- La comparación es
--    λ> encadenados [12,24,41]
--    [12,24,41,124,241,412,1241,2412,4124]
--    (2.23 secs, 5,189,736,248 bytes)
--    λ> encadenados2 [12,24,41]
--    [12,24,41,124,241,412,1241,2412,4124]
--    (0.00 secs, 188,496 bytes)
--    λ> encadenados3 [12,24,41]
--    [12,24,41,124,241,412,1241,2412,4124]
--    (0.01 secs, 176,376 bytes)
--
--    λ> length (encadenados2 [10..42])
--    911208
--    (13.59 secs, 14,104,867,760 bytes)
--    λ> length (encadenados3 [10..42])
--    911208
--    (10.62 secs, 10,164,004,808 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

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

166

import Data.List (delete, sort)

import Data.Tree (Tree (Node), drawTree)

import Test.QuickCheck (Gen, choose, sublistOf, quickCheck)

-- 1ª solución

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

encadenados :: [Integer] -> [Integer]

encadenados xs =

filter (esEncadenado xs) [10..10^(2 * length xs) - 1]

-- (esEncadenado xs n) se verifica si n es un número encadenado respecto

-- de xs. Por ejemplo,

-- esEncadenado [36,64,15] 364 == True

-- esEncadenado [36,64,15] 3642 == False

-- esEncadenado [36,63] 3636 == False

esEncadenado :: [Integer] -> Integer -> Bool

esEncadenado xs n =

dosConsecutivos n `contenido` xs

-- (dosConsecutivos n) es la lista de los números formados por dos

-- dígitos consecutivos de xs. Por ejemplo,

-- dosConsecutivos 81649 == [81,16,64,49]

dosConsecutivos :: Integer -> [Integer]

dosConsecutivos n =

map read [[x,y] | (x,y) <- zip xs (tail xs)]

where xs = show n

-- Otra definición alternativa

dosConsecutivos2 :: Integer -> [Integer]

dosConsecutivos2 = reverse . aux

where aux n

| n < 10 = []

| otherwise = n `mod` 100 : aux (n `div` 10)

-- (contenido xs ys) se verifica si xs está contenido en ys. Por

-- ejemplo,

-- contenido [2,5] [3,5,2] == True

-- contenido [2,5,5] [3,5,2] == False

contenido :: [Integer] -> [Integer] -> Bool

contenido [] _ = True

contenido (x:xs) ys = x `elem` ys && xs `contenido` (delete x ys)

-- 2ª solución

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

encadenados2 :: [Integer] -> [Integer]

encadenados2 xs =

sort (map (digitosAnumero . cadenaReducida) (tail (nodos (arbolCadenas ps))))

where ps = map (`divMod` 10) xs

-- (arbolCadenas ps) es el árbol de las cadenas formadas con los

-- elementos de ps. Por ejemplo,

-- λ> putStrLn (drawTree (fmap show (arbolCadenas [(1,2),(2,3),(3,1)])))

-- []

-- |

-- +- [(1,2)]

-- | |

-- | `- [(3,1),(1,2)]

-- | |

-- | `- [(2,3),(3,1),(1,2)]

-- |

-- +- [(2,3)]

-- | |

-- | `- [(1,2),(2,3)]

-- | |

-- | `- [(3,1),(1,2),(2,3)]

-- |

-- `- [(3,1)]

-- |

-- `- [(2,3),(3,1)]

-- |

-- `- [(1,2),(2,3),(3,1)]

arbolCadenas :: Eq a => [(a,a)] -> Tree [(a,a)]

arbolCadenas ps = aux []

where

aux xs = Node xs (map aux (extensiones xs))

extensiones [] =

[[p] | p <- ps]

extensiones ((x,y):rs) =

[(a,b):(x,y):rs | (a,b) <- ps,

b == x,

(a,b) `notElem` ((x,y):rs)]

-- (nodos a) es la lista de los nodos del árbol a. Por ejemplo,

-- λ> nodos (arbolCadenas [(1,6),(6,4),(8,1)])

-- [[],[(1,6)],[(8,1),(1,6)],[(6,4)],[(1,6),(6,4)],[(8,1),(1,6),(6,4)],[(8,1)]]

nodos :: Tree [(a,a)] -> [[(a,a)]]

nodos (Node x ys) =

x : concatMap nodos ys

-- (cadenaReducida ps) es la lista de los elementos la cadena ps donde

-- los enlaces solo se escriben una vez. Por ejemplo,

-- cadenaReducida [(8,1),(1,6),(6,4),(4,9)] == [8,1,6,4,9]

cadenaReducida :: [(a,a)] -> [a]

cadenaReducida [] = []

cadenaReducida ((x,y):ps) = x : y : map snd ps

-- (digitosAnumero xs) es el número cuya lista de dígitos es xs. Por

-- ejemplo,

-- digitosAnumero [8,1,6,4,9] == 81649

digitosAnumero :: [Integer] -> Integer

digitosAnumero xs =

read (concatMap show xs)

-- 3ª solución

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

encadenados3 :: [Integer] -> [Integer]

encadenados3 xs =

sort (map read (aux [(p,delete p ps) | p <- ps]))

where

ps = map show xs

aux [] = []

aux ((as,qs):yss)

| null zss = as : aux yss

| otherwise = as : aux (zss ++ yss)

where zss = extensiones (as,qs)

extensiones (x:xs,cs) =

[(a:x:xs,delete [a,b] cs) | [a,b] <- cs, b == x]

-- Cálculo de cuadriseguidos

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

-- El cálculo es

-- λ> encadenados2 [n^2 | n <- [4..9]]

-- [16,25,36,49,64,81,164,364,649,816,1649,3649,8164,81649]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_encadenados :: Gen Bool

prop_encadenados = do

n <- choose (2,9)

xs <- sublistOf [10..99]

let ys = take n xs

as = encadenados3 ys

m = length as

return (take m (encadenados ys) == as &&

encadenados2 ys == as)

-- La comprobación es

-- λ> quickCheck prop_encadenados

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> encadenados [12,24,41]

-- [12,24,41,124,241,412,1241,2412,4124]

-- (2.23 secs, 5,189,736,248 bytes)

-- λ> encadenados2 [12,24,41]

-- [12,24,41,124,241,412,1241,2412,4124]

-- (0.00 secs, 188,496 bytes)

-- λ> encadenados3 [12,24,41]

-- [12,24,41,124,241,412,1241,2412,4124]

-- (0.01 secs, 176,376 bytes)

-- λ> length (encadenados2 [10..42])

-- 911208

-- (13.59 secs, 14,104,867,760 bytes)

-- λ> length (encadenados3 [10..42])

-- 911208

-- (10.62 secs, 10,164,004,808 bytes)

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>

Árbol de cadenas

PorJosé A. Alonso 19-abril-202126-abril-2021

En la librería Data.Tree se definen los árboles y los bosques como sigue

   data Tree a   = Node a (Forest a)
   type Forest a = [Tree a]

1 2	data Tree a = Node a (Forest a) type Forest a = [Tree a]

Se pueden definir árboles. Por ejemplo,

   ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

1	ej = Node 3 [Node 5 [Node 9 []], Node 7 []]

Y se pueden dibujar con la función drawTree. Por ejemplo,

   λ> putStrLn (drawTree (fmap show ej))
   3
   |
   +- 5
   |  |
   |  `- 9
   |
   `- 7

λ> putStrLn (drawTree (fmap show ej))

+- 5

| |

| `- 9

`- 7

Una cadena con un conjunto de pares ps es una lista xs de elementos distintos de ps tales que la segunda componente de cada elemento de xs es igual a la primera componente de su siguiente elemento. Por ejemplo, si ps = [(1,6),(2,5),(3,6),(4,9),(6,4),(8,1)] entonces [(6,4)], [(8,1),(1,6)] y [(8,1),(1,6),(6,4),(4,9)] son cadenas con ps.

Definir la función

   arbolCadenas :: Eq a => [(a,a)] -> Tree [(a,a)]

1	arbolCadenas :: Eq a => [(a,a)] -> Tree [(a,a)]

tal que (arbolCadenas ps) es el árbol de las cadenas formadas con los elementos de ps. Por ejemplo,

   λ> putStrLn (drawTree (fmap show (arbolCadenas [(1,2),(2,3),(3,1)])))
   []
   |
   +- [(1,2)]
   |  |
   |  `- [(3,1),(1,2)]
   |     |
   |     `- [(2,3),(3,1),(1,2)]
   |
   +- [(2,3)]
   |  |
   |  `- [(1,2),(2,3)]
   |     |
   |     `- [(3,1),(1,2),(2,3)]
   |
   `- [(3,1)]
      |
      `- [(2,3),(3,1)]
         |
         `- [(1,2),(2,3),(3,1)]

   λ> putStrLn (drawTree (fmap show (arbolCadenas [(1,6),(2,5),(3,6),(4,9),(6,4),(8,1)])))
   []
   |
   +- [(1,6)]
   |  |
   |  `- [(8,1),(1,6)]
   |
   +- [(2,5)]
   |
   +- [(3,6)]
   |
   +- [(4,9)]
   |  |
   |  `- [(6,4),(4,9)]
   |     |
   |     +- [(1,6),(6,4),(4,9)]
   |     |  |
   |     |  `- [(8,1),(1,6),(6,4),(4,9)]
   |     |
   |     `- [(3,6),(6,4),(4,9)]
   |
   +- [(6,4)]
   |  |
   |  +- [(1,6),(6,4)]
   |  |  |
   |  |  `- [(8,1),(1,6),(6,4)]
   |  |
   |  `- [(3,6),(6,4)]
   |
   `- [(8,1)]

λ> putStrLn (drawTree (fmap show (arbolCadenas [(1,2),(2,3),(3,1)])))

[]

+- [(1,2)]

| |

| `- [(3,1),(1,2)]

| |

| `- [(2,3),(3,1),(1,2)]

+- [(2,3)]

| |

| `- [(1,2),(2,3)]

| |

| `- [(3,1),(1,2),(2,3)]

`- [(3,1)]

`- [(2,3),(3,1)]

`- [(1,2),(2,3),(3,1)]

λ> putStrLn (drawTree (fmap show (arbolCadenas [(1,6),(2,5),(3,6),(4,9),(6,4),(8,1)])))

[]

+- [(1,6)]

| |

| `- [(8,1),(1,6)]

+- [(2,5)]

+- [(3,6)]

+- [(4,9)]

| |

| `- [(6,4),(4,9)]

| |

| +- [(1,6),(6,4),(4,9)]

| | |

| | `- [(8,1),(1,6),(6,4),(4,9)]

| |

| `- [(3,6),(6,4),(4,9)]

+- [(6,4)]

| |

| +- [(1,6),(6,4)]

| | |

| | `- [(8,1),(1,6),(6,4)]

| |

| `- [(3,6),(6,4)]

`- [(8,1)]

Soluciones

import Data.Tree (Tree (Node), drawTree)

arbolCadenas :: Eq a => [(a,a)] -> Tree [(a,a)]
arbolCadenas ps = aux []
  where
    aux xs = Node xs (map aux (extensiones xs))
    extensiones [] =
      [[p] | p <- ps]
    extensiones ((x,y):rs) =
      [(a,b):(x,y):rs | (a,b) <- ps,
                        b == x,
                        (a,b) `notElem` ((x,y):rs)]

import Data.Tree (Tree (Node), drawTree)

arbolCadenas :: Eq a => [(a,a)] -> Tree [(a,a)]

arbolCadenas ps = aux []

where

aux xs = Node xs (map aux (extensiones xs))

extensiones [] =

[[p] | p <- ps]

extensiones ((x,y):rs) =

[(a,b):(x,y):rs | (a,b) <- ps,

b == x,

(a,b) `notElem` ((x,y):rs)]

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 de cubos perfectos

PorJosé A. Alonso 16-abril-202123-abril-2021

Definir la lista

   sucesion :: [Integer]

1	sucesion :: [Integer]

cuyos elementos son los términos de la sucesión

   107811/3, 110778111/3, 111077781111/3, 111107777811111/3, ...

1	107811/3, 110778111/3, 111077781111/3, 111107777811111/3, ...

Por ejemplo,

   λ> take 5 sucesion
   [35937,36926037,37025927037,37035925937037,37036925926037037]
   λ> length (show (sucesion2 !! (3*10^6)))
   9000005

λ> take 5 sucesion

[35937,36926037,37025927037,37035925937037,37036925926037037]

λ> length (show (sucesion2 !! (3*10^6)))

9000005

Comprobar con QuickCheck que todos los términos de la sucesión son cubos perfectos.

Soluciones

import Test.QuickCheck

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

sucesion :: [Integer]
sucesion = map termino [1..]

-- (termino n) es el término n-ésimo de la sucesión por ejemplo,
--    termino 1  ==  35937
--    termino 2  ==  36926037
--    termino 3  ==  37025927037
termino :: Int -> Integer
termino n = numerador n `div` 3


-- (numerador n) es el numerador del término n-ésimo de la sucesión por
-- ejemplo,
--    λ> mapM_ print (map numerador [1..5])
--    107811
--    110778111
--    111077781111
--    111107777811111
--    111110777778111111
numerador :: Int -> Integer
numerador n =
  read (replicate n '1' ++ "0" ++ replicate n '7' ++ "81" ++ replicate n '1')

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

-- La propiedad es
prop_sucesion :: Int -> Property
prop_sucesion n =
  n >= 0 ==>
  esCubo (sucesion !! n)

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

-- (esCubo x) se verifica si x es un cubo perfecto. Por ejemplo,
--    esCubo 27  ==  True
--    esCubo 28  ==  False
esCubo :: Integer -> Bool
esCubo x =
  (raizCubicaEntera x)^3 == x

-- (raizCubicaEntera x) es el mayor entero cuyo cubo es menor o igual
-- que x. Por ejemplo,
--    raizCubicaEntera 26  ==  2
--    raizCubicaEntera 27  ==  3
--    raizCubicaEntera 28  ==  3
raizCubicaEntera :: Integer -> Integer
raizCubicaEntera x = aux (1,x)
    where aux (a,b) | d == x    = c
                    | c == a    = c
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c)
              where c = (a+b) `div` 2
                    d = c^3

-- Otra forma es observando los cubos de los términos de la sucesión
--    λ> map raizCubicaEntera (take 7 sucesion)
--    [33,333,3333,33333,333333,3333333,33333333]

-- La propiedad es
prop_sucesion2 :: Int -> Property
prop_sucesion2 n =
  n >= 0 ==>
  sucesion !! n == ((10^(n+2)-1) `div` 3)^3

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

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

-- Basada en la propiedad anterior.

sucesion2 :: [Integer]
sucesion2 =
  [((10^n-1) `div` 3)^3 | n <- [2..]]

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

-- La propiedad es
prop_equiv :: Int -> Property
prop_equiv n =
  n >= 0 ==>
  sucesion !! n == sucesion2 !! n

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

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

-- La comparación es
--    λ> length (show (sucesion !! (3*10^6)))
--    9000005
--    (6.34 secs, 5,161,177,808 bytes)
--    λ> length (show (sucesion2 !! (3*10^6)))
--    9000005
--    (2.72 secs, 1,124,065,328 bytes)

100

101

102

103

104

105

106

107

108

import Test.QuickCheck

-- 1ª solución

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

sucesion :: [Integer]

sucesion = map termino [1..]

-- (termino n) es el término n-ésimo de la sucesión por ejemplo,

-- termino 1 == 35937

-- termino 2 == 36926037

-- termino 3 == 37025927037

termino :: Int -> Integer

termino n = numerador n `div` 3

-- (numerador n) es el numerador del término n-ésimo de la sucesión por

-- ejemplo,

-- λ> mapM_ print (map numerador [1..5])

-- 107811

-- 110778111

-- 111077781111

-- 111107777811111

-- 111110777778111111

numerador :: Int -> Integer

numerador n =

read (replicate n '1' ++ "0" ++ replicate n '7' ++ "81" ++ replicate n '1')

-- Propiedad

-- =========

-- La propiedad es

prop_sucesion :: Int -> Property

prop_sucesion n =

n >= 0 ==>

esCubo (sucesion !! n)

-- La comprobación es

-- λ> quickCheck prop_sucesion

-- +++ OK, passed 100 tests.

-- (esCubo x) se verifica si x es un cubo perfecto. Por ejemplo,

-- esCubo 27 == True

-- esCubo 28 == False

esCubo :: Integer -> Bool

esCubo x =

(raizCubicaEntera x)^3 == x

-- (raizCubicaEntera x) es el mayor entero cuyo cubo es menor o igual

-- que x. Por ejemplo,

-- raizCubicaEntera 26 == 2

-- raizCubicaEntera 27 == 3

-- raizCubicaEntera 28 == 3

raizCubicaEntera :: Integer -> Integer

raizCubicaEntera x = aux (1,x)

where aux (a,b) | d == x = c

| c == a = c

| d < x = aux (c,b)

| otherwise = aux (a,c)

where c = (a+b) `div` 2

d = c^3

-- Otra forma es observando los cubos de los términos de la sucesión

-- λ> map raizCubicaEntera (take 7 sucesion)

-- [33,333,3333,33333,333333,3333333,33333333]

-- La propiedad es

prop_sucesion2 :: Int -> Property

prop_sucesion2 n =

n >= 0 ==>

sucesion !! n == ((10^(n+2)-1) `div` 3)^3

-- La comprobación es

-- λ> quickCheck prop_sucesion2

-- +++ OK, passed 100 tests.

-- 2ª solución

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

-- Basada en la propiedad anterior.

sucesion2 :: [Integer]

sucesion2 =

[((10^n-1) `div` 3)^3 | n <- [2..]]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equiv :: Int -> Property

prop_equiv n =

n >= 0 ==>

sucesion !! n == sucesion2 !! n

-- La comprobación es

-- λ> quickCheck prop_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (show (sucesion !! (3*10^6)))

-- 9000005

-- (6.34 secs, 5,161,177,808 bytes)

-- λ> length (show (sucesion2 !! (3*10^6)))

-- 9000005

-- (2.72 secs, 1,124,065,328 bytes)

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>

Enlaces primos

PorJosé A. Alonso 15-abril-202122-abril-2021

Un enlace primo de longitud n es una permutación de 1, 2, …, n comienza con 1 y termina con n, tal que la suma de cada par de términos adyacentes es primo. Por ejemplo, para n = 6 la lista [1,4,3,2,5,6] es un enlace primo ua que las sumas de los pares de términos adyacentes son los números primos 5, 7, 5, 7, 11.

Definir la función

   enlacesPrimos :: Int -> [[Int]]

1	enlacesPrimos :: Int -> [[Int]]

tal que (enlacesPrimos n) es la lista de los enlaces primos de longitud n. Por ejemplo,

   λ> enlacesPrimos 6
   [[1,4,3,2,5,6]]
   λ> enlacesPrimos 7
   [[1,4,3,2,5,6,7],[1,6,5,2,3,4,7]]
   λ> enlacesPrimos 8
   [[1,2,5,6,7,4,3,8],[1,4,7,6,5,2,3,8],[1,2,3,4,7,6,5,8],[1,6,7,4,3,2,5,8]]
   λ> length (enlacesPrimos 10)
   24
   λ> length (head (enlacesPrimos (5*10^4)))
   50000

λ> enlacesPrimos 6

[[1,4,3,2,5,6]]

λ> enlacesPrimos 7

[[1,4,3,2,5,6,7],[1,6,5,2,3,4,7]]

λ> enlacesPrimos 8

[[1,2,5,6,7,4,3,8],[1,4,7,6,5,2,3,8],[1,2,3,4,7,6,5,8],[1,6,7,4,3,2,5,8]]

λ> length (enlacesPrimos 10)

λ> length (head (enlacesPrimos (5*10^4)))

50000

Soluciones

import Data.List (permutations, delete)
import Data.Numbers.Primes (isPrime)

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

enlacesPrimos :: Int -> [[Int]]
enlacesPrimos 1 = [[1]]
enlacesPrimos n =
  [ys | xs <- permutations [2..n-1],
       let ys = (1:xs)++[n],
       conEnlacesPrimos ys]

-- (conEnlacesPrimos xs) se verifica si las sumas de los elementos
-- adyacentes de xs son primos. Por ejemplo,
--    conEnlacesPrimos [1,4,3,2,5,6]  ==  True
--    conEnlacesPrimos [1,3,4,2,5,6]  ==  False
conEnlacesPrimos :: [Int] -> Bool
conEnlacesPrimos xs =
  all isPrime (enlaces xs)

-- (enlaces xs) es la lista de las sumas de los elementos adyacentes de
-- xs. Por ejemplo,
--    enlaces [1,4,3,2,5,6]  ==  [5,7,5,7,11]
--    enlaces [1,3,4,2,5,6]  ==  [4,7,6,7,11]
enlaces :: [Int] -> [Int]
enlaces xs =
  zipWith (+) xs (tail xs)

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

enlacesPrimos2 :: Int -> [[Int]]
enlacesPrimos2 1 = [[1]]
enlacesPrimos2 n = aux [(n-1,[n],[n-1,n-2..2])]
  where
    aux [] = []
    aux ((1,x:xs,_):ts) =
      [1:x:xs | isPrime (1+x)] ++ aux ts
    aux ((k,x:xs,ys):ts) =
      aux ([(k-1,y:x:xs,delete y ys) | y <-ys, isPrime (y+x)] ++ ts)

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

-- La comparación es
--    λ> length (enlacesPrimos 12)
--    216
--    (6.04 secs, 22,266,444,408 bytes)
--    λ> length (enlacesPrimos2 12)
--    216
--    (0.03 secs, 18,102,192 bytes)
--
--    λ> length (enlacesPrimos2 17)
--    59448
--    (2.69 secs, 8,514,104,800 bytes)

import Data.List (permutations, delete)

import Data.Numbers.Primes (isPrime)

-- 1ª solución

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

enlacesPrimos :: Int -> [[Int]]

enlacesPrimos 1 = [[1]]

enlacesPrimos n =

[ys | xs <- permutations [2..n-1],

let ys = (1:xs)++[n],

conEnlacesPrimos ys]

-- (conEnlacesPrimos xs) se verifica si las sumas de los elementos

-- adyacentes de xs son primos. Por ejemplo,

-- conEnlacesPrimos [1,4,3,2,5,6] == True

-- conEnlacesPrimos [1,3,4,2,5,6] == False

conEnlacesPrimos :: [Int] -> Bool

conEnlacesPrimos xs =

all isPrime (enlaces xs)

-- (enlaces xs) es la lista de las sumas de los elementos adyacentes de

-- xs. Por ejemplo,

-- enlaces [1,4,3,2,5,6] == [5,7,5,7,11]

-- enlaces [1,3,4,2,5,6] == [4,7,6,7,11]

enlaces :: [Int] -> [Int]

enlaces xs =

zipWith (+) xs (tail xs)

-- 2ª solución

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

enlacesPrimos2 :: Int -> [[Int]]

enlacesPrimos2 1 = [[1]]

enlacesPrimos2 n = aux [(n-1,[n],[n-1,n-2..2])]

where

aux [] = []

aux ((1,x:xs,_):ts) =

[1:x:xs | isPrime (1+x)] ++ aux ts

aux ((k,x:xs,ys):ts) =

aux ([(k-1,y:x:xs,delete y ys) | y <-ys, isPrime (y+x)] ++ ts)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (enlacesPrimos 12)

-- 216

-- (6.04 secs, 22,266,444,408 bytes)

-- λ> length (enlacesPrimos2 12)

-- 216

-- (0.03 secs, 18,102,192 bytes)

-- λ> length (enlacesPrimos2 17)

-- 59448

-- (2.69 secs, 8,514,104,800 bytes)

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>

Raíces digitales de sucesiones de raíces digitales

PorJosé A. Alonso 14-abril-202121-abril-2021

La raíz digital de un número entero positivo n es el dígito que resulta al sumar sus dígitos, volviendo a sumar reiteradamente los resultados de esa suma y de las siguientes hasta que la suma sea un número de un dígito, al que se llama la raíz digital del número n y se representa pod D(n). Por ejemplo, la raíz digital del número 2345 es 6, porque 2+3+4+5+1 = 15 y sumando los dígitos del 15 resulta 6.

La sucesión de las raices digitales definida por un número a es la sucesión a(n) tal que a(0) = a y a(n+1) es la suma de a(n) y la raíz dígital de a(n). Por ejemplo, los primeros términos de la sucesión de las raíces digitales definida por 1 son

   1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89,...

1	1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89,...

Definir la función

   raicesDigitalesSucesionRaicesDigitales :: Integer -> [Integer]

1	raicesDigitalesSucesionRaicesDigitales :: Integer -> [Integer]

tal que (raicesDigitalesSucesionRaicesDigitales a) es la lista de las raíces digitales de los elementos de la sucesión de raíces digitales definidas por a. Por ejemplo,

   λ> take 20 (raicesDigitalesSucesionRaicesDigitales 1)
   [1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2]
   λ> take 20 (raicesDigitalesSucesionRaicesDigitales 2021)
   [5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1]
   λ> raicesDigitalesSucesionRaicesDigitales (9^100) !! (10^9)
   9

λ> take 20 (raicesDigitalesSucesionRaicesDigitales 1)

[1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2]

λ> take 20 (raicesDigitalesSucesionRaicesDigitales 2021)

[5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1]

λ> raicesDigitalesSucesionRaicesDigitales (9^100) !! (10^9)

Soluciones

import Data.List (cycle)

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

raicesDigitalesSucesionRaicesDigitales :: Integer -> [Integer]
raicesDigitalesSucesionRaicesDigitales a =
  map raizDigital (sucesionRaicesDigitales a)

-- (sucesionRaicesDigitales a) es la sucesión de las raíces digitales
-- definida por un número a. Por ejemplo,
--    λ> take 22 (sucesionRaicesDigitales 1)
--    [1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89]
--    λ> take 22 (sucesionRaicesDigitales 3)
--    [3,6,12,15,21,24,30,33,39,42,48,51,57,60,66,69,75,78,84,87,93,96]
--    λ> take 22 (sucesionRaicesDigitales 5)
--    [5,10,11,13,17,25,32,37,38,40,44,52,59,64,65,67,71,79,86,91,92,94]
--    λ> take 22 (sucesionRaicesDigitales 7)
--    [7,14,19,20,22,26,34,41,46,47,49,53,61,68,73,74,76,80,88,95,100,101]
--    λ> take 22 (sucesionRaicesDigitales 9)
--    [9,18,27,36,45,54,63,72,81,90,99,108,117,126,135,144,153,162,171,180,189,198]
sucesionRaicesDigitales :: Integer -> [Integer]
sucesionRaicesDigitales a =
  iterate siguienteRaizDigital a

-- (siguienteRaizDigital a) es el siguiente de a en la sucesión de raices
-- digitales. Por ejemplo,
--    siguienteRaizDigital 23 == 28
siguienteRaizDigital :: Integer -> Integer
siguienteRaizDigital a =
  a + raizDigital a

-- (raizDigital n) es la raíz digital de n. Por ejemplo,
--    raizDigital 23451  ==  6
raizDigital :: Integer -> Integer
raizDigital n = 1 + (n-1) `mod` 9

-- (noPertenece x ys) se verifica si x no pertenece a la lista infinita
-- ordenada creciente ys. Por ejemplo,
--    noPertenece 2 [1,3..] == True
--    noPertenece 5 [1,3..] == False
noPertenece :: Integer -> [Integer] -> Bool
noPertenece x ys =
  not (x `pertenece` ys)

-- (Pertenece x ys) se verifica si x pertenece a la lista infinita
-- ordenada creciente ys. Por ejemplo,
--    pertenece 5 [1,3..] == True
--    pertenece 2 [1,3..] == False
pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)

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

-- En el ejercicio aterior vimos que sólo hay 5 sucesiones de ríace
-- digitales: las generadas por 1, 3, 5, 7 y 9. Las raíces digitales de
-- dichas sucesiones son
--    λ> take 20 (raicesDigitalesSucesionRaicesDigitales 1)
--    [1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2]
--    λ> take 20 (raicesDigitalesSucesionRaicesDigitales 3)
--    [3,6,3,6,3,6,3,6,3,6,3,6,3,6,3,6,3,6,3,6]
--    λ> take 20 (raicesDigitalesSucesionRaicesDigitales 5)
--    [5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1]
--    λ> take 20 (raicesDigitalesSucesionRaicesDigitales 7)
--    [7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5]
--    λ> take 20 (raicesDigitalesSucesionRaicesDigitales 9)
--    [9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9]
-- Se observa que todas son periódicas.

raicesDigitalesSucesionRaicesDigitales2 :: Integer -> [Integer]
raicesDigitalesSucesionRaicesDigitales2 a =
  cycle (d : takeWhile (/= d) (tail (raicesDigitalesSucesionRaicesDigitales a)))
  where d = raizDigital a

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

raicesDigitalesSucesionRaicesDigitales3 :: Integer -> [Integer]
raicesDigitalesSucesionRaicesDigitales3 a =
  case (raizDigital a) of
    1 -> cycle [1,2,4,8,7,5]
    2 -> cycle [2,4,8,7,5,1]
    3 -> cycle [3,6]
    4 -> cycle [4,8,7,5,1,2]
    5 -> cycle [5,1,2,4,8,7]
    6 -> cycle [6,3]
    7 -> cycle [7,5,1,2,4,8]
    8 -> cycle [8,7,5,1,2,4]
    9 -> cycle [9]

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

-- La comparación es
--    λ> raicesDigitalesSucesionRaicesDigitales (9^100) !! (3*10^6)
--    9
--    (4.23 secs, 2,160,860,128 bytes)
--    λ> raicesDigitalesSucesionRaicesDigitales2 (9^100) !! (3*10^6)
--    9
--    (0.02 secs, 103,768 bytes)
--    λ> raicesDigitalesSucesionRaicesDigitales3 (9^100) !! (3*10^6)
--    9
--    (0.02 secs, 103,056 bytes)
--
--    λ> raicesDigitalesSucesionRaicesDigitales2 (9^100) !! (10^9)
--    9
--    (2.09 secs, 103,608 bytes)
--    λ> raicesDigitalesSucesionRaicesDigitales3 (9^100) !! (10^9)
--    9
--    (2.25 secs, 102,952 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

import Data.List (cycle)

-- 1ª solución

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

raicesDigitalesSucesionRaicesDigitales :: Integer -> [Integer]

raicesDigitalesSucesionRaicesDigitales a =

map raizDigital (sucesionRaicesDigitales a)

-- (sucesionRaicesDigitales a) es la sucesión de las raíces digitales

-- definida por un número a. Por ejemplo,

-- λ> take 22 (sucesionRaicesDigitales 1)

-- [1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89]

-- λ> take 22 (sucesionRaicesDigitales 3)

-- [3,6,12,15,21,24,30,33,39,42,48,51,57,60,66,69,75,78,84,87,93,96]

-- λ> take 22 (sucesionRaicesDigitales 5)

-- [5,10,11,13,17,25,32,37,38,40,44,52,59,64,65,67,71,79,86,91,92,94]

-- λ> take 22 (sucesionRaicesDigitales 7)

-- [7,14,19,20,22,26,34,41,46,47,49,53,61,68,73,74,76,80,88,95,100,101]

-- λ> take 22 (sucesionRaicesDigitales 9)

-- [9,18,27,36,45,54,63,72,81,90,99,108,117,126,135,144,153,162,171,180,189,198]

sucesionRaicesDigitales :: Integer -> [Integer]

sucesionRaicesDigitales a =

iterate siguienteRaizDigital a

-- (siguienteRaizDigital a) es el siguiente de a en la sucesión de raices

-- digitales. Por ejemplo,

-- siguienteRaizDigital 23 == 28

siguienteRaizDigital :: Integer -> Integer

siguienteRaizDigital a =

a + raizDigital a

-- (raizDigital n) es la raíz digital de n. Por ejemplo,

-- raizDigital 23451 == 6

raizDigital :: Integer -> Integer

raizDigital n = 1 + (n-1) `mod` 9

-- (noPertenece x ys) se verifica si x no pertenece a la lista infinita

-- ordenada creciente ys. Por ejemplo,

-- noPertenece 2 [1,3..] == True

-- noPertenece 5 [1,3..] == False

noPertenece :: Integer -> [Integer] -> Bool

noPertenece x ys =

not (x `pertenece` ys)

-- (Pertenece x ys) se verifica si x pertenece a la lista infinita

-- ordenada creciente ys. Por ejemplo,

-- pertenece 5 [1,3..] == True

-- pertenece 2 [1,3..] == False

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

pertenece x ys =

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

-- 2ª solución

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

-- En el ejercicio aterior vimos que sólo hay 5 sucesiones de ríace

-- digitales: las generadas por 1, 3, 5, 7 y 9. Las raíces digitales de

-- dichas sucesiones son

-- λ> take 20 (raicesDigitalesSucesionRaicesDigitales 1)

-- [1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2]

-- λ> take 20 (raicesDigitalesSucesionRaicesDigitales 3)

-- [3,6,3,6,3,6,3,6,3,6,3,6,3,6,3,6,3,6,3,6]

-- λ> take 20 (raicesDigitalesSucesionRaicesDigitales 5)

-- [5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1]

-- λ> take 20 (raicesDigitalesSucesionRaicesDigitales 7)

-- [7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5]

-- λ> take 20 (raicesDigitalesSucesionRaicesDigitales 9)

-- [9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9]

-- Se observa que todas son periódicas.

raicesDigitalesSucesionRaicesDigitales2 :: Integer -> [Integer]

raicesDigitalesSucesionRaicesDigitales2 a =

cycle (d : takeWhile (/= d) (tail (raicesDigitalesSucesionRaicesDigitales a)))

where d = raizDigital a

-- 3ª solución

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

raicesDigitalesSucesionRaicesDigitales3 :: Integer -> [Integer]

raicesDigitalesSucesionRaicesDigitales3 a =

case (raizDigital a) of

1 -> cycle [1,2,4,8,7,5]

2 -> cycle [2,4,8,7,5,1]

3 -> cycle [3,6]

4 -> cycle [4,8,7,5,1,2]

5 -> cycle [5,1,2,4,8,7]

6 -> cycle [6,3]

7 -> cycle [7,5,1,2,4,8]

8 -> cycle [8,7,5,1,2,4]

9 -> cycle [9]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> raicesDigitalesSucesionRaicesDigitales (9^100) !! (3*10^6)

-- 9

-- (4.23 secs, 2,160,860,128 bytes)

-- λ> raicesDigitalesSucesionRaicesDigitales2 (9^100) !! (3*10^6)

-- 9

-- (0.02 secs, 103,768 bytes)

-- λ> raicesDigitalesSucesionRaicesDigitales3 (9^100) !! (3*10^6)

-- 9

-- (0.02 secs, 103,056 bytes)

-- λ> raicesDigitalesSucesionRaicesDigitales2 (9^100) !! (10^9)

-- 9

-- (2.09 secs, 103,608 bytes)

-- λ> raicesDigitalesSucesionRaicesDigitales3 (9^100) !! (10^9)

-- 9

-- (2.25 secs, 102,952 bytes)

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>

Sucesiones de raíces digitales

PorJosé A. Alonso 13-abril-202120-abril-2021

La raíz digital de un número entero positivo n es el dígito resulta al sumar sus dígitos, volviendo a sumar reiteradamente resultados de esa suma y de las siguientes hasta que la suma sea un número de un dígito, al que se llama la raíz digital del número n y se representa pod D(n). Por ejemplo, la raíz digital del número 23451 es 6, porque 2+3+4+5+1 = 15 y sumando los dígitos del 15 resulta 6.

   1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89,...

1	1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89,...

Se observa que el menor número que no pertenece a la sucesión anterior es 3. Los primeros términos de la sucesión de las raíces digitales definida por 3 son

   3,6,12,15,21,24,30,33,39,42,48,51,57,60,66,69,75,78,84,87,93,96,...

1	3,6,12,15,21,24,30,33,39,42,48,51,57,60,66,69,75,78,84,87,93,96,...

Se observa que el menor número que no pertenece a las 2 sucesiones anteriores es 5. Los primeros términos de la sucesión de las raíces digitales definida por 5 son

   5,10,11,13,17,25,32,37,38,40,44,52,59,64,65,67,71,79,86,91,92,94,...

1	5,10,11,13,17,25,32,37,38,40,44,52,59,64,65,67,71,79,86,91,92,94,...

Definir la función

   sucesionSucesionesRaicesDigitales :: [[Integer]]

1	sucesionSucesionesRaicesDigitales :: [[Integer]]

tal que sus elementos son las sucesiones de raíces digitales tal el primer elemento de cada sucesión es el menor elemento que no pertenece a las sucesiones anteriores. Por ejemplo,

   λ> map (take 5) (take 4 sucesionSucesionesRaicesDigitales)
   [[1,2,4,8,16],[3,6,12,15,21],[5,10,11,13,17],[7,14,19,20,22]]

1 2	λ> map (take 5) (take 4 sucesionSucesionesRaicesDigitales) [[1,2,4,8,16],[3,6,12,15,21],[5,10,11,13,17],[7,14,19,20,22]]

Comprobar con QuickCheck que sucesionSucesionesRaicesDigitales tiene exactamente 5 elementos.

Soluciones

import Test.QuickCheck

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

sucesionSucesionesRaicesDigitales :: [[Integer]]
sucesionSucesionesRaicesDigitales =
  map aux [1..]
  where aux 1 = sucesionRaicesDigitales 1
        aux n = sucesionRaicesDigitales m
          where m = head [a | a <- [1..],
                              all (a `noPertenece`)
                                  [aux k | k <- [1..n-1]]]

-- (sucesionRaicesDigitales a) es la sucesión de las raíces digitales
-- definida por un número a. Por ejemplo,
--    λ> take 22 (sucesionRaicesDigitales 1)
--    [1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89]
--    λ> take 22 (sucesionRaicesDigitales 3)
--    [3,6,12,15,21,24,30,33,39,42,48,51,57,60,66,69,75,78,84,87,93,96]
--    λ> take 22 (sucesionRaicesDigitales 5)
--    [5,10,11,13,17,25,32,37,38,40,44,52,59,64,65,67,71,79,86,91,92,94]
--    λ> take 22 (sucesionRaicesDigitales 7)
--    [7,14,19,20,22,26,34,41,46,47,49,53,61,68,73,74,76,80,88,95,100,101]
--    λ> take 22 (sucesionRaicesDigitales 9)
--    [9,18,27,36,45,54,63,72,81,90,99,108,117,126,135,144,153,162,171,180,189,198]
sucesionRaicesDigitales :: Integer -> [Integer]
sucesionRaicesDigitales a =
  iterate siguienteRaizDigital a

-- (siguienteRaizDigital a) es el siguiente de a en la sucesión de raices
-- digitales. Por ejemplo,
--    siguienteRaizDigital 23 == 28
siguienteRaizDigital :: Integer -> Integer
siguienteRaizDigital a =
  a + raizDigital a

-- (raizDigital n) es la raíz digital de n. Por ejemplo,
--    raizDigital 23451  ==  6
raizDigital :: Integer -> Integer
raizDigital n = 1 + (n-1) `mod` 9

-- (noPertenece x ys) se verifica si x no pertenece a la lista infinita
-- ordenada creciente ys. Por ejemplo,
--    noPertenece 2 [1,3..] == True
--    noPertenece 5 [1,3..] == False
noPertenece :: Integer -> [Integer] -> Bool
noPertenece x ys =
  not (x `pertenece` ys)

-- (Pertenece x ys) se verifica si x pertenece a la lista infinita
-- ordenada creciente ys. Por ejemplo,
--    pertenece 5 [1,3..] == True
--    pertenece 2 [1,3..] == False
pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  x == head (dropWhile (<x) ys)

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

sucesionSucesionesRaicesDigitales2 :: [[Integer]]
sucesionSucesionesRaicesDigitales2 = aux [1..]
  where aux xs = sucesion xs : aux (diferencia xs (sucesion xs))
        sucesion xs = sucesionRaicesDigitales (head xs)

-- (diferencia xs ys) es la diferencia las listas infinitas ordenadas
-- crecientes xs e ys. Por ejemplo,
--    λ> take 8 (diferencia [1..] [2,4..])
--    [1,3,5,7,9,11,13,15]
diferencia :: [Integer] -> [Integer] -> [Integer]
diferencia (x:xs) (y:ys)
  | x == y    = diferencia xs ys
  | otherwise = x : diferencia xs (y:ys)

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

-- Del cálculo 
--    λ> map (take 4) (take 5 sucesionSucesionesRaicesDigitales)
--    [[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,20],[9,18,27,36]]
-- se deduce que tiene al menos 5. Sólo queda por comprobar que no tiene más; es decir
prop_sucesionSucesionesRaicesDigitales :: Integer -> Property
prop_sucesionSucesionesRaicesDigitales n =
  n > 0 ==>
  any (n `pertenece`) xss
  where xss = take 5 (sucesionSucesionesRaicesDigitales2)

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

import Test.QuickCheck

-- 1ª solución

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

sucesionSucesionesRaicesDigitales :: [[Integer]]

sucesionSucesionesRaicesDigitales =

map aux [1..]

where aux 1 = sucesionRaicesDigitales 1

aux n = sucesionRaicesDigitales m

where m = head [a | a <- [1..],

all (a `noPertenece`)

[aux k | k <- [1..n-1]]]

-- (sucesionRaicesDigitales a) es la sucesión de las raíces digitales

-- definida por un número a. Por ejemplo,

-- λ> take 22 (sucesionRaicesDigitales 1)

-- [1,2,4,8,16,23,28,29,31,35,43,50,55,56,58,62,70,77,82,83,85,89]

-- λ> take 22 (sucesionRaicesDigitales 3)

-- [3,6,12,15,21,24,30,33,39,42,48,51,57,60,66,69,75,78,84,87,93,96]

-- λ> take 22 (sucesionRaicesDigitales 5)

-- [5,10,11,13,17,25,32,37,38,40,44,52,59,64,65,67,71,79,86,91,92,94]

-- λ> take 22 (sucesionRaicesDigitales 7)

-- [7,14,19,20,22,26,34,41,46,47,49,53,61,68,73,74,76,80,88,95,100,101]

-- λ> take 22 (sucesionRaicesDigitales 9)

-- [9,18,27,36,45,54,63,72,81,90,99,108,117,126,135,144,153,162,171,180,189,198]

sucesionRaicesDigitales :: Integer -> [Integer]

sucesionRaicesDigitales a =

iterate siguienteRaizDigital a

-- (siguienteRaizDigital a) es el siguiente de a en la sucesión de raices

-- digitales. Por ejemplo,

-- siguienteRaizDigital 23 == 28

siguienteRaizDigital :: Integer -> Integer

siguienteRaizDigital a =

a + raizDigital a

-- (raizDigital n) es la raíz digital de n. Por ejemplo,

-- raizDigital 23451 == 6

raizDigital :: Integer -> Integer

raizDigital n = 1 + (n-1) `mod` 9

-- (noPertenece x ys) se verifica si x no pertenece a la lista infinita

-- ordenada creciente ys. Por ejemplo,

-- noPertenece 2 [1,3..] == True

-- noPertenece 5 [1,3..] == False

noPertenece :: Integer -> [Integer] -> Bool

noPertenece x ys =

not (x `pertenece` ys)

-- (Pertenece x ys) se verifica si x pertenece a la lista infinita

-- ordenada creciente ys. Por ejemplo,

-- pertenece 5 [1,3..] == True

-- pertenece 2 [1,3..] == False

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

pertenece x ys =

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

-- 2ª solución

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

sucesionSucesionesRaicesDigitales2 :: [[Integer]]

sucesionSucesionesRaicesDigitales2 = aux [1..]

where aux xs = sucesion xs : aux (diferencia xs (sucesion xs))

sucesion xs = sucesionRaicesDigitales (head xs)

-- (diferencia xs ys) es la diferencia las listas infinitas ordenadas

-- crecientes xs e ys. Por ejemplo,

-- λ> take 8 (diferencia [1..] [2,4..])

-- [1,3,5,7,9,11,13,15]

diferencia :: [Integer] -> [Integer] -> [Integer]

diferencia (x:xs) (y:ys)

| x == y = diferencia xs ys

| otherwise = x : diferencia xs (y:ys)

-- Propiedad

-- =========

-- Del cálculo

-- λ> map (take 4) (take 5 sucesionSucesionesRaicesDigitales)

-- [[1,2,4,8],[3,6,12,15],[5,10,11,13],[7,14,19,20],[9,18,27,36]]

-- se deduce que tiene al menos 5. Sólo queda por comprobar que no tiene más; es decir

prop_sucesionSucesionesRaicesDigitales :: Integer -> Property

prop_sucesionSucesionesRaicesDigitales n =

n > 0 ==>

any (n `pertenece`) xss

where xss = take 5 (sucesionSucesionesRaicesDigitales2)

-- La comprobación es

-- λ> quickCheck prop_sucesionSucesionesRaicesDigitales

-- +++ OK, passed 100 tests.

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>

Raíces digitales de los números de Fibonacci

PorJosé A. Alonso 12-abril-202119-abril-2021

La sucesión Fibonacci es la siguiente sucesión infinita de números naturales:

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

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

La sucesión comienza con los números 1 y 1 y, a partir de estos, cada término es la suma de los dos anteriores.

Definir la función

   raizDigitalFibonacci :: Integer -> Integer

1	raizDigitalFibonacci :: Integer -> Integer

tal que (raizDigitalFibonacci n) es la raíz digital del n-ésimo número de Fibonacci. Por ejemplo,

   raizDigitalFibonacci 6         ==  4
   raizDigitalFibonacci 7         ==  3
   raizDigitalFibonacci (3*10^7)  ==  1

raizDigitalFibonacci 6 == 4

raizDigitalFibonacci 7 == 3

raizDigitalFibonacci (3*10^7) == 1

Soluciones

import Data.List (genericIndex, cycle)

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

raizDigitalFibonacci :: Integer -> Integer
raizDigitalFibonacci =
  raizDigital . fibonacci

-- (fibonacci k) es el k-ésimo número de Fibonacci. Por ejemplo,
fibonacci :: Integer -> Integer
fibonacci 0 = 1
fibonacci 1 = 1
fibonacci n = fibonacci (n-1) + fibonacci (n-2)

-- (raizDigital n) es la raíz digital de n. Por ejemplo,
--    raizDigital 23451  ==  6
raizDigital :: Integer -> Integer
raizDigital n = 1 + (n-1) `mod` 9

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

raizDigitalFibonacci2 :: Integer -> Integer
raizDigitalFibonacci2 n =
  raizDigital (fibs `genericIndex` n)

-- fibs es la la sucesión de los números de Fibonacci. Por ejemplo,
--    take 14 fibs  == [1,1,2,3,5,8,13,21,34,55,89,144,233,377]
fibs :: [Integer]
fibs = 1 : scanl (+) 1 fibs

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

-- En el cálculo
---   λ> map raizDigitalFibonacci2 [0..47]
---   [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9,
--     1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]
-- se observa que la lista es periódica con período
--    1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9,

raizDigitalFibonacci3 :: Integer -> Integer
raizDigitalFibonacci3 n =
  raicesDigitalesFibonacci `genericIndex` n

-- raicesDigitalesFibonacci es la suceción de las raíces digitales de
-- los números de Fibonacci. Por ejemplo,
---   λ> take 24 raicesDigitalesFibonacci
---   [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]
raicesDigitalesFibonacci :: [Integer]
raicesDigitalesFibonacci =
  concat (repeat [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9])

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

raizDigitalFibonacci4 :: Integer -> Integer
raizDigitalFibonacci4 n =
  raicesDigitalesFibonacci2 `genericIndex` n

-- raicesDigitalesFibonacci2 es la suceción de las raíces digitales de
-- los números de Fibonacci. Por ejemplo,
---   λ> take 24 raicesDigitalesFibonacci2
---   [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]
raicesDigitalesFibonacci2 :: [Integer]
raicesDigitalesFibonacci2 =
  cycle [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]

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

-- La comparación es
--    λ> raizDigitalFibonacci 34
--    8
--    (7.88 secs, 3,560,871,624 bytes)
--    λ> raizDigitalFibonacci2 34
--    8
--    (0.01 secs, 106,896 bytes)
--    λ> raizDigitalFibonacci3 34
--    8
--    (0.01 secs, 106,568 bytes)
--    λ> raizDigitalFibonacci4 34
--    8
--    (0.01 secs, 107,512 bytes)
--
--    λ> raizDigitalFibonacci2 (4*10^5)
--    4
--    (3.19 secs, 7,146,227,192 bytes)
--    λ> raizDigitalFibonacci3 (4*10^5)
--    4
--    (0.05 secs, 80,635,064 bytes)
--    λ> raizDigitalFibonacci4 (4*10^5)
--    4
--    (0.05 secs, 57,701,392 bytes)
--
--    λ> raizDigitalFibonacci3 (10^7)
--    4
--    (1.34 secs, 2,013,435,912 bytes)
--    λ> raizDigitalFibonacci4 (10^7)
--    4
--    (0.66 secs, 1,440,100,712 bytes)
--
--    λ> raizDigitalFibonacci4 (3*10^7)
--    1
--    (1.92 secs, 4,320,102,368 bytes)

100

101

102

103

104

105

106

import Data.List (genericIndex, cycle)

-- 1ª solución

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

raizDigitalFibonacci :: Integer -> Integer

raizDigitalFibonacci =

raizDigital . fibonacci

-- (fibonacci k) es el k-ésimo número de Fibonacci. Por ejemplo,

fibonacci :: Integer -> Integer

fibonacci 0 = 1

fibonacci 1 = 1

fibonacci n = fibonacci (n-1) + fibonacci (n-2)

-- (raizDigital n) es la raíz digital de n. Por ejemplo,

-- raizDigital 23451 == 6

raizDigital :: Integer -> Integer

raizDigital n = 1 + (n-1) `mod` 9

-- 2ª solución

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

raizDigitalFibonacci2 :: Integer -> Integer

raizDigitalFibonacci2 n =

raizDigital (fibs `genericIndex` n)

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

-- take 14 fibs == [1,1,2,3,5,8,13,21,34,55,89,144,233,377]

fibs :: [Integer]

fibs = 1 : scanl (+) 1 fibs

-- 3ª solución

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

-- En el cálculo

--- λ> map raizDigitalFibonacci2 [0..47]

--- [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9,

-- 1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]

-- se observa que la lista es periódica con período

-- 1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9,

raizDigitalFibonacci3 :: Integer -> Integer

raizDigitalFibonacci3 n =

raicesDigitalesFibonacci `genericIndex` n

-- raicesDigitalesFibonacci es la suceción de las raíces digitales de

-- los números de Fibonacci. Por ejemplo,

--- λ> take 24 raicesDigitalesFibonacci

--- [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]

raicesDigitalesFibonacci :: [Integer]

raicesDigitalesFibonacci =

concat (repeat [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9])

-- 4ª solución

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

raizDigitalFibonacci4 :: Integer -> Integer

raizDigitalFibonacci4 n =

raicesDigitalesFibonacci2 `genericIndex` n

-- raicesDigitalesFibonacci2 es la suceción de las raíces digitales de

-- los números de Fibonacci. Por ejemplo,

--- λ> take 24 raicesDigitalesFibonacci2

--- [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]

raicesDigitalesFibonacci2 :: [Integer]

raicesDigitalesFibonacci2 =

cycle [1,1,2,3,5,8,4,3,7,1,8,9,8,8,7,6,4,1,5,6,2,8,1,9]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> raizDigitalFibonacci 34

-- 8

-- (7.88 secs, 3,560,871,624 bytes)

-- λ> raizDigitalFibonacci2 34

-- 8

-- (0.01 secs, 106,896 bytes)

-- λ> raizDigitalFibonacci3 34

-- 8

-- (0.01 secs, 106,568 bytes)

-- λ> raizDigitalFibonacci4 34

-- 8

-- (0.01 secs, 107,512 bytes)

-- λ> raizDigitalFibonacci2 (4*10^5)

-- 4

-- (3.19 secs, 7,146,227,192 bytes)

-- λ> raizDigitalFibonacci3 (4*10^5)

-- 4

-- (0.05 secs, 80,635,064 bytes)

-- λ> raizDigitalFibonacci4 (4*10^5)

-- 4

-- (0.05 secs, 57,701,392 bytes)

-- λ> raizDigitalFibonacci3 (10^7)

-- 4

-- (1.34 secs, 2,013,435,912 bytes)

-- λ> raizDigitalFibonacci4 (10^7)

-- 4

-- (0.66 secs, 1,440,100,712 bytes)

-- λ> raizDigitalFibonacci4 (3*10^7)

-- 1

-- (1.92 secs, 4,320,102,368 bytes)

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>

Raíces digitales de los números de Fermat.

PorJosé A. Alonso 9-abril-202116-abril-2021

Los números de Fermat son los número de la forma F(n) = 2^(2^n) + 1, donde n es un número natural.

Definir la función

   raizDigitalFermat :: Integer -> Integer

1	raizDigitalFermat :: Integer -> Integer

tal que (raizDigitalFermat n) es la raíz digital del n-ésimo número de Fermat. Por ejemplo,

   raizDigitalFermat 3          ==  5
   raizDigitalFermat (10^2021)  ==  8

1 2	raizDigitalFermat 3 == 5 raizDigitalFermat (10^2021) == 8

Soluciones

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

raizDigitalFermat :: Integer -> Integer
raizDigitalFermat =
  raizDigital . fermat

-- (fermat k) es el k-ésimo número de Fermat. Por ejemplo,
--    fermat 0  ==  3
--    fermat 1  ==  5
--    fermat 2  ==  17
--    fermat 3  ==  257
--    fermat 4  ==  65537
--    fermat 5  ==  4294967297
fermat :: Integer -> Integer
fermat k = 1 + 2^(2^k)

-- (raizDigital n) es la raíz digital de n. Por ejemplo,
--    raizDigital 23451  ==  6
raizDigital :: Integer -> Integer
raizDigital n = 1 + (n-1) `mod` 9

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

-- En el cálculo
--    λ> map raizDigitalFermat [0..20]
--    [3,5,8,5,8,5,8,5,8,5,8,5,8,5,8,5,8,5,8,5,8]
-- se observa que se compone del 3 seguido por la repetición periódica
-- de 5 y 8.

raizDigitalFermat2 :: Integer -> Integer
raizDigitalFermat2 0 = 3
raizDigitalFermat2 n
  | odd n     = 5
  | otherwise = 8

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

-- La comparación es
--    λ> raizDigitalFermat 30
--    8
--    (6.76 secs, 536,981,128 bytes)
--    λ> raizDigitalFermat2 30
--    8
--    (0.01 secs, 98,400 bytes)

-- 1ª solución

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

raizDigitalFermat :: Integer -> Integer

raizDigitalFermat =

raizDigital . fermat

-- (fermat k) es el k-ésimo número de Fermat. Por ejemplo,

-- fermat 0 == 3

-- fermat 1 == 5

-- fermat 2 == 17

-- fermat 3 == 257

-- fermat 4 == 65537

-- fermat 5 == 4294967297

fermat :: Integer -> Integer

fermat k = 1 + 2^(2^k)

-- (raizDigital n) es la raíz digital de n. Por ejemplo,

-- raizDigital 23451 == 6

raizDigital :: Integer -> Integer

raizDigital n = 1 + (n-1) `mod` 9

-- 2ª solución

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

-- En el cálculo

-- λ> map raizDigitalFermat [0..20]

-- [3,5,8,5,8,5,8,5,8,5,8,5,8,5,8,5,8,5,8,5,8]

-- se observa que se compone del 3 seguido por la repetición periódica

-- de 5 y 8.

raizDigitalFermat2 :: Integer -> Integer

raizDigitalFermat2 0 = 3

raizDigitalFermat2 n

| odd n = 5

| otherwise = 8

-- Comparación de eficiencia

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

-- La comparación es

-- λ> raizDigitalFermat 30

-- 8

-- (6.76 secs, 536,981,128 bytes)

-- λ> raizDigitalFermat2 30

-- 8

-- (0.01 secs, 98,400 bytes)

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>

Persistencia aditiva

PorJosé A. Alonso 8-abril-202115-abril-2021

La raíz digital de un número entero positivo n es el dígito resulta al sumar sus dígitos, volviendo a sumar reiteradamente los resultados de esa suma y de las siguientes hasta que la suma sea un número de un dígito, al que se llama la raíz digital del número n y se representa pod D(n). Por ejemplo, la raíz digital del número 23451 es 6, porque 2+3+4+5+1 = 15 y sumando los dígitos del 15 resulta 6.

La persistencia aditiva de un número entero positivo es el número de veces que hay sumar sus dígitos para llegar a su raíz digital. Por ejemplo, la persistencia aditiva de 2718 es 2: primero encontramos que 2+7+1+8 = 18, luego que 1+8 = 9.

Definir la función

   persistencia :: Integer -> Integer

1	persistencia :: Integer -> Integer

tal que (persistencia n) es la persistencia del número entero positivo n. Por ejemplo,

   persistencia 2718                     ==  2
   persistencia 199                      ==  3
   persistencia 19999999999999999999999  ==  4

persistencia 2718 == 2

persistencia 199 == 3

persistencia 19999999999999999999999 == 4

Soluciones

import Data.List (genericLength)
import Test.QuickCheck (Property, (==>), quickCheck)

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

persistencia :: Integer -> Integer
persistencia n
  | n < 10    = 0
  | otherwise = 1 + persistencia (sumaDigitos n)

-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,
--    sumaDigitos 2021  ==  5
sumaDigitos :: Integer -> Integer
sumaDigitos = sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 2021  ==  [2,0,2,1]
digitos :: Integer -> [Integer]
digitos x = [read [c] | c <- show x]

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

persistencia2 :: Integer -> Integer
persistencia2 = aux 0
  where aux m n
          | n < 10    = m
          | otherwise = aux (m+1) (sumaDigitos n)

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

persistencia3 :: Integer -> Integer
persistencia3 n =
  genericLength (takeWhile (>9) (iterate sumaDigitos n))

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

-- La propiedad es
prop_equiv :: Integer -> Property
prop_equiv n =
  n > 0 ==>
  all (== (persistencia n))
      [persistencia2 n,
       persistencia3 n]

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

import Data.List (genericLength)

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª solución

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

persistencia :: Integer -> Integer

persistencia n

| n < 10 = 0

| otherwise = 1 + persistencia (sumaDigitos n)

-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,

-- sumaDigitos 2021 == 5

sumaDigitos :: Integer -> Integer

sumaDigitos = sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 2021 == [2,0,2,1]

digitos :: Integer -> [Integer]

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

-- 2ª solución

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

persistencia2 :: Integer -> Integer

persistencia2 = aux 0

where aux m n

| n < 10 = m

| otherwise = aux (m+1) (sumaDigitos n)

-- 3ª solución

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

persistencia3 :: Integer -> Integer

persistencia3 n =

genericLength (takeWhile (>9) (iterate sumaDigitos n))

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equiv :: Integer -> Property

prop_equiv n =

n > 0 ==>

all (== (persistencia n))

[persistencia2 n,

persistencia3 n]

-- La comprobación es

-- λ> quickCheck prop_equiv

-- +++ OK, passed 100 tests.

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>

Raíces digitales de potencias de dos

PorJosé A. Alonso 7-abril-202114-abril-2021

La raíz digital de un número entero positivo n es el dígito resulta al sumar sus dígitos, volviendo a sumar reiteradamente los resultados de esa suma y de las siguientes hasta que la suma sea un número de un dígito, al que se llama la raíz digital del número n y se representa por D(n). Por ejemplo, la raíz digital del número 23451 es 6, porque 2+3+4+5+1 = 15 y sumando los dígitos del 15 resulta 6.

Definir la función

   raizDigitalPotencia :: Integer -> Integer

1	raizDigitalPotencia :: Integer -> Integer

tal que (raizDigitalPotencia n) es la raíz digital de 2^n. Por ejemplo,

   raizDigitalPotencia 6            ==  1
   raizDigitalPotencia (10^(10^8))  ==  7

1 2	raizDigitalPotencia 6 == 1 raizDigitalPotencia (10^(10^8)) == 7

Soluciones

import Test.QuickCheck (Property, (==>), quickCheck)

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

raizDigitalPotencia :: Integer -> Integer
raizDigitalPotencia n =
  raizDigital (2^n)

-- (raizDigital n) es la raíz digital de n. Por ejemplo,
--    raizDigital 23451  ==  6
raizDigital :: Integer -> Integer
raizDigital n = 1 + (n-1) `mod` 9

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

-- Calculando las raíces digitales de los primeros números se obtiene
--    λ> map raizDigitalPotencia [0..29]
--    [1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5]
-- Se observa se repite el período 1,2,4,8,7,5.

raizDigitalPotencia2 :: Integer -> Integer
raizDigitalPotencia2 n
    | m == 0 = 1
    | m == 1 = 2
    | m == 2 = 4
    | m == 3 = 8
    | m == 4 = 7
    | m == 5 = 5
  where m = n `mod` 6

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

raizDigitalPotencia3 :: Integer -> Integer
raizDigitalPotencia3 n =
  case (n `mod` 6) of
    0 -> 1
    1 -> 2
    2 -> 4
    3 -> 8
    4 -> 7
    5 -> 5

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

raizDigitalPotencia4 :: Integer -> Integer
raizDigitalPotencia4 n =
  raizDigital (2^(mod n 6))

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

-- La propiedad es
prop_raizDigitalPotencia :: Integer -> Property
prop_raizDigitalPotencia n =
  n >= 0 ==>
  all (== (raizDigitalPotencia n))
      [raizDigitalPotencia2 n,
       raizDigitalPotencia3 n,
       raizDigitalPotencia4 n]

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

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

-- La comparación es
--    λ> raizDigitalPotencia 300000000
--    1
--    (2.82 secs, 149,107,152 bytes)
--    λ> raizDigitalPotencia2 300000000
--    1
--    (0.01 secs, 98,480 bytes)
--    λ> raizDigitalPotencia3 300000000
--    1
--    (0.01 secs, 98,440 bytes)
--    λ> raizDigitalPotencia4 300000000
--    1
--    (0.01 secs, 98,568 bytes)
--
--    λ> raizDigitalPotencia2 (10^(10^8))
--    7
--    (3.09 secs, 123,233,992 bytes)
--    λ> raizDigitalPotencia3 (10^(10^8))
--    7
--    (3.07 secs, 123,232,728 bytes)
--    λ> raizDigitalPotencia4 (10^(10^8))
--    7
--    (3.18 secs, 123,234,344 bytes)

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª solución

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

raizDigitalPotencia :: Integer -> Integer

raizDigitalPotencia n =

raizDigital (2^n)

-- (raizDigital n) es la raíz digital de n. Por ejemplo,

-- raizDigital 23451 == 6

raizDigital :: Integer -> Integer

raizDigital n = 1 + (n-1) `mod` 9

-- 2ª solución

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

-- Calculando las raíces digitales de los primeros números se obtiene

-- λ> map raizDigitalPotencia [0..29]

-- [1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5,1,2,4,8,7,5]

-- Se observa se repite el período 1,2,4,8,7,5.

raizDigitalPotencia2 :: Integer -> Integer

raizDigitalPotencia2 n

| m == 0 = 1

| m == 1 = 2

| m == 2 = 4

| m == 3 = 8

| m == 4 = 7

| m == 5 = 5

where m = n `mod` 6

-- 3ª solución

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

raizDigitalPotencia3 :: Integer -> Integer

raizDigitalPotencia3 n =

case (n `mod` 6) of

0 -> 1

1 -> 2

2 -> 4

3 -> 8

4 -> 7

5 -> 5

-- 4ª solución

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

raizDigitalPotencia4 :: Integer -> Integer

raizDigitalPotencia4 n =

raizDigital (2^(mod n 6))

-- Comprobación de equivalencia

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

-- La propiedad es

prop_raizDigitalPotencia :: Integer -> Property

prop_raizDigitalPotencia n =

n >= 0 ==>

all (== (raizDigitalPotencia n))

[raizDigitalPotencia2 n,

raizDigitalPotencia3 n,

raizDigitalPotencia4 n]

-- La comprobación es

-- λ> quickCheck prop_raizDigitalPotencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> raizDigitalPotencia 300000000

-- 1

-- (2.82 secs, 149,107,152 bytes)

-- λ> raizDigitalPotencia2 300000000

-- 1

-- (0.01 secs, 98,480 bytes)

-- λ> raizDigitalPotencia3 300000000

-- 1

-- (0.01 secs, 98,440 bytes)

-- λ> raizDigitalPotencia4 300000000

-- 1

-- (0.01 secs, 98,568 bytes)

-- λ> raizDigitalPotencia2 (10^(10^8))

-- 7

-- (3.09 secs, 123,233,992 bytes)

-- λ> raizDigitalPotencia3 (10^(10^8))

-- 7

-- (3.07 secs, 123,232,728 bytes)

-- λ> raizDigitalPotencia4 (10^(10^8))

-- 7

-- (3.18 secs, 123,234,344 bytes)

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>

Raíz digital

PorJosé A. Alonso 6-abril-202113-abril-2021

La raíz digital de un número entero positivo n es el dígito que resulta al sumar sus dígitos, volviendo a sumar reiteradamente los resultados de esa suma y de las siguientes hasta que la suma sea un número de un dígito, al que se llama la raíz digital del número n y se representa por D(n). Por ejemplo, la raíz digital del número 23451 es 6, porque 2+3+4+5+1 = 15 y sumando los dígitos del 15 resulta 6.

Definir la función

   raizDigital :: Integer -> Integer

1	raizDigital :: Integer -> Integer

tal que (raizDigital n) es la raíz digital del entero positivo n. Por ejemplo,

   raizDigital 23451  ==  6

1	raizDigital 23451 == 6

Comprobar con QuickCheck las siguientes propiedades de la raíz digital:

D(m + n) = D(D(m) + D(n)).
D(mn) = D(D(m)D(n)).
D(m^n) = D(D(m)^n).
D(D(n)) = D(n).
D(n + 9) = D(n).
D(9n) = 9.

Soluciones

import Test.QuickCheck (Property, (==>), quickCheck)

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

raizDigital :: Integer -> Integer
raizDigital n
  | n < 10    = n
  | otherwise = raizDigital (sumaDigitos n)

-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,
--    sumaDigitos 2021  ==  5
sumaDigitos :: Integer -> Integer
sumaDigitos = sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 2021  ==  [2,0,2,1]
digitos :: Integer -> [Integer]
digitos x = [read [c] | c <- show x]

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

raizDigital2 :: Integer -> Integer
raizDigital2 n =
  head (dropWhile (>9) (iterate sumaDigitos n))

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

raizDigital3 :: Integer -> Integer
raizDigital3 n
  | m == 0    = 9
  | otherwise = m
  where m = n `mod` 9

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

raizDigital4 :: Integer -> Integer
raizDigital4 n = 1 + (n-1) `mod` 9

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

-- La propiedad es
prop_raizDigital_equiv :: Integer -> Property
prop_raizDigital_equiv n =
  n > 0 ==>
  all (== (raizDigital n))
      [raizDigital2 n,
       raizDigital3 n,
       raizDigital4 n]

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

-- Propiedades
-- ===========

-- Las propiedades son
prop_raizDigital :: Integer -> Integer -> Property
prop_raizDigital m n =
  m > 0 && n > 0 ==>
  d(m + n) == d(d(m) + d(n)) &&
  d(m*n) == d(d(m)*d(n)) &&
  d(m^n) == d(d(m)^n) &&
  d(d(n)) == d(n) &&
  d(n + 9) == d(n) &&
  d(9*n) == 9
  where d = raizDigital

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

import Test.QuickCheck (Property, (==>), quickCheck)

-- 1ª solución

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

raizDigital :: Integer -> Integer

raizDigital n

| n < 10 = n

| otherwise = raizDigital (sumaDigitos n)

-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,

-- sumaDigitos 2021 == 5

sumaDigitos :: Integer -> Integer

sumaDigitos = sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 2021 == [2,0,2,1]

digitos :: Integer -> [Integer]

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

-- 2ª solución

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

raizDigital2 :: Integer -> Integer

raizDigital2 n =

head (dropWhile (>9) (iterate sumaDigitos n))

-- 3ª solución

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

raizDigital3 :: Integer -> Integer

raizDigital3 n

| m == 0 = 9

| otherwise = m

where m = n `mod` 9

-- 4ª solución

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

raizDigital4 :: Integer -> Integer

raizDigital4 n = 1 + (n-1) `mod` 9

-- Comprobación de equivalencia

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

-- La propiedad es

prop_raizDigital_equiv :: Integer -> Property

prop_raizDigital_equiv n =

n > 0 ==>

all (== (raizDigital n))

[raizDigital2 n,

raizDigital3 n,

raizDigital4 n]

-- La comprobación es

-- λ> quickCheck prop_raizDigital_equiv

-- +++ OK, passed 100 tests.

-- Propiedades

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

-- Las propiedades son

prop_raizDigital :: Integer -> Integer -> Property

prop_raizDigital m n =

m > 0 && n > 0 ==>

d(m + n) == d(d(m) + d(n)) &&

d(m*n) == d(d(m)*d(n)) &&

d(m^n) == d(d(m)^n) &&

d(d(n)) == d(n) &&

d(n + 9) == d(n) &&

d(9*n) == 9

where d = raizDigital

-- La comprobación es

-- λ> quickCheck prop_raizDigital

-- +++ OK, passed 100 tests.

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>

Antiimágenes de funciones crecientes bidimensionales

PorJosé A. Alonso 5-abril-202129-marzo-2021

Una función f de pares de números naturales en números naturales es estrictamente creciente en ambos argumentos si

para x1 < x2, se tiene f(x1,y) < f(x1,y), para todo y y
para y1 < y2, se tiene f(x,y1) < f(x,y2), para todo x.

Por ejemplo, la función f definida por f(x,y) = x^2+3^y es creciente en ambos argumentos.

Las antiimágenes por f de t son los pares (x,y) tales que f(x,y) = t. Por ejemplo, las antimágenes por f(x,y) = x^2+3^y de 82 son los pares (1,4) y (9,0).

Definir la función

   antiimagenes :: Integral a => ((a,a) -> a) -> a -> [(a,a)]

1	antiimagenes :: Integral a => ((a,a) -> a) -> a -> [(a,a)]

tal que (antiimagenes f t) es la lista de las antiimágenes por f de t, donde se supone que f es una función de pares de números naturales en números naturales que es estrictamente creciente en ambos argumentos. Por ejemplo,

   antiimagenes (\(x,y) -> x^2+3^y) 82        ==  [(1,4),(9,0)]
   antiimagenes (\(x,y) -> x^2+3^y) 387421785 ==  [(36,18)]

1 2	antiimagenes (\(x,y) -> x^2+3^y) 82 == [(1,4),(9,0)] antiimagenes (\(x,y) -> x^2+3^y) 387421785 == [(36,18)]

Soluciones

[schedule expon=’2021-04-12′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 12 de abril.
El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

[/schedule]

[schedule on=’2021-04-12′ at=»06:00″]

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

antiimagenes :: Integral a => ((a,a) -> a) -> a -> [(a,a)]
antiimagenes f t =
  [(x,y) | x <- [0..t], y <- [0..t ], f (x,y) == t]

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

antiimagenes2 :: Integral a => ((a,a) -> a) -> a -> [(a,a)]
antiimagenes2 f t = antiimagenesEn (0,t)
  where antiimagenesEn (a,b) = [(x,y) | x <- [a..t], y <- [b,b-1..0], f (x,y) == t]

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

antiimagenes3 :: Integral a => ((a,a) -> a) -> a -> [(a,a)]
antiimagenes3 f t = antiimagenesEn (0,t)
  where antiimagenesEn (a,b)
          | a > t || b < 0 = []
          | c < t          = antiimagenesEn (a+1,b)
          | c == t         = (a,b) : antiimagenesEn (a+1,b-1)
          | c > t          = antiimagenesEn (a,b-1)
          where c = f (a,b)

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

antiimagenes4 :: Integral a => ((a,a) -> a) -> a -> [(a,a)]
antiimagenes4 f t = desde (0,p) (q,0) where
  p = menor (-1,t) (\ y -> f (0,y)) t
  q = menor (-1,t) (\ x -> f (x,0)) t
  desde (x1,y1) (x2,y2)
    | x2 < x1 || y1 < y2 = []
    | y1 - y <= x2 - x1  = fila x
    | otherwise          = columna y
    where
      x = menor (x1-1,x2) (\ x -> f (x,r)) t
      y = menor (y2-1,y1) (\ y -> f (c,y)) t
      c = (x1 + x2) `div` 2
      r = (y1 + y2) `div` 2
      fila x
        | z < t  = desde (x1,y1) (x2,r+1)
        | z == t = (x,r) : desde (x1,y1) (x-1,r+1) ++ desde (x+1,r-1) (x2,y2)
        | z > t  = desde (x1,y1) (x-1,r+1) ++ desde (x,r-1) (x2,y2)
        where z = f (x,r)
      columna y
        | z < t  = desde (c+1,y1) (x2,y2)
        | z == t = (c,y) : desde (x1,y1) (c-1,y+1) ++ desde (c+1,y-1) (x2,y2)
        | z > t  = desde (x1,y1) (c-1,y) ++ desde (c+1,y-1) (x2,y2)
        where z = f (c, y)


-- (menor (a,b) f t), suponiendo que t <= f b, es el menor x enel
-- intervalo (a,b] tal que t <= f x.
menor :: Integral a => (a,a) -> (a -> a) -> a -> a
menor (a,b) f t
  | a + 1 == b = b
  | t <= f m   = menor (a, m) f t
  | otherwise  = menor (m, b) f t
  where m = (a + b) `div` 2

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

-- La comparación es
--    λ> antiimagenes (\(x,y) -> x^2+3^y) 2383
--    [(14,7)]
--    (15.63 secs, 26,904,500,208 bytes)
--    λ> antiimagenes2 (\(x,y) -> x^2+3^y) 2383
--    [(14,7)]
--    (16.37 secs, 26,950,312,440 bytes)
--    λ> antiimagenes3 (\(x,y) -> x^2+3^y) 2383
--    [(14,7)]
--    (0.03 secs, 11,892,160 bytes)
--    λ> antiimagenes4 (\(x,y) -> x^2+3^y) 2383
--    [(14,7)]
--    (0.01 secs, 277,696 bytes)
--
--    λ> antiimagenes3 (\(x,y) -> x^2+3^y) 59449
--    [(20,10)]
--    (3.77 secs, 1,329,803,208 bytes)
--    λ> antiimagenes4 (\(x,y) -> x^2+3^y) 59449
--    [(20,10)]
--    (0.03 secs, 400,400 bytes)

-- 1ª solución

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

antiimagenes :: Integral a => ((a,a) -> a) -> a -> [(a,a)]

antiimagenes f t =

[(x,y) | x <- [0..t], y <- [0..t ], f (x,y) == t]

-- 2ª solución

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

antiimagenes2 :: Integral a => ((a,a) -> a) -> a -> [(a,a)]

antiimagenes2 f t = antiimagenesEn (0,t)

where antiimagenesEn (a,b) = [(x,y) | x <- [a..t], y <- [b,b-1..0], f (x,y) == t]

-- 3ª solución

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

antiimagenes3 :: Integral a => ((a,a) -> a) -> a -> [(a,a)]

antiimagenes3 f t = antiimagenesEn (0,t)

where antiimagenesEn (a,b)

| a > t || b < 0 = []

| c < t = antiimagenesEn (a+1,b)

| c == t = (a,b) : antiimagenesEn (a+1,b-1)

| c > t = antiimagenesEn (a,b-1)

where c = f (a,b)

-- 3ª solución

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

antiimagenes4 :: Integral a => ((a,a) -> a) -> a -> [(a,a)]

antiimagenes4 f t = desde (0,p) (q,0) where

p = menor (-1,t) (\ y -> f (0,y)) t

q = menor (-1,t) (\ x -> f (x,0)) t

desde (x1,y1) (x2,y2)

| x2 < x1 || y1 < y2 = []

| y1 - y <= x2 - x1 = fila x

| otherwise = columna y

where

x = menor (x1-1,x2) (\ x -> f (x,r)) t

y = menor (y2-1,y1) (\ y -> f (c,y)) t

c = (x1 + x2) `div` 2

r = (y1 + y2) `div` 2

fila x

| z < t = desde (x1,y1) (x2,r+1)

| z == t = (x,r) : desde (x1,y1) (x-1,r+1) ++ desde (x+1,r-1) (x2,y2)

| z > t = desde (x1,y1) (x-1,r+1) ++ desde (x,r-1) (x2,y2)

where z = f (x,r)

columna y

| z < t = desde (c+1,y1) (x2,y2)

| z == t = (c,y) : desde (x1,y1) (c-1,y+1) ++ desde (c+1,y-1) (x2,y2)

| z > t = desde (x1,y1) (c-1,y) ++ desde (c+1,y-1) (x2,y2)

where z = f (c, y)

-- (menor (a,b) f t), suponiendo que t <= f b, es el menor x enel

-- intervalo (a,b] tal que t <= f x.

menor :: Integral a => (a,a) -> (a -> a) -> a -> a

menor (a,b) f t

| a + 1 == b = b

| t <= f m = menor (a, m) f t

| otherwise = menor (m, b) f t

where m = (a + b) `div` 2

-- Comparación de eficiencia

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

-- La comparación es

-- λ> antiimagenes (\(x,y) -> x^2+3^y) 2383

-- [(14,7)]

-- (15.63 secs, 26,904,500,208 bytes)

-- λ> antiimagenes2 (\(x,y) -> x^2+3^y) 2383

-- [(14,7)]

-- (16.37 secs, 26,950,312,440 bytes)

-- λ> antiimagenes3 (\(x,y) -> x^2+3^y) 2383

-- [(14,7)]

-- (0.03 secs, 11,892,160 bytes)

-- λ> antiimagenes4 (\(x,y) -> x^2+3^y) 2383

-- [(14,7)]

-- (0.01 secs, 277,696 bytes)

-- λ> antiimagenes3 (\(x,y) -> x^2+3^y) 59449

-- [(20,10)]

-- (3.77 secs, 1,329,803,208 bytes)

-- λ> antiimagenes4 (\(x,y) -> x^2+3^y) 59449

-- [(20,10)]

-- (0.03 secs, 400,400 bytes)

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>

[/schedule]

Antiimagen de función creciente

PorJosé A. Alonso 2-abril-20219-abril-2021

Una función f de los números naturales en los números naturales es estrictamente creciente si para cualquier par de números x, y tales que x < y se verifica que f(x) < f(y). La antiimagen por f de un número natural t es el número natural x tal que f(x) = t. No todos los números tienen antiimiagen por f, pero en caso de tenerla es única.

Definir la función

   antiimagen :: (Integer -> Integer) -> Integer -> Maybe Integer

1	antiimagen :: (Integer -> Integer) -> Integer -> Maybe Integer

tal que, suponiendo que f es una función creciente de los números naturales en los números naturales, (antiimagen f t) es justamente la antiimagen por f de t, si existe y es Nothing, en caso contrario. Por ejemplo,

   antiimagen (\x -> 2*x^2-3) 47  ==  Just 5
   antiimagen (\x -> 2*x^2-3) 48  ==  Nothing
   antiimagen (\x -> 2^x) 1024    ==  Just 10
   antiimagen (2^) 1024           ==  Just 10
   antiimagen (2^) (2^(10^7))     ==  Just 10000000
   antiimagen (2^) (1+2^(10^7))   ==  Nothing

antiimagen (\x -> 2*x^2-3) 47 == Just 5

antiimagen (\x -> 2*x^2-3) 48 == Nothing

antiimagen (\x -> 2^x) 1024 == Just 10

antiimagen (2^) 1024 == Just 10

antiimagen (2^) (2^(10^7)) == Just 10000000

antiimagen (2^) (1+2^(10^7)) == Nothing

Soluciones

import Data.Maybe (listToMaybe)

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

antiimagen :: (Integer -> Integer) -> Integer -> Maybe Integer
antiimagen f t =
  listToMaybe [x | x <- [0..t], f x == t]

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

antiimagen2 :: (Integer -> Integer) -> Integer -> Maybe Integer
antiimagen2 f t = busqueda (0,t)
  where busqueda (a,b) = listToMaybe [x | x <- [a..b], f x == t]

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

antiimagen3 :: (Integer -> Integer) -> Integer -> Maybe Integer
antiimagen3 f t = busqueda (0,t)
  where busqueda (a,b)
          | a > b     = Nothing
          | t < f m   = busqueda (a,m-1)
          | t == f m  = Just m
          | otherwise = busqueda (m+1,b)
          where m = (a+b) `div` 2

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

antiimagen4 :: (Integer -> Integer) -> Integer -> Maybe Integer
antiimagen4 f t | f x == t  = Just x
                | otherwise = Nothing
  where x = busqueda (cotas f t)
        busqueda (a,b) = head [x | x <- [a+1..b], t <= f x]

-- (cotas f t) es un par (a,b) de potencias consecutivas de 2 tal que la
-- antiimagen de t por f está en el intevalo [a+1,b]. Por ejemplo,
--    cotas (\x -> 2*x^2-3) 47  ==  (4,8)
--    cotas (\x -> 2^x) 1024    ==  (8,16)
cotas :: (Integer -> Integer) -> Integer -> (Integer, Integer)
cotas f t | t <= f 0  = (-1,0)
          | otherwise = (b `div` 2, b)
  where b = until done (*2) 1
        done b = t <= f b

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

antiimagen5 :: (Integer -> Integer) -> Integer -> Maybe Integer
antiimagen5 f t | f x == t  = Just x
                | otherwise = Nothing
  where x = busqueda (cotas f t)
        busqueda (a,b) | a+1 == b  = b
                       | t <= f m  = busqueda (a,m)
                       | otherwise = busqueda (m,b)
          where m = (a+b) `div`  2

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

-- La comparación es
--    λ> antiimagen (2^) (2^30)
--    Just 30
--    (0.01 secs, 142,728 bytes)
--    λ> antiimagen2 (2^) (2^30)
--    Just 30
--    (0.01 secs, 142,784 bytes)
--    λ> antiimagen3 (2^) (2^30)
--    Just 30
--    (8.05 secs, 335,820,048 bytes)
--    λ> antiimagen4 (2^) (2^30)
--    Just 30
--    (0.01 secs, 133,984 bytes)
--    λ> antiimagen5 (2^) (2^30)
--    Just 30
--    (0.02 secs, 121,816 bytes)
--
--    λ> antiimagen (2^) (2^50000)
--    Just 50000
--    (1.29 secs, 673,789,160 bytes)
--    λ> antiimagen2 (2^) (2^50000)
--    Just 50000
--    (1.28 secs, 673,791,368 bytes)
--    λ> antiimagen4 (2^) (2^50000)
--    Just 50000
--    (0.84 secs, 342,311,360 bytes)
--    λ> antiimagen5 (2^) (2^50000)
--    Just 50000
--    (0.01 secs, 549,688 bytes)
--
--    λ> antiimagen4 (2^) (2^100000)
--    Just 100000
--    (4.37 secs, 1,210,476,848 bytes)
--    λ> antiimagen5 (2^) (2^100000)
--    Just 100000
--    (0.01 secs, 918,096 bytes)

import Data.Maybe (listToMaybe)

-- 1ª solución

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

antiimagen :: (Integer -> Integer) -> Integer -> Maybe Integer

antiimagen f t =

listToMaybe [x | x <- [0..t], f x == t]

-- 2ª solución

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

antiimagen2 :: (Integer -> Integer) -> Integer -> Maybe Integer

antiimagen2 f t = busqueda (0,t)

where busqueda (a,b) = listToMaybe [x | x <- [a..b], f x == t]

-- 3ª solución

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

antiimagen3 :: (Integer -> Integer) -> Integer -> Maybe Integer

antiimagen3 f t = busqueda (0,t)

where busqueda (a,b)

| a > b = Nothing

| t < f m = busqueda (a,m-1)

| t == f m = Just m

| otherwise = busqueda (m+1,b)

where m = (a+b) `div` 2

-- 4ª solución

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

antiimagen4 :: (Integer -> Integer) -> Integer -> Maybe Integer

antiimagen4 f t | f x == t = Just x

| otherwise = Nothing

where x = busqueda (cotas f t)

busqueda (a,b) = head [x | x <- [a+1..b], t <= f x]

-- (cotas f t) es un par (a,b) de potencias consecutivas de 2 tal que la

-- antiimagen de t por f está en el intevalo [a+1,b]. Por ejemplo,

-- cotas (\x -> 2*x^2-3) 47 == (4,8)

-- cotas (\x -> 2^x) 1024 == (8,16)

cotas :: (Integer -> Integer) -> Integer -> (Integer, Integer)

cotas f t | t <= f 0 = (-1,0)

| otherwise = (b `div` 2, b)

where b = until done (*2) 1

done b = t <= f b

-- 5ª solución

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

antiimagen5 :: (Integer -> Integer) -> Integer -> Maybe Integer

antiimagen5 f t | f x == t = Just x

| otherwise = Nothing

where x = busqueda (cotas f t)

busqueda (a,b) | a+1 == b = b

| t <= f m = busqueda (a,m)

| otherwise = busqueda (m,b)

where m = (a+b) `div` 2

-- Comparación de eficiencia

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

-- La comparación es

-- λ> antiimagen (2^) (2^30)

-- Just 30

-- (0.01 secs, 142,728 bytes)

-- λ> antiimagen2 (2^) (2^30)

-- Just 30

-- (0.01 secs, 142,784 bytes)

-- λ> antiimagen3 (2^) (2^30)

-- Just 30

-- (8.05 secs, 335,820,048 bytes)

-- λ> antiimagen4 (2^) (2^30)

-- Just 30

-- (0.01 secs, 133,984 bytes)

-- λ> antiimagen5 (2^) (2^30)

-- Just 30

-- (0.02 secs, 121,816 bytes)

-- λ> antiimagen (2^) (2^50000)

-- Just 50000

-- (1.29 secs, 673,789,160 bytes)

-- λ> antiimagen2 (2^) (2^50000)

-- Just 50000

-- (1.28 secs, 673,791,368 bytes)

-- λ> antiimagen4 (2^) (2^50000)

-- Just 50000

-- (0.84 secs, 342,311,360 bytes)

-- λ> antiimagen5 (2^) (2^50000)

-- Just 50000

-- (0.01 secs, 549,688 bytes)

-- λ> antiimagen4 (2^) (2^100000)

-- Just 100000

-- (4.37 secs, 1,210,476,848 bytes)

-- λ> antiimagen5 (2^) (2^100000)

-- Just 100000

-- (0.01 secs, 918,096 bytes)

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>

Reducción de consecutivos relacionados

PorJosé A. Alonso 1-abril-20218-abril-2021

Definir la función

   reducida :: (a -> a -> Bool) -> [a] -> [a]

1	reducida :: (a -> a -> Bool) -> [a] -> [a]

tal que (reducida r xs) obtenida elimando en xs las repeticiones de elementos consecutivos queverifican la relación r. Por ejemplo,

   reducida (==) [4,4,2,1,1,1,2,5]  ==  [4,2,1,2,5]
   reducida (<)  [4,4,2,1,1,1,2,5]  ==  [4,4,2,1,1,1]
   reducida (>=) [4,4,2,1,1,1,2,5]  ==  [4,5]
   reducida (>)  [4,4,2,1,1,1,2,5]  ==  [4,4,5]
   reducida (/=) [4,4,2,1,1,1,2,5]  ==  [4,4]

reducida (==) [4,4,2,1,1,1,2,5] == [4,2,1,2,5]

reducida (<) [4,4,2,1,1,1,2,5] == [4,4,2,1,1,1]

reducida (>=) [4,4,2,1,1,1,2,5] == [4,5]

reducida (>) [4,4,2,1,1,1,2,5] == [4,4,5]

reducida (/=) [4,4,2,1,1,1,2,5] == [4,4]

Soluciones

import Data.List (groupBy)

-- 1ª solución
reducida :: (a -> a -> Bool) -> [a] -> [a]
reducida _ []     = []
reducida r (x:xs) = x : reducida r (dropWhile (r x) xs)

-- 2ª solución
reducida2 :: (a -> a -> Bool) -> [a] -> [a]
reducida2 r = foldr aux []
  where aux x xs = x : dropWhile (r x) xs

-- 3ª solución
reducida3 :: (a -> a -> Bool) -> [a] -> [a]
reducida3 r xs =
  map head (groupBy r xs)

import Data.List (groupBy)

-- 1ª solución

reducida :: (a -> a -> Bool) -> [a] -> [a]

reducida _ [] = []

reducida r (x:xs) = x : reducida r (dropWhile (r x) xs)

-- 2ª solución

reducida2 :: (a -> a -> Bool) -> [a] -> [a]

reducida2 r = foldr aux []

where aux x xs = x : dropWhile (r x) xs

-- 3ª solución

reducida3 :: (a -> a -> Bool) -> [a] -> [a]

reducida3 r xs =

map head (groupBy r xs)

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>

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico