Listas infinitas – Exercitium

Representación de Zeckendorf

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

Los primeros números de Fibonacci son

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

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

tales que los dos primeros son iguales a 1 y los siguientes se obtienen sumando los dos anteriores.

El teorema de Zeckendorf establece que todo entero positivo n se puede representar, de manera única, como la suma de números de Fibonacci no consecutivos decrecientes. Dicha suma se llama la representación de Zeckendorf de n. Por ejemplo, la representación de Zeckendorf de 100 es

   100 = 89 + 8 + 3

1	100 = 89 + 8 + 3

Hay otras formas de representar 100 como sumas de números de Fibonacci; por ejemplo,

   100 = 89 +  8 + 2 + 1
   100 = 55 + 34 + 8 + 3

1 2	100 = 89 + 8 + 2 + 1 100 = 55 + 34 + 8 + 3

pero no son representaciones de Zeckendorf porque 1 y 2 son números de Fibonacci consecutivos, al igual que 34 y 55.

Definir la función

   zeckendorf :: Integer -> [Integer]

1	zeckendorf :: Integer -> [Integer]

tal que (zeckendorf n) es la representación de Zeckendorf de n. Por ejemplo,

   zeckendorf 100 == [89,8,3]
   zeckendorf 200 == [144,55,1]
   zeckendorf 300 == [233,55,8,3,1]
   length (zeckendorf (10^50000)) == 66097

zeckendorf 100 == [89,8,3]

zeckendorf 200 == [144,55,1]

zeckendorf 300 == [233,55,8,3,1]

length (zeckendorf (10^50000)) == 66097

Soluciones

module Representacion_de_Zeckendorf where

import Data.List (subsequences)
import Test.QuickCheck

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

zeckendorf1 :: Integer -> [Integer]
zeckendorf1 = head . zeckendorf1Aux

zeckendorf1Aux :: Integer -> [[Integer]]
zeckendorf1Aux n =
  [xs | xs <- subsequences (reverse (takeWhile (<= n) (tail fibs))),
        sum xs == n,
        sinFibonacciConsecutivos xs]

-- 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
-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión
-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por
-- ejemplo, 

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión
-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por
-- ejemplo, 
--    sinFibonacciConsecutivos [89, 8, 3]      ==  True
--    sinFibonacciConsecutivos [55, 34, 8, 3]  ==  False
sinFibonacciConsecutivos :: [Integer] -> Bool
sinFibonacciConsecutivos xs =
  and [x /= siguienteFibonacci y | (x,y) <- zip xs (tail xs)]

-- (siguienteFibonacci n) es el menor número de Fibonacci mayor que
-- n. Por ejemplo, 
--    siguienteFibonacci 34  ==  55
siguienteFibonacci :: Integer -> Integer
siguienteFibonacci n =
  head (dropWhile (<= n) fibs)

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

zeckendorf2 :: Integer -> [Integer]
zeckendorf2 = head . zeckendorf2Aux

zeckendorf2Aux :: Integer -> [[Integer]]
zeckendorf2Aux n = map reverse (aux n (tail fibs))
  where aux 0 _ = [[]]
        aux m (x:y:zs)
            | x <= m     = [x:xs | xs <- aux (m-x) zs] ++ aux m (y:zs)
            | otherwise  = []

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

zeckendorf3 :: Integer -> [Integer]
zeckendorf3 0 = []
zeckendorf3 n = x : zeckendorf3 (n - x)
  where x = last (takeWhile (<= n) fibs)

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

zeckendorf4 :: Integer -> [Integer]
zeckendorf4 n = aux n (reverse (takeWhile (<= n) fibs))
  where aux 0 _      = []
        aux m (x:xs) = x : aux (m-x) (dropWhile (>m-x) xs)

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

-- La propiedad es
prop_zeckendorf :: Positive Integer -> Bool
prop_zeckendorf (Positive n) =
  all (== zeckendorf1 n)
      [zeckendorf2 n,
       zeckendorf3 n,
       zeckendorf4 n]

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

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

-- La comparación es
--    λ> zeckendorf1 (7*10^4)
--    [46368,17711,4181,1597,89,34,13,5,2]
--    (1.49 secs, 2,380,707,744 bytes)
--    λ> zeckendorf2 (7*10^4)
--    [46368,17711,4181,1597,89,34,13,5,2]
--    (0.07 secs, 21,532,008 bytes)
--
--    λ> zeckendorf2 (10^6)
--    [832040,121393,46368,144,55]
--    (1.40 secs, 762,413,432 bytes)
--    λ> zeckendorf3 (10^6)
--    [832040,121393,46368,144,55]
--    (0.01 secs, 542,488 bytes)
--    λ> zeckendorf4 (10^6)
--    [832040,121393,46368,144,55]
--    (0.01 secs, 536,424 bytes)
--
--    λ> length (zeckendorf3 (10^3000))
--    3947
--    (3.02 secs, 1,611,966,408 bytes)
--    λ> length (zeckendorf4 (10^2000))
--    2611
--    (0.02 secs, 10,434,336 bytes)
--
--    λ> length (zeckendorf4 (10^50000))
--    66097
--    (2.84 secs, 3,976,483,760 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

module Representacion_de_Zeckendorf where

import Data.List (subsequences)

import Test.QuickCheck

-- 1ª solución

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

zeckendorf1 :: Integer -> [Integer]

zeckendorf1 = head . zeckendorf1Aux

zeckendorf1Aux :: Integer -> [[Integer]]

zeckendorf1Aux n =

[xs | xs <- subsequences (reverse (takeWhile (<= n) (tail fibs))),

sum xs == n,

sinFibonacciConsecutivos xs]

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

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión

-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por

-- ejemplo,

-- (sinFibonacciConsecutivos xs) se verifica si en la sucesión

-- decreciente de número de Fibonacci xs no hay dos consecutivos. Por

-- ejemplo,

-- sinFibonacciConsecutivos [89, 8, 3] == True

-- sinFibonacciConsecutivos [55, 34, 8, 3] == False

sinFibonacciConsecutivos :: [Integer] -> Bool

sinFibonacciConsecutivos xs =

and [x /= siguienteFibonacci y | (x,y) <- zip xs (tail xs)]

-- (siguienteFibonacci n) es el menor número de Fibonacci mayor que

-- n. Por ejemplo,

-- siguienteFibonacci 34 == 55

siguienteFibonacci :: Integer -> Integer

siguienteFibonacci n =

head (dropWhile (<= n) fibs)

-- 2ª solución

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

zeckendorf2 :: Integer -> [Integer]

zeckendorf2 = head . zeckendorf2Aux

zeckendorf2Aux :: Integer -> [[Integer]]

zeckendorf2Aux n = map reverse (aux n (tail fibs))

where aux 0 _ = [[]]

aux m (x:y:zs)

| x <= m = [x:xs | xs <- aux (m-x) zs] ++ aux m (y:zs)

| otherwise = []

-- 3ª solución

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

zeckendorf3 :: Integer -> [Integer]

zeckendorf3 0 = []

zeckendorf3 n = x : zeckendorf3 (n - x)

where x = last (takeWhile (<= n) fibs)

-- 4ª solución

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

zeckendorf4 :: Integer -> [Integer]

zeckendorf4 n = aux n (reverse (takeWhile (<= n) fibs))

where aux 0 _ = []

aux m (x:xs) = x : aux (m-x) (dropWhile (>m-x) xs)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_zeckendorf :: Positive Integer -> Bool

prop_zeckendorf (Positive n) =

all (== zeckendorf1 n)

[zeckendorf2 n,

zeckendorf3 n,

zeckendorf4 n]

-- La comprobación es

-- λ> quickCheck prop_zeckendorf

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> zeckendorf1 (7*10^4)

-- [46368,17711,4181,1597,89,34,13,5,2]

-- (1.49 secs, 2,380,707,744 bytes)

-- λ> zeckendorf2 (7*10^4)

-- [46368,17711,4181,1597,89,34,13,5,2]

-- (0.07 secs, 21,532,008 bytes)

-- λ> zeckendorf2 (10^6)

-- [832040,121393,46368,144,55]

-- (1.40 secs, 762,413,432 bytes)

-- λ> zeckendorf3 (10^6)

-- [832040,121393,46368,144,55]

-- (0.01 secs, 542,488 bytes)

-- λ> zeckendorf4 (10^6)

-- [832040,121393,46368,144,55]

-- (0.01 secs, 536,424 bytes)

-- λ> length (zeckendorf3 (10^3000))

-- 3947

-- (3.02 secs, 1,611,966,408 bytes)

-- λ> length (zeckendorf4 (10^2000))

-- 2611

-- (0.02 secs, 10,434,336 bytes)

-- λ> length (zeckendorf4 (10^50000))

-- 66097

-- (2.84 secs, 3,976,483,760 bytes)

El código se encuentra en GitHub.

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

Descomposiciones triangulares

PorJosé A. Alonso 13-abril-202215-abril-2022

Los números triangulares se forman como sigue

   *     *      *
        * *    * *
              * * *
   1     3      6

* * *

* * * *

* * *

1 3 6

La sucesión de los números triangulares se obtiene sumando los números naturales. Así, los 5 primeros números triangulares son

    1 = 1
    3 = 1 + 2
    6 = 1 + 2 + 3
   10 = 1 + 2 + 3 + 4
   15 = 1 + 2 + 3 + 4 + 5

1 = 1

3 = 1 + 2

6 = 1 + 2 + 3

10 = 1 + 2 + 3 + 4

15 = 1 + 2 + 3 + 4 + 5

Definir la función

   descomposicionesTriangulares :: Int -> [(Int, Int, Int)]

1	descomposicionesTriangulares :: Int -> [(Int, Int, Int)]

tal que (descomposicionesTriangulares n) es la lista de las ternas correspondientes a las descomposiciones de n en tres sumandos formados por números triangulares. Por ejemplo,

   descomposicionesTriangulares  4 == []
   descomposicionesTriangulares  5 == [(1,1,3)]
   descomposicionesTriangulares 12 == [(1,1,10),(3,3,6)]
   descomposicionesTriangulares 30 == [(1,1,28),(3,6,21),(10,10,10)]
   descomposicionesTriangulares 61 == [(1,15,45),(3,3,55),(6,10,45),(10,15,36)]
   descomposicionesTriangulares 52 == [(1,6,45),(1,15,36),(3,21,28),(6,10,36),(10,21,21)]
   descomposicionesTriangulares 82 == [(1,3,78),(1,15,66),(1,36,45),(6,10,66),(6,21,55),(10,36,36)]
   length (descomposicionesTriangulares (5*10^5)) == 124

descomposicionesTriangulares 4 == []

descomposicionesTriangulares 5 == [(1,1,3)]

descomposicionesTriangulares 12 == [(1,1,10),(3,3,6)]

descomposicionesTriangulares 30 == [(1,1,28),(3,6,21),(10,10,10)]

descomposicionesTriangulares 61 == [(1,15,45),(3,3,55),(6,10,45),(10,15,36)]

descomposicionesTriangulares 52 == [(1,6,45),(1,15,36),(3,21,28),(6,10,36),(10,21,21)]

descomposicionesTriangulares 82 == [(1,3,78),(1,15,66),(1,36,45),(6,10,66),(6,21,55),(10,36,36)]

length (descomposicionesTriangulares (5*10^5)) == 124

Soluciones

[schedule expon=’2022-04-20′ expat=»06:00″]

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

[/schedule]

[schedule on=’2022-04-20′ at=»06:00″]

import Test.QuickCheck

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

descomposicionesTriangulares1 :: Int -> [(Int, Int, Int)]
descomposicionesTriangulares1 n =
  [(x,y,z) | x <- xs,
             y <- xs,
             z <- xs,
             x <= y && y <= z,
             x + y + z == n]
  where xs = takeWhile (<=n) triangulares

-- triangulares es la lista de los números triangulares. Por ejemplo,
--    take 9 triangulares  ==  [1,3,6,10,15,21,28,36,45]
triangulares :: [Int]
triangulares = scanl (+) 1 [2..]

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

descomposicionesTriangulares2 :: Int -> [(Int, Int, Int)]
descomposicionesTriangulares2 n =
  [(x,y,z) | x <- xs,
             y <- xs,
             x <= y,
             z <- xs,
             y <= z,
             x + y + z == n]
  where xs = takeWhile (<=n) triangulares

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

descomposicionesTriangulares3 :: Int -> [(Int, Int, Int)]
descomposicionesTriangulares3 n =
  [(x,y,z) | x <- xs,
             y <- xs,
             x <= y,
             let z = n - x - y,
             y <= z,
             z `elem` xs]
  where xs = takeWhile (<=n) triangulares

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

descomposicionesTriangulares4 :: Int -> [(Int, Int, Int)]
descomposicionesTriangulares4 n =
  [(x,y,n-x-y) | x <- xs,
                 y <- dropWhile (<x) xs,
                 let z = n - x - y,
                 y <= z,
                 z `elem` xs]
  where xs = takeWhile (<=n) triangulares

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

-- La propiedad es
prop_descomposicionesTriangulares ::  Positive Int -> Bool
prop_descomposicionesTriangulares (Positive n) =
  all (== descomposicionesTriangulares1 n)
      [descomposicionesTriangulares2 n,
       descomposicionesTriangulares3 n,
       descomposicionesTriangulares4 n]

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

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

-- La comparación es
--   λ> last (descomposicionesTriangulares1 (2*10^4))
--   (5671,6328,8001)
--   (3.34 secs, 1,469,517,168 bytes)
--   λ> last (descomposicionesTriangulares2 (2*10^4))
--   (5671,6328,8001)
--   (1.29 secs, 461,433,928 bytes)
--   λ> last (descomposicionesTriangulares3 (2*10^4))
--   (5671,6328,8001)
--   (0.08 secs, 6,574,056 bytes)
--
--   λ> last (descomposicionesTriangulares3 (5*10^5))
--   (140185,148240,211575)
--   (2.12 secs, 151,137,280 bytes)
--   λ> last (descomposicionesTriangulares4 (5*10^5))
--   (140185,148240,211575)
--   (2.30 secs, 103,280,216 bytes)

import Test.QuickCheck

-- 1ª solución

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

descomposicionesTriangulares1 :: Int -> [(Int, Int, Int)]

descomposicionesTriangulares1 n =

[(x,y,z) | x <- xs,

y <- xs,

z <- xs,

x <= y && y <= z,

x + y + z == n]

where xs = takeWhile (<=n) triangulares

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

-- take 9 triangulares == [1,3,6,10,15,21,28,36,45]

triangulares :: [Int]

triangulares = scanl (+) 1 [2..]

-- 2ª solución

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

descomposicionesTriangulares2 :: Int -> [(Int, Int, Int)]

descomposicionesTriangulares2 n =

[(x,y,z) | x <- xs,

y <- xs,

x <= y,

z <- xs,

y <= z,

x + y + z == n]

where xs = takeWhile (<=n) triangulares

-- 3ª solución

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

descomposicionesTriangulares3 :: Int -> [(Int, Int, Int)]

descomposicionesTriangulares3 n =

[(x,y,z) | x <- xs,

y <- xs,

x <= y,

let z = n - x - y,

y <= z,

z `elem` xs]

where xs = takeWhile (<=n) triangulares

-- 4ª solución

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

descomposicionesTriangulares4 :: Int -> [(Int, Int, Int)]

descomposicionesTriangulares4 n =

[(x,y,n-x-y) | x <- xs,

y <- dropWhile (<x) xs,

let z = n - x - y,

y <= z,

z `elem` xs]

where xs = takeWhile (<=n) triangulares

-- Comprobación de equivalencia

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

-- La propiedad es

prop_descomposicionesTriangulares :: Positive Int -> Bool

prop_descomposicionesTriangulares (Positive n) =

all (== descomposicionesTriangulares1 n)

[descomposicionesTriangulares2 n,

descomposicionesTriangulares3 n,

descomposicionesTriangulares4 n]

-- La comprobación es

-- λ> quickCheck prop_descomposicionesTriangulares

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (descomposicionesTriangulares1 (2*10^4))

-- (5671,6328,8001)

-- (3.34 secs, 1,469,517,168 bytes)

-- λ> last (descomposicionesTriangulares2 (2*10^4))

-- (5671,6328,8001)

-- (1.29 secs, 461,433,928 bytes)

-- λ> last (descomposicionesTriangulares3 (2*10^4))

-- (5671,6328,8001)

-- (0.08 secs, 6,574,056 bytes)

-- λ> last (descomposicionesTriangulares3 (5*10^5))

-- (140185,148240,211575)

-- (2.12 secs, 151,137,280 bytes)

-- λ> last (descomposicionesTriangulares4 (5*10^5))

-- (140185,148240,211575)

-- (2.30 secs, 103,280,216 bytes)

El código se encuentra en [GitHub](https://github.com/jaalonso/Exercitium/blob/main/src/Descomposiciones_triangulares.hs).

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

Nuevas soluciones

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

[/schedule]

Índices de valores verdaderos

PorJosé A. Alonso 12-abril-202211-abril-2022

Definir la función

   indicesVerdaderos :: [Int] -> [Bool]

1	indicesVerdaderos :: [Int] -> [Bool]

tal que (indicesVerdaderos xs) es la lista infinita de booleanos tal que sólo son verdaderos los elementos cuyos índices pertenecen a la lista estrictamente creciente xs. Por ejemplo,

   λ> take 6 (indicesVerdaderos [1,4])
   [False,True,False,False,True,False]
   λ> take 6 (indicesVerdaderos [0,2..])
   [True,False,True,False,True,False]
   λ> take 3 (indicesVerdaderos [])
   [False,False,False]
   λ> take 6 (indicesVerdaderos [1..])
   [False,True,True,True,True,True]
   λ> last (take (8*10^7) (indicesVerdaderos [0,5..]))
   False

λ> take 6 (indicesVerdaderos [1,4])

[False,True,False,False,True,False]

λ> take 6 (indicesVerdaderos [0,2..])

[True,False,True,False,True,False]

λ> take 3 (indicesVerdaderos [])

[False,False,False]

λ> take 6 (indicesVerdaderos [1..])

[False,True,True,True,True,True]

λ> last (take (8*10^7) (indicesVerdaderos [0,5..]))

False

Soluciones

[schedule expon=’2022-04-19′ expat=»06:00″]

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

[/schedule]

[schedule on=’2022-04-19′ at=»06:00″]

import Data.List.Ordered (member)
import Test.QuickCheck

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

indicesVerdaderos1 :: [Int] -> [Bool]
indicesVerdaderos1 []     = repeat False
indicesVerdaderos1 (x:ys) =
  replicate x False ++ [True] ++ indicesVerdaderos1 [y-x-1 | y <- ys]

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

indicesVerdaderos2 :: [Int] -> [Bool]
indicesVerdaderos2 = aux 0
  where aux _ []     = repeat False
        aux n (x:xs) | x == n    = True  : aux (n+1) xs
                     | otherwise = False : aux (n+1) (x:xs)

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

indicesVerdaderos3 :: [Int] -> [Bool]
indicesVerdaderos3 = aux [0..]
  where aux _      []                 = repeat False
        aux (i:is) (x:xs) | i == x    = True  : aux is xs
                          | otherwise = False : aux is (x:xs)

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

indicesVerdaderos4 :: [Int] -> [Bool]
indicesVerdaderos4 xs = [pertenece x xs | x <- [0..]]

-- (pertenece x ys) se verifica si x pertenece a la lista estrictamente
-- creciente (posiblemente infinita) ys. Por ejemplo,
--    pertenece 9 [1,3..]  ==  True
--    pertenece 6 [1,3..]  ==  False
pertenece :: Int -> [Int] -> Bool
pertenece x ys = x `elem` takeWhile (<=x) ys

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

indicesVerdaderos5 :: [Int] -> [Bool]
indicesVerdaderos5 xs = map (`pertenece2` xs) [0..]

pertenece2 :: Int -> [Int] -> Bool
pertenece2 x = aux
  where aux [] = False
        aux (y:ys) = case compare x y of
                       LT -> False
                       EQ -> True
                       GT -> aux ys

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

indicesVerdaderos6 :: [Int] -> [Bool]
indicesVerdaderos6 xs = map (`member` xs) [0..]

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

-- ListaCreciente es un tipo de dato para generar lista de enteros
-- crecientes arbitrarias.
newtype ListaCreciente = LC [Int]
  deriving Show

-- listaCrecienteArbitraria es un generador de lista de enteros
-- crecientes arbitrarias. Por ejemplo,
--    λ> sample listaCrecienteArbitraria
--    LC []
--    LC [2,5]
--    LC [4,8]
--    LC [6,13]
--    LC [7,15,20,28,33]
--    LC [11,15,20,29,35,40]
--    LC [5,17,25,36,42,50,52,64]
--    LC [9,16,31,33,46,59,74,83,85,89,104,113,118]
--    LC [9,22,29,35,37,49,53,62,68,77,83,100]
--    LC []
--    LC [3,22,25,34,36,51,72,75,89]
listaCrecienteArbitraria :: Gen ListaCreciente
listaCrecienteArbitraria = do
  xs <- arbitrary
  return (LC (listaCreciente xs))

-- (listaCreciente xs) es la lista creciente correspondiente a xs. Por ejemplo,
--    listaCreciente [-1,3,-4,3,0]   ==  [2,6,11,15,16]
listaCreciente :: [Int] -> [Int]
listaCreciente xs =
  scanl1 (+) (map (succ . abs) xs)

-- ListaCreciente está contenida en Arbitrary
instance Arbitrary ListaCreciente where
  arbitrary = listaCrecienteArbitraria

-- La propiedad es
prop_indicesVerdaderos :: ListaCreciente -> Bool
prop_indicesVerdaderos (LC xs) =
  all (== take n (indicesVerdaderos1 xs))
      [take n (f xs) | f <-[indicesVerdaderos2,
                            indicesVerdaderos3,
                            indicesVerdaderos4,
                            indicesVerdaderos5,
                            indicesVerdaderos6]]
  where n = length xs

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

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

-- La comparación es
--    λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))
--    False
--    (2.69 secs, 2,611,031,544 bytes)
--    λ> last (take (2*10^4) (indicesVerdaderos2 [0,5..]))
--    False
--    (0.03 secs, 10,228,880 bytes)
--
--    λ> last (take (4*10^6) (indicesVerdaderos2 [0,5..]))
--    False
--    (2.37 secs, 1,946,100,856 bytes)
--    λ> last (take (4*10^6) (indicesVerdaderos3 [0,5..]))
--    False
--    (1.54 secs, 1,434,100,984 bytes)
--
--    λ> last (take (6*10^6) (indicesVerdaderos3 [0,5..]))
--    False
--    (2.30 secs, 2,150,900,984 bytes)
--    λ> last (take (6*10^6) (indicesVerdaderos4 [0,5..]))
--    False
--    (1.55 secs, 1,651,701,184 bytes)
--    λ> last (take (6*10^6) (indicesVerdaderos5 [0,5..]))
--    False
--    (0.58 secs, 1,584,514,304 bytes)
--
--    λ> last (take (3*10^7) (indicesVerdaderos5 [0,5..]))
--    False
--    (2.74 secs, 7,920,514,360 bytes)
--    λ> last (take (3*10^7) (indicesVerdaderos6 [0,5..]))
--    False
--    (0.82 secs, 6,960,514,136 bytes)

--    λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))
--    False
--    (2.69 secs, 2,611,031,544 bytes)
--    λ> last (take (2*10^4) (indicesVerdaderos6 [0,5..]))
--    False
--    (0.01 secs, 5,154,040 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

import Data.List.Ordered (member)

import Test.QuickCheck

-- 1ª solución

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

indicesVerdaderos1 :: [Int] -> [Bool]

indicesVerdaderos1 [] = repeat False

indicesVerdaderos1 (x:ys) =

replicate x False ++ [True] ++ indicesVerdaderos1 [y-x-1 | y <- ys]

-- 2ª solución

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

indicesVerdaderos2 :: [Int] -> [Bool]

indicesVerdaderos2 = aux 0

where aux _ [] = repeat False

aux n (x:xs) | x == n = True : aux (n+1) xs

| otherwise = False : aux (n+1) (x:xs)

-- 3ª solución

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

indicesVerdaderos3 :: [Int] -> [Bool]

indicesVerdaderos3 = aux [0..]

where aux _ [] = repeat False

aux (i:is) (x:xs) | i == x = True : aux is xs

| otherwise = False : aux is (x:xs)

-- 4ª solución

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

indicesVerdaderos4 :: [Int] -> [Bool]

indicesVerdaderos4 xs = [pertenece x xs | x <- [0..]]

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

-- creciente (posiblemente infinita) ys. Por ejemplo,

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

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

pertenece :: Int -> [Int] -> Bool

pertenece x ys = x `elem` takeWhile (<=x) ys

-- 5ª solución

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

indicesVerdaderos5 :: [Int] -> [Bool]

indicesVerdaderos5 xs = map (`pertenece2` xs) [0..]

pertenece2 :: Int -> [Int] -> Bool

pertenece2 x = aux

where aux [] = False

aux (y:ys) = case compare x y of

LT -> False

EQ -> True

GT -> aux ys

-- 6ª solución

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

indicesVerdaderos6 :: [Int] -> [Bool]

indicesVerdaderos6 xs = map (`member` xs) [0..]

-- Comprobación de equivalencia

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

-- ListaCreciente es un tipo de dato para generar lista de enteros

-- crecientes arbitrarias.

newtype ListaCreciente = LC [Int]

deriving Show

-- listaCrecienteArbitraria es un generador de lista de enteros

-- crecientes arbitrarias. Por ejemplo,

-- λ> sample listaCrecienteArbitraria

-- LC []

-- LC [2,5]

-- LC [4,8]

-- LC [6,13]

-- LC [7,15,20,28,33]

-- LC [11,15,20,29,35,40]

-- LC [5,17,25,36,42,50,52,64]

-- LC [9,16,31,33,46,59,74,83,85,89,104,113,118]

-- LC [9,22,29,35,37,49,53,62,68,77,83,100]

-- LC []

-- LC [3,22,25,34,36,51,72,75,89]

listaCrecienteArbitraria :: Gen ListaCreciente

listaCrecienteArbitraria = do

xs <- arbitrary

return (LC (listaCreciente xs))

-- (listaCreciente xs) es la lista creciente correspondiente a xs. Por ejemplo,

-- listaCreciente [-1,3,-4,3,0] == [2,6,11,15,16]

listaCreciente :: [Int] -> [Int]

listaCreciente xs =

scanl1 (+) (map (succ . abs) xs)

-- ListaCreciente está contenida en Arbitrary

instance Arbitrary ListaCreciente where

arbitrary = listaCrecienteArbitraria

-- La propiedad es

prop_indicesVerdaderos :: ListaCreciente -> Bool

prop_indicesVerdaderos (LC xs) =

all (== take n (indicesVerdaderos1 xs))

[take n (f xs) | f <-[indicesVerdaderos2,

indicesVerdaderos3,

indicesVerdaderos4,

indicesVerdaderos5,

indicesVerdaderos6]]

where n = length xs

-- La comprobación es

-- λ> quickCheck prop_indicesVerdaderos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))

-- False

-- (2.69 secs, 2,611,031,544 bytes)

-- λ> last (take (2*10^4) (indicesVerdaderos2 [0,5..]))

-- False

-- (0.03 secs, 10,228,880 bytes)

-- λ> last (take (4*10^6) (indicesVerdaderos2 [0,5..]))

-- False

-- (2.37 secs, 1,946,100,856 bytes)

-- λ> last (take (4*10^6) (indicesVerdaderos3 [0,5..]))

-- False

-- (1.54 secs, 1,434,100,984 bytes)

-- λ> last (take (6*10^6) (indicesVerdaderos3 [0,5..]))

-- False

-- (2.30 secs, 2,150,900,984 bytes)

-- λ> last (take (6*10^6) (indicesVerdaderos4 [0,5..]))

-- False

-- (1.55 secs, 1,651,701,184 bytes)

-- λ> last (take (6*10^6) (indicesVerdaderos5 [0,5..]))

-- False

-- (0.58 secs, 1,584,514,304 bytes)

-- λ> last (take (3*10^7) (indicesVerdaderos5 [0,5..]))

-- False

-- (2.74 secs, 7,920,514,360 bytes)

-- λ> last (take (3*10^7) (indicesVerdaderos6 [0,5..]))

-- False

-- (0.82 secs, 6,960,514,136 bytes)

-- λ> last (take (2*10^4) (indicesVerdaderos1 [0,5..]))

-- False

-- (2.69 secs, 2,611,031,544 bytes)

-- λ> last (take (2*10^4) (indicesVerdaderos6 [0,5..]))

-- False

-- (0.01 secs, 5,154,040 bytes)

El código se encuentra en [GitHub](https://github.com/jaalonso/Exercitium/blob/main/src/Indices_verdaderos.hs).

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

Nuevas soluciones

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

[/schedule]

Números triangulares con n cifras distintas

PorJosé A. Alonso 5-abril-202212-abril-2022

Los números triangulares se forman como sigue

   *     *      *
        * *    * *
              * * *
   1     3      6

* * *

* * * *

* * *

1 3 6

La sucesión de los números triangulares se obtiene sumando los números naturales. Así, los 5 primeros números triangulares son

    1 = 1
    3 = 1 + 2
    6 = 1 + 2 + 3
   10 = 1 + 2 + 3 + 4
   15 = 1 + 2 + 3 + 4 + 5

1 = 1

3 = 1 + 2

6 = 1 + 2 + 3

10 = 1 + 2 + 3 + 4

15 = 1 + 2 + 3 + 4 + 5

Definir la función

   triangularesConCifras :: Int -> [Integer]

1	triangularesConCifras :: Int -> [Integer]

tal que (triangulares n) es la lista de los números triangulares con n cifras distintas. Por ejemplo,

   take 6 (triangularesConCifras 1)   ==  [1,3,6,55,66,666]
   take 6 (triangularesConCifras 2)   ==  [10,15,21,28,36,45]
   take 6 (triangularesConCifras 3)   ==  [105,120,136,153,190,210]
   take 5 (triangularesConCifras 4)   ==  [1035,1275,1326,1378,1485]
   take 2 (triangularesConCifras 10)  ==  [1062489753,1239845706]

take 6 (triangularesConCifras 1) == [1,3,6,55,66,666]

take 6 (triangularesConCifras 2) == [10,15,21,28,36,45]

take 6 (triangularesConCifras 3) == [105,120,136,153,190,210]

take 5 (triangularesConCifras 4) == [1035,1275,1326,1378,1485]

take 2 (triangularesConCifras 10) == [1062489753,1239845706]

Soluciones

import Data.List (nub)
import Test.QuickCheck

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

triangularesConCifras1 :: Int -> [Integer]
triangularesConCifras1 n =
  [x | x <- triangulares1,
       nCifras x == n]

-- triangulares1 es la lista de los números triangulares. Por ejemplo,
--    take 10 triangulares1 == [1,3,6,10,15,21,28,36,45,55]
triangulares1 :: [Integer]
triangulares1 = map triangular [1..]

triangular :: Integer -> Integer
triangular 1 = 1
triangular n = triangular (n-1) + n

-- (nCifras x) es el número de cifras distintas del número x. Por
-- ejemplo,
--    nCifras 325275  ==  4
nCifras :: Integer -> Int
nCifras = length . nub . show

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

triangularesConCifras2 :: Int -> [Integer]
triangularesConCifras2 n =
  [x | x <- triangulares2,
       nCifras x == n]

triangulares2 :: [Integer]
triangulares2 = [(n*(n+1)) `div` 2 | n <- [1..]]

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

triangularesConCifras3 :: Int -> [Integer]
triangularesConCifras3 n =
  [x | x <- triangulares3,
       nCifras x == n]

triangulares3 :: [Integer]
triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares3]

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

triangularesConCifras4 :: Int -> [Integer]
triangularesConCifras4 n =
  [x | x <- triangulares4,
       nCifras x == n]

triangulares4 :: [Integer]
triangulares4 = 1 : zipWith (+) [2..] triangulares4

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

triangularesConCifras5 :: Int -> [Integer]
triangularesConCifras5 n =
  [x | x <- triangulares5,
       nCifras x == n]

triangulares5 :: [Integer]
triangulares5 = scanl (+) 1 [2..]

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

-- La 1ª propiedad es
prop_triangularesConCifras1 :: Bool
prop_triangularesConCifras1 =
  [take 2 (triangularesConCifras1 n) | n <- [1..7]] ==
  [take 2 (triangularesConCifras2 n) | n <- [1..7]]

-- La comprobación es
--    λ> prop_triangularesConCifras1
--    True

-- La 2ª propiedad es
prop_triangularesConCifras2 :: Int -> Bool
prop_triangularesConCifras2 n =
  all (== take 5 (triangularesConCifras2 n'))
      [take 5 (triangularesConCifras3 n'),
       take 5 (triangularesConCifras4 n'),
       take 5 (triangularesConCifras5 n')]
  where n' = 1 + n `mod` 9

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

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

-- La comparación es
--    λ> (triangularesConCifras1 3) !! 220
--    5456556
--    (2.48 secs, 1,228,690,120 bytes)
--    λ> (triangularesConCifras2 3) !! 220
--    5456556
--    (0.01 secs, 4,667,288 bytes)
--
--    λ> (triangularesConCifras2 3) !! 600
--    500010500055
--    (1.76 secs, 1,659,299,872 bytes)
--    λ> (triangularesConCifras3 3) !! 600
--    500010500055
--    (1.67 secs, 1,603,298,648 bytes)
--    λ> (triangularesConCifras4 3) !! 600
--    500010500055
--    (1.20 secs, 1,507,298,248 bytes)
--    λ> (triangularesConCifras5 3) !! 600
--    500010500055
--    (1.15 secs, 1,507,298,256 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

import Data.List (nub)

import Test.QuickCheck

-- 1ª solución

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

triangularesConCifras1 :: Int -> [Integer]

triangularesConCifras1 n =

[x | x <- triangulares1,

nCifras x == n]

-- triangulares1 es la lista de los números triangulares. Por ejemplo,

-- take 10 triangulares1 == [1,3,6,10,15,21,28,36,45,55]

triangulares1 :: [Integer]

triangulares1 = map triangular [1..]

triangular :: Integer -> Integer

triangular 1 = 1

triangular n = triangular (n-1) + n

-- (nCifras x) es el número de cifras distintas del número x. Por

-- ejemplo,

-- nCifras 325275 == 4

nCifras :: Integer -> Int

nCifras = length . nub . show

-- 2ª solución

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

triangularesConCifras2 :: Int -> [Integer]

triangularesConCifras2 n =

[x | x <- triangulares2,

nCifras x == n]

triangulares2 :: [Integer]

triangulares2 = [(n*(n+1)) `div` 2 | n <- [1..]]

-- 3ª solución

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

triangularesConCifras3 :: Int -> [Integer]

triangularesConCifras3 n =

[x | x <- triangulares3,

nCifras x == n]

triangulares3 :: [Integer]

triangulares3 = 1 : [x+y | (x,y) <- zip [2..] triangulares3]

-- 4ª solución

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

triangularesConCifras4 :: Int -> [Integer]

triangularesConCifras4 n =

[x | x <- triangulares4,

nCifras x == n]

triangulares4 :: [Integer]

triangulares4 = 1 : zipWith (+) [2..] triangulares4

-- 5ª solución

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

triangularesConCifras5 :: Int -> [Integer]

triangularesConCifras5 n =

[x | x <- triangulares5,

nCifras x == n]

triangulares5 :: [Integer]

triangulares5 = scanl (+) 1 [2..]

-- Comprobación de equivalencia

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

-- La 1ª propiedad es

prop_triangularesConCifras1 :: Bool

prop_triangularesConCifras1 =

[take 2 (triangularesConCifras1 n) | n <- [1..7]] ==

[take 2 (triangularesConCifras2 n) | n <- [1..7]]

-- La comprobación es

-- λ> prop_triangularesConCifras1

-- True

-- La 2ª propiedad es

prop_triangularesConCifras2 :: Int -> Bool

prop_triangularesConCifras2 n =

all (== take 5 (triangularesConCifras2 n'))

[take 5 (triangularesConCifras3 n'),

take 5 (triangularesConCifras4 n'),

take 5 (triangularesConCifras5 n')]

where n' = 1 + n `mod` 9

-- La comprobación es

-- λ> quickCheck prop_triangularesConCifras

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> (triangularesConCifras1 3) !! 220

-- 5456556

-- (2.48 secs, 1,228,690,120 bytes)

-- λ> (triangularesConCifras2 3) !! 220

-- 5456556

-- (0.01 secs, 4,667,288 bytes)

-- λ> (triangularesConCifras2 3) !! 600

-- 500010500055

-- (1.76 secs, 1,659,299,872 bytes)

-- λ> (triangularesConCifras3 3) !! 600

-- 500010500055

-- (1.67 secs, 1,603,298,648 bytes)

-- λ> (triangularesConCifras4 3) !! 600

-- 500010500055

-- (1.20 secs, 1,507,298,248 bytes)

-- λ> (triangularesConCifras5 3) !! 600

-- 500010500055

-- (1.15 secs, 1,507,298,256 bytes)

El código se encuentra en GitHub.

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

Nuevas soluciones

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

Numeración de las ternas de números naturales

PorJosé A. Alonso 17-marzo-202215-abril-2022

Las ternas de números naturales se pueden ordenar como sigue

   (0,0,0),
   (0,0,1),(0,1,0),(1,0,0),
   (0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0),(2,0,0),
   (0,0,3),(0,1,2),(0,2,1),(0,3,0),(1,0,2),(1,1,1),(1,2,0),(2,0,1),...
   ...

(0,0,0),

(0,0,1),(0,1,0),(1,0,0),

(0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0),(2,0,0),

(0,0,3),(0,1,2),(0,2,1),(0,3,0),(1,0,2),(1,1,1),(1,2,0),(2,0,1),...

...

Definir la función

   posicion :: (Int,Int,Int) -> Int

1	posicion :: (Int,Int,Int) -> Int

tal que (posicion (x,y,z)) es la posición de la terna de números naturales (x,y,z) en la ordenación anterior. Por ejemplo,

   posicion (0,1,0)  ==  2
   posicion (0,0,2)  ==  4
   posicion (0,1,1)  ==  5

posicion (0,1,0) == 2

posicion (0,0,2) == 4

posicion (0,1,1) == 5

Comprobar con QuickCheck que

la posición de (x,0,0) es x(x²+6x+11)/6
la posición de (0,y,0) es y(y²+3y+ 8)/6
la posición de (0,0,z) es z(z²+3z+ 2)/6
la posición de (x,x,x) es x(9x²+14x+7)/2

Soluciones

import Data.List (elemIndex)
import Data.Maybe (fromJust)
import Test.QuickCheck

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

posicion1 :: (Int,Int,Int) -> Int
posicion1 t = aux 0 ternas
  where aux n (t':ts) | t' == t   = n
                      | otherwise = aux (n+1) ts

-- ternas es la lista ordenada de las ternas de números naturales. Por ejemplo,
--    λ> take 9 ternas
--    [(0,0,0),(0,0,1),(0,1,0),(1,0,0),(0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0)]
ternas :: [(Int,Int,Int)]
ternas = [(x,y,n-x-y) | n <- [0..], x <- [0..n], y <- [0..n-x]]

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

posicion2 :: (Int,Int,Int) -> Int
posicion2 t =
  head [n | (n,t') <- zip [0..] ternas, t' == t]

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

posicion3 :: (Int,Int,Int) -> Int
posicion3 t = indice t ternas

-- (indice x ys) es el índice de x en ys. Por ejemplo,
--    indice 5 [0..]  ==  5
indice :: Eq a => a -> [a] -> Int
indice x ys = length (takeWhile (/= x) ys)

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

posicion4 :: (Int,Int,Int) -> Int
posicion4 t = fromJust (elemIndex t ternas)

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

posicion5 :: (Int,Int,Int) -> Int
posicion5 = fromJust . (`elemIndex` ternas)

-- Equivalencia
-- ============

-- La propiedad es
prop_posicion_equiv :: NonNegative Int
                    -> NonNegative Int
                    -> NonNegative Int
                    -> Bool
prop_posicion_equiv (NonNegative x) (NonNegative y) (NonNegative z) =
  all (== posicion1 (x,y,z))
      [f (x,y,z) | f <- [ posicion2
                        , posicion3
                        , posicion4
                        , posicion5 ]]

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

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

-- La comparación es
--    λ> posicion1 (147,46,116)
--    5000000
--    (5.84 secs, 2,621,428,184 bytes)
--    λ> posicion2 (147,46,116)
--    5000000
--    (3.63 secs, 2,173,230,200 bytes)
--    λ> posicion3 (147,46,116)
--    5000000
--    (2.48 secs, 1,453,229,880 bytes)
--    λ> posicion4 (147,46,116)
--    5000000
--    (1.91 secs, 1,173,229,840 bytes)
--    λ> posicion5 (147,46,116)
--    5000000
--    (1.94 secs, 1,173,229,960 bytes)

-- En lo que sigue, usaremos la 5ª definición
posicion :: (Int,Int,Int) -> Int
posicion = posicion5

-- Propiedades
-- ===========

-- La 1ª propiedad es
prop_posicion1 :: NonNegative Int -> Bool
prop_posicion1 (NonNegative x) =
  posicion (x,0,0) == x * (x^2 + 6*x + 11) `div` 6

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion1
--    +++ OK, passed 100 tests.

-- La 2ª propiedad es
prop_posicion2 :: NonNegative Int -> Bool
prop_posicion2 (NonNegative y) =
  posicion (0,y,0) == y * (y^2 + 3*y + 8) `div` 6

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion2
--    +++ OK, passed 100 tests.

-- La 3ª propiedad es
prop_posicion3 :: NonNegative Int -> Bool
prop_posicion3 (NonNegative z) =
  posicion (0,0,z) == z * (z^2 + 3*z + 2) `div` 6

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion3
--    +++ OK, passed 100 tests.

-- La 4ª propiedad es
prop_posicion4 :: NonNegative Int -> Bool
prop_posicion4 (NonNegative x) =
  posicion (x,x,x) == x * (9 * x^2 + 14 * x + 7) `div` 2

-- Su comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion4
--    +++ OK, passed 100 tests.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

import Data.List (elemIndex)

import Data.Maybe (fromJust)

import Test.QuickCheck

-- 1ª solución

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

posicion1 :: (Int,Int,Int) -> Int

posicion1 t = aux 0 ternas

where aux n (t':ts) | t' == t = n

| otherwise = aux (n+1) ts

-- ternas es la lista ordenada de las ternas de números naturales. Por ejemplo,

-- λ> take 9 ternas

-- [(0,0,0),(0,0,1),(0,1,0),(1,0,0),(0,0,2),(0,1,1),(0,2,0),(1,0,1),(1,1,0)]

ternas :: [(Int,Int,Int)]

ternas = [(x,y,n-x-y) | n <- [0..], x <- [0..n], y <- [0..n-x]]

-- 2ª solución

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

posicion2 :: (Int,Int,Int) -> Int

posicion2 t =

head [n | (n,t') <- zip [0..] ternas, t' == t]

-- 3ª solución

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

posicion3 :: (Int,Int,Int) -> Int

posicion3 t = indice t ternas

-- (indice x ys) es el índice de x en ys. Por ejemplo,

-- indice 5 [0..] == 5

indice :: Eq a => a -> [a] -> Int

indice x ys = length (takeWhile (/= x) ys)

-- 4ª solución

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

posicion4 :: (Int,Int,Int) -> Int

posicion4 t = fromJust (elemIndex t ternas)

-- 5ª solución

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

posicion5 :: (Int,Int,Int) -> Int

posicion5 = fromJust . (`elemIndex` ternas)

-- Equivalencia

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

-- La propiedad es

prop_posicion_equiv :: NonNegative Int

-> NonNegative Int

-> Bool

prop_posicion_equiv (NonNegative x) (NonNegative y) (NonNegative z) =

all (== posicion1 (x,y,z))

[f (x,y,z) | f <- [ posicion2

, posicion3

, posicion4

, posicion5 ]]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> posicion1 (147,46,116)

-- 5000000

-- (5.84 secs, 2,621,428,184 bytes)

-- λ> posicion2 (147,46,116)

-- 5000000

-- (3.63 secs, 2,173,230,200 bytes)

-- λ> posicion3 (147,46,116)

-- 5000000

-- (2.48 secs, 1,453,229,880 bytes)

-- λ> posicion4 (147,46,116)

-- 5000000

-- (1.91 secs, 1,173,229,840 bytes)

-- λ> posicion5 (147,46,116)

-- 5000000

-- (1.94 secs, 1,173,229,960 bytes)

-- En lo que sigue, usaremos la 5ª definición

posicion :: (Int,Int,Int) -> Int

posicion = posicion5

-- Propiedades

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

-- La 1ª propiedad es

prop_posicion1 :: NonNegative Int -> Bool

prop_posicion1 (NonNegative x) =

posicion (x,0,0) == x * (x^2 + 6*x + 11) `div` 6

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion1

-- +++ OK, passed 100 tests.

-- La 2ª propiedad es

prop_posicion2 :: NonNegative Int -> Bool

prop_posicion2 (NonNegative y) =

posicion (0,y,0) == y * (y^2 + 3*y + 8) `div` 6

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion2

-- +++ OK, passed 100 tests.

-- La 3ª propiedad es

prop_posicion3 :: NonNegative Int -> Bool

prop_posicion3 (NonNegative z) =

posicion (0,0,z) == z * (z^2 + 3*z + 2) `div` 6

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion3

-- +++ OK, passed 100 tests.

-- La 4ª propiedad es

prop_posicion4 :: NonNegative Int -> Bool

prop_posicion4 (NonNegative x) =

posicion (x,x,x) == x * (9 * x^2 + 14 * x + 7) `div` 2

-- Su comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=20}) prop_posicion4

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

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

Lista cuadrada

PorJosé A. Alonso 10-marzo-202217-marzo-2022

Definir la función

   listaCuadrada :: Int -> a -> [a] -> [[a]]

1	listaCuadrada :: Int -> a -> [a] -> [[a]]

tal que (listaCuadrada n x xs) es una lista de n listas de longitud n formadas con los elementos de xs completada con x, si no xs no tiene suficientes elementos. Por ejemplo,

   listaCuadrada 3 7 [0,3,5,2,4]  ==  [[0,3,5],[2,4,7],[7,7,7]]
   listaCuadrada 3 7 [0..]        ==  [[0,1,2],[3,4,5],[6,7,8]]
   listaCuadrada 2 'p' "eva"      ==  ["ev","ap"]
   listaCuadrada 2 'p' ['a'..]    ==  ["ab","cd"]

listaCuadrada 3 7 [0,3,5,2,4] == [[0,3,5],[2,4,7],[7,7,7]]

listaCuadrada 3 7 [0..] == [[0,1,2],[3,4,5],[6,7,8]]

listaCuadrada 2 'p' "eva" == ["ev","ap"]

listaCuadrada 2 'p' ['a'..] == ["ab","cd"]

Soluciones

import Data.List.Split (chunksOf)
import Test.QuickCheck

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

listaCuadrada1 :: Int -> a -> [a] -> [[a]]
listaCuadrada1 n x xs =
  take n (grupos n (xs ++ repeat x))

-- (grupos n xs) es la lista obtenida agrupando los elementos de xs en
-- grupos de n elementos, salvo el último que puede tener menos. Por
-- ejemplo,
--    grupos 2 [4,2,5,7,6]     ==  [[4,2],[5,7],[6]]
--    take 3 (grupos 3 [1..])  ==  [[1,2,3],[4,5,6],[7,8,9]]
grupos :: Int -> [a] -> [[a]]
grupos _ [] = []
grupos n xs = take n xs : grupos n (drop n xs)

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

listaCuadrada2 :: Int -> a -> [a] -> [[a]]
listaCuadrada2 n x xs =
  take n (grupos2 n (xs ++ repeat x))

grupos2 :: Int -> [a] -> [[a]]
grupos2 _ [] = []
grupos2 n xs = ys : grupos n zs
  where (ys,zs) = splitAt n xs

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

listaCuadrada3 :: Int -> a -> [a] -> [[a]]
listaCuadrada3 n x xs =
  take n (chunksOf n (xs ++ repeat x))

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

-- La propiedad es
prop_listaCuadrada :: Int -> Int -> [Int] -> Bool
prop_listaCuadrada n x xs =
  all (== listaCuadrada1 n x xs)
      [listaCuadrada2 n x xs,
       listaCuadrada3 n x xs]

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

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

-- La comparación es
--    λ> length (listaCuadrada1 (10^4) 5 [1..])
--    10000
--    (2.02 secs, 12,801,918,616 bytes)
--    λ> length (listaCuadrada2 (10^4) 5 [1..])
--    10000
--    (1.89 secs, 12,803,198,576 bytes)
--    λ> length (listaCuadrada3 (10^4) 5 [1..])
--    10000
--    (1.85 secs, 12,801,518,728 bytes)

import Data.List.Split (chunksOf)

import Test.QuickCheck

-- 1ª solución

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

listaCuadrada1 :: Int -> a -> [a] -> [[a]]

listaCuadrada1 n x xs =

take n (grupos n (xs ++ repeat x))

-- (grupos n xs) es la lista obtenida agrupando los elementos de xs en

-- grupos de n elementos, salvo el último que puede tener menos. Por

-- ejemplo,

-- grupos 2 [4,2,5,7,6] == [[4,2],[5,7],[6]]

-- take 3 (grupos 3 [1..]) == [[1,2,3],[4,5,6],[7,8,9]]

grupos :: Int -> [a] -> [[a]]

grupos _ [] = []

grupos n xs = take n xs : grupos n (drop n xs)

-- 2ª solución

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

listaCuadrada2 :: Int -> a -> [a] -> [[a]]

listaCuadrada2 n x xs =

take n (grupos2 n (xs ++ repeat x))

grupos2 :: Int -> [a] -> [[a]]

grupos2 _ [] = []

grupos2 n xs = ys : grupos n zs

where (ys,zs) = splitAt n xs

-- 3ª solución

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

listaCuadrada3 :: Int -> a -> [a] -> [[a]]

listaCuadrada3 n x xs =

take n (chunksOf n (xs ++ repeat x))

-- Comprobación de la equivalencia

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

-- La propiedad es

prop_listaCuadrada :: Int -> Int -> [Int] -> Bool

prop_listaCuadrada n x xs =

all (== listaCuadrada1 n x xs)

[listaCuadrada2 n x xs,

listaCuadrada3 n x xs]

-- La comprobación es

-- λ> quickCheck prop_listaCuadrada

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (listaCuadrada1 (10^4) 5 [1..])

-- 10000

-- (2.02 secs, 12,801,918,616 bytes)

-- λ> length (listaCuadrada2 (10^4) 5 [1..])

-- 10000

-- (1.89 secs, 12,803,198,576 bytes)

-- λ> length (listaCuadrada3 (10^4) 5 [1..])

-- 10000

-- (1.85 secs, 12,801,518,728 bytes)

El código se encuentra en GitHub.

La elaboración de la solución se muestra en el siguiente vídeo:

Primos equidistantes

PorJosé A. Alonso 2-marzo-202215-abril-2022

Definir la función

   primosEquidistantes :: Integer -> [(Integer,Integer)]

1	primosEquidistantes :: Integer -> [(Integer,Integer)]

tal que (primosEquidistantes k) es la lista de los pares de primos cuya diferencia es k. Por ejemplo,

   take 3 (primosEquidistantes 2)  ==  [(3,5),(5,7),(11,13)]
   take 3 (primosEquidistantes 4)  ==  [(7,11),(13,17),(19,23)]
   take 3 (primosEquidistantes 6)  ==  [(23,29),(31,37),(47,53)]
   take 3 (primosEquidistantes 8)  ==  [(89,97),(359,367),(389,397)]
   primosEquidistantes 4 !! (10^5) ==  (18467047,18467051)

take 3 (primosEquidistantes 2) == [(3,5),(5,7),(11,13)]

take 3 (primosEquidistantes 4) == [(7,11),(13,17),(19,23)]

take 3 (primosEquidistantes 6) == [(23,29),(31,37),(47,53)]

take 3 (primosEquidistantes 8) == [(89,97),(359,367),(389,397)]

primosEquidistantes 4 !! (10^5) == (18467047,18467051)

Soluciones

import Data.Numbers.Primes (primes)

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

primosEquidistantes1 :: Integer -> [(Integer,Integer)]
primosEquidistantes1 k = aux primos
  where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)
                     | otherwise  = aux (y:ps)

-- (primo x) se verifica si x es primo. Por ejemplo,
--    primo 7  ==  True
--    primo 8  ==  False
primo :: Integer -> Bool
primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

-- primos es la lista de los números primos. Por ejemplo,
--    take 10 primos  ==  [2,3,5,7,11,13,17,19,23,29]
primos :: [Integer]
primos = 2 : [x | x <- [3,5..], primo x]

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

primosEquidistantes2 :: Integer -> [(Integer,Integer)]
primosEquidistantes2 k = aux primos2
  where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)
                     | otherwise  = aux (y:ps)

primos2 :: [Integer]
primos2 = criba [2..]
  where criba (p:ps) = p : criba [n | n <- ps, mod n p /= 0]

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

primosEquidistantes3 :: Integer -> [(Integer,Integer)]
primosEquidistantes3 k =
  [(x,y) | (x,y) <- zip primos2 (tail primos2)
         , y - x == k]

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

primosEquidistantes4 :: Integer -> [(Integer,Integer)]
primosEquidistantes4 k = aux primes
  where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)
                     | otherwise  = aux (y:ps)

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

primosEquidistantes5 :: Integer -> [(Integer,Integer)]
primosEquidistantes5 k =
  [(x,y) | (x,y) <- zip primes (tail primes)
         , y - x == k]

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

-- La propiedad es
prop_primosEquidistantes :: Int -> Integer -> Bool
prop_primosEquidistantes n k =
  all (== take n (primosEquidistantes1 k))
      [take n (f k) | f <- [primosEquidistantes2,
                            primosEquidistantes3,
                            primosEquidistantes4,
                            primosEquidistantes5]]

-- La comprobación es
--    λ> prop_primosEquidistantes 100 4
--    True

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

-- La comparación es
--    λ> primosEquidistantes1 4 !! 200
--    (9829,9833)
--    (2.60 secs, 1,126,458,272 bytes)
--    λ> primosEquidistantes2 4 !! 200
--    (9829,9833)
--    (0.44 secs, 249,622,048 bytes)
--    λ> primosEquidistantes3 4 !! 200
--    (9829,9833)
--    (0.36 secs, 207,549,592 bytes)
--    λ> primosEquidistantes4 4 !! 200
--    (9829,9833)
--    (0.02 secs, 4,012,848 bytes)
--    λ> primosEquidistantes5 4 !! 200
--    (9829,9833)
--    (0.01 secs, 7,085,072 bytes)
--
--    λ> primosEquidistantes2 4 !! 600
--    (41617,41621)
--    (5.67 secs, 3,340,313,480 bytes)
--    λ> primosEquidistantes3 4 !! 600
--    (41617,41621)
--    (5.43 secs, 3,090,994,096 bytes)
--    λ> primosEquidistantes4 4 !! 600
--    (41617,41621)
--    (0.03 secs, 15,465,824 bytes)
--    λ> primosEquidistantes5 4 !! 600
--    (41617,41621)
--    (0.04 secs, 28,858,232 bytes)
--
--    λ> primosEquidistantes4 4 !! (10^5)
--    (18467047,18467051)
--    (3.99 secs, 9,565,715,488 bytes)
--    λ> primosEquidistantes5 4 !! (10^5)
--    (18467047,18467051)
--    (7.95 secs, 18,712,469,144 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

import Data.Numbers.Primes (primes)

-- 1ª solución

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

primosEquidistantes1 :: Integer -> [(Integer,Integer)]

primosEquidistantes1 k = aux primos

where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)

| otherwise = aux (y:ps)

-- (primo x) se verifica si x es primo. Por ejemplo,

-- primo 7 == True

-- primo 8 == False

primo :: Integer -> Bool

primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

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

-- take 10 primos == [2,3,5,7,11,13,17,19,23,29]

primos :: [Integer]

primos = 2 : [x | x <- [3,5..], primo x]

-- 2ª solución

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

primosEquidistantes2 :: Integer -> [(Integer,Integer)]

primosEquidistantes2 k = aux primos2

where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)

| otherwise = aux (y:ps)

primos2 :: [Integer]

primos2 = criba [2..]

where criba (p:ps) = p : criba [n | n <- ps, mod n p /= 0]

-- 3ª solución

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

primosEquidistantes3 :: Integer -> [(Integer,Integer)]

primosEquidistantes3 k =

[(x,y) | (x,y) <- zip primos2 (tail primos2)

, y - x == k]

-- 4ª solución

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

primosEquidistantes4 :: Integer -> [(Integer,Integer)]

primosEquidistantes4 k = aux primes

where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)

| otherwise = aux (y:ps)

-- 5ª solución

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

primosEquidistantes5 :: Integer -> [(Integer,Integer)]

primosEquidistantes5 k =

[(x,y) | (x,y) <- zip primes (tail primes)

, y - x == k]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_primosEquidistantes :: Int -> Integer -> Bool

prop_primosEquidistantes n k =

all (== take n (primosEquidistantes1 k))

[take n (f k) | f <- [primosEquidistantes2,

primosEquidistantes3,

primosEquidistantes4,

primosEquidistantes5]]

-- La comprobación es

-- λ> prop_primosEquidistantes 100 4

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> primosEquidistantes1 4 !! 200

-- (9829,9833)

-- (2.60 secs, 1,126,458,272 bytes)

-- λ> primosEquidistantes2 4 !! 200

-- (9829,9833)

-- (0.44 secs, 249,622,048 bytes)

-- λ> primosEquidistantes3 4 !! 200

-- (9829,9833)

-- (0.36 secs, 207,549,592 bytes)

-- λ> primosEquidistantes4 4 !! 200

-- (9829,9833)

-- (0.02 secs, 4,012,848 bytes)

-- λ> primosEquidistantes5 4 !! 200

-- (9829,9833)

-- (0.01 secs, 7,085,072 bytes)

-- λ> primosEquidistantes2 4 !! 600

-- (41617,41621)

-- (5.67 secs, 3,340,313,480 bytes)

-- λ> primosEquidistantes3 4 !! 600

-- (41617,41621)

-- (5.43 secs, 3,090,994,096 bytes)

-- λ> primosEquidistantes4 4 !! 600

-- (41617,41621)

-- (0.03 secs, 15,465,824 bytes)

-- λ> primosEquidistantes5 4 !! 600

-- (41617,41621)

-- (0.04 secs, 28,858,232 bytes)

-- λ> primosEquidistantes4 4 !! (10^5)

-- (18467047,18467051)

-- (3.99 secs, 9,565,715,488 bytes)

-- λ> primosEquidistantes5 4 !! (10^5)

-- (18467047,18467051)

-- (7.95 secs, 18,712,469,144 bytes)

El código se encuentra en GitHub.

Primos consecutivos con media capicúa

PorJosé A. Alonso 23-febrero-202215-abril-2022

Definir la lista

   primosConsecutivosConMediaCapicua :: [(Int,Int,Int)]

1	primosConsecutivosConMediaCapicua :: [(Int,Int,Int)]

formada por las ternas (x,y,z) tales que x e y son primos consecutivos cuya media, z, es capicúa. Por ejemplo,

   λ> take 5 primosConsecutivosConMediaCapicua
   [(3,5,4),(5,7,6),(7,11,9),(97,101,99),(109,113,111)]
   λ> primosConsecutivosConMediaCapicua !! 500
   (5687863,5687867,5687865)

λ> take 5 primosConsecutivosConMediaCapicua

[(3,5,4),(5,7,6),(7,11,9),(97,101,99),(109,113,111)]

λ> primosConsecutivosConMediaCapicua !! 500

(5687863,5687867,5687865)

Soluciones

import Data.List (genericTake)
import Data.Numbers.Primes (primes)

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

primosConsecutivosConMediaCapicua :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua =
  [(x,y,z) | (x,y) <- zip primosImpares (tail primosImpares),
             let z = (x + y) `div` 2,
             capicua z]

-- (primo x) se verifica si x es primo. Por ejemplo,
--    primo 7  ==  True
--    primo 8  ==  False
primo :: Integer -> Bool
primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

-- primosImpares es la lista de los números primos impares. Por ejemplo,
--    take 10 primosImpares  ==  [3,5,7,11,13,17,19,23,29]
primosImpares :: [Integer]
primosImpares = [x | x <- [3,5..], primo x]

-- (capicua x) se verifica si x es capicúa. Por ejemplo,
capicua :: Integer -> Bool
capicua x = ys == reverse ys
  where ys = show x

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

primosConsecutivosConMediaCapicua2 :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua2 =
  [(x,y,z) | (x,y) <- zip primosImpares2 (tail primosImpares2),
             let z = (x + y) `div` 2,
             capicua z]

primosImpares2 :: [Integer]
primosImpares2 = tail (criba [2..])
  where criba (p:ps) = p : criba [n | n <- ps, mod n p /= 0]
        criba []     = error "Imposible"

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

primosConsecutivosConMediaCapicua3 :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua3 =
  [(x,y,z) | (x,y) <- zip (tail primos3) (drop 2 primos3),
             let z = (x + y) `div` 2,
             capicua z]

primos3 :: [Integer]
primos3 = 2 : 3 : criba3 0 (tail primos3) 3
  where criba3 k (p:ps) x = [n | n <- [x+2,x+4..p*p-2],
                                 and [n `rem` q /= 0 | q <- take k (tail primos3)]]
                            ++ criba3 (k+1) ps (p*p)
        criba3 _ [] _     = error "Imposible"

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

primosConsecutivosConMediaCapicua4 :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua4 =
  [(x,y,z) | (x,y) <- zip (tail primes) (drop 2 primes),
             let z = (x + y) `div` 2,
             capicua z]

-- Equivalencia de definiciones
-- ============================

-- La propiedad es
prop_primosConsecutivosConMediaCapicua :: Integer -> Bool
prop_primosConsecutivosConMediaCapicua n =
  all (== genericTake n primosConsecutivosConMediaCapicua)
      [genericTake n primosConsecutivosConMediaCapicua2,
       genericTake n primosConsecutivosConMediaCapicua3,
       genericTake n primosConsecutivosConMediaCapicua4]

-- La comprobación es
--    λ> prop_primosConsecutivosConMediaCapicua 25 {-# SCC "" #-}
--    True

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

-- La comparación es
--    λ> primosConsecutivosConMediaCapicua !! 30
--    (12919,12923,12921)
--    (4.60 secs, 1,877,064,288 bytes)
--    λ> primosConsecutivosConMediaCapicua2 !! 30
--    (12919,12923,12921)
--    (0.69 secs, 407,055,848 bytes)
--    λ> primosConsecutivosConMediaCapicua3 !! 30
--    (12919,12923,12921)
--    (0.07 secs, 18,597,104 bytes)
--    λ> primosConsecutivosConMediaCapicua4 !! 30
--    (12919,12923,12921)
--    (0.01 secs, 10,065,784 bytes)
--
--    λ> primosConsecutivosConMediaCapicua2 !! 40
--    (29287,29297,29292)
--    (2.67 secs, 1,775,554,576 bytes)
--    λ> primosConsecutivosConMediaCapicua3 !! 40
--    (29287,29297,29292)
--    (0.09 secs, 32,325,808 bytes)
--    λ> primosConsecutivosConMediaCapicua4 !! 40
--    (29287,29297,29292)
--    (0.01 secs, 22,160,072 bytes)
--
--    λ> primosConsecutivosConMediaCapicua3 !! 150
--    (605503,605509,605506)
--    (3.68 secs, 2,298,403,864 bytes)
--    λ> primosConsecutivosConMediaCapicua4 !! 150
--    (605503,605509,605506)
--    (0.24 secs, 491,917,240 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (genericTake)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

primosConsecutivosConMediaCapicua :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua =

[(x,y,z) | (x,y) <- zip primosImpares (tail primosImpares),

let z = (x + y) `div` 2,

capicua z]

-- (primo x) se verifica si x es primo. Por ejemplo,

-- primo 7 == True

-- primo 8 == False

primo :: Integer -> Bool

primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

-- primosImpares es la lista de los números primos impares. Por ejemplo,

-- take 10 primosImpares == [3,5,7,11,13,17,19,23,29]

primosImpares :: [Integer]

primosImpares = [x | x <- [3,5..], primo x]

-- (capicua x) se verifica si x es capicúa. Por ejemplo,

capicua :: Integer -> Bool

capicua x = ys == reverse ys

where ys = show x

-- 2ª solución

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

primosConsecutivosConMediaCapicua2 :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua2 =

[(x,y,z) | (x,y) <- zip primosImpares2 (tail primosImpares2),

let z = (x + y) `div` 2,

capicua z]

primosImpares2 :: [Integer]

primosImpares2 = tail (criba [2..])

where criba (p:ps) = p : criba [n | n <- ps, mod n p /= 0]

criba [] = error "Imposible"

-- 3ª solución

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

primosConsecutivosConMediaCapicua3 :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua3 =

[(x,y,z) | (x,y) <- zip (tail primos3) (drop 2 primos3),

let z = (x + y) `div` 2,

capicua z]

primos3 :: [Integer]

primos3 = 2 : 3 : criba3 0 (tail primos3) 3

where criba3 k (p:ps) x = [n | n <- [x+2,x+4..p*p-2],

and [n `rem` q /= 0 | q <- take k (tail primos3)]]

++ criba3 (k+1) ps (p*p)

criba3 _ [] _ = error "Imposible"

-- 4ª solución

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

primosConsecutivosConMediaCapicua4 :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua4 =

[(x,y,z) | (x,y) <- zip (tail primes) (drop 2 primes),

let z = (x + y) `div` 2,

capicua z]

-- Equivalencia de definiciones

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

-- La propiedad es

prop_primosConsecutivosConMediaCapicua :: Integer -> Bool

prop_primosConsecutivosConMediaCapicua n =

all (== genericTake n primosConsecutivosConMediaCapicua)

[genericTake n primosConsecutivosConMediaCapicua2,

genericTake n primosConsecutivosConMediaCapicua3,

genericTake n primosConsecutivosConMediaCapicua4]

-- La comprobación es

-- λ> prop_primosConsecutivosConMediaCapicua 25 {-# SCC "" #-}

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> primosConsecutivosConMediaCapicua !! 30

-- (12919,12923,12921)

-- (4.60 secs, 1,877,064,288 bytes)

-- λ> primosConsecutivosConMediaCapicua2 !! 30

-- (12919,12923,12921)

-- (0.69 secs, 407,055,848 bytes)

-- λ> primosConsecutivosConMediaCapicua3 !! 30

-- (12919,12923,12921)

-- (0.07 secs, 18,597,104 bytes)

-- λ> primosConsecutivosConMediaCapicua4 !! 30

-- (12919,12923,12921)

-- (0.01 secs, 10,065,784 bytes)

-- λ> primosConsecutivosConMediaCapicua2 !! 40

-- (29287,29297,29292)

-- (2.67 secs, 1,775,554,576 bytes)

-- λ> primosConsecutivosConMediaCapicua3 !! 40

-- (29287,29297,29292)

-- (0.09 secs, 32,325,808 bytes)

-- λ> primosConsecutivosConMediaCapicua4 !! 40

-- (29287,29297,29292)

-- (0.01 secs, 22,160,072 bytes)

-- λ> primosConsecutivosConMediaCapicua3 !! 150

-- (605503,605509,605506)

-- (3.68 secs, 2,298,403,864 bytes)

-- λ> primosConsecutivosConMediaCapicua4 !! 150

-- (605503,605509,605506)

-- (0.24 secs, 491,917,240 bytes)

El código se encuentra en GitHub.

Suma de los números amigos menores que n

PorJosé A. Alonso 18-febrero-202215-abril-2022

Dos números amigos son dos números enteros positivos distintos tales que la suma de los divisores propios de cada uno es igual al otro. Los divisores propios de un número incluyen la unidad pero no al propio número. Por ejemplo, los divisores propios de 220 son 1, 2, 4, 5, 10, 11, 20, 22, 44, 55 y 110. La suma de estos números equivale a 284. A su vez, los divisores propios de 284 son 1, 2, 4, 71 y 142. Su suma equivale a 220. Por tanto, 220 y 284 son amigos.

Definir la función

   sumaAmigosMenores :: Integer -> Integer

1	sumaAmigosMenores :: Integer -> Integer

tal que (sumaAmigosMenores n) es la suma de los números amigos menores que n. Por ejemplo,

   sumaAmigosMenores 2000   == 2898
   sumaAmigosMenores (10^5) == 852810

1 2	sumaAmigosMenores 2000 == 2898 sumaAmigosMenores (10^5) == 852810

Soluciones

import Data.List (genericLength, group, inits, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)

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

sumaAmigosMenores1 :: Integer -> Integer
sumaAmigosMenores1 n =
  sum [x+y | (x,y) <- amigosMenores1 n]

-- (amigosMenores1 n) es la lista de los pares de números amigos (con la
-- primera componente menor que la segunda) que son menores que n. Por
-- ejemplo,
--    amigosMenores1 2000  ==  [(220,284),(1184,1210)]
amigosMenores1 :: Integer -> [(Integer,Integer)]
amigosMenores1 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos1

sucesionAmigos1 :: [(Integer,Integer)]
sucesionAmigos1 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios1 x,
           y > x,
           sumaDivisoresPropios1 y == x]

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de
-- x. Por ejemplo,
--    sumaDivisoresPropios1 220  ==  284
--    sumaDivisoresPropios1 284  ==  220
sumaDivisoresPropios1 :: Integer -> Integer
sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por
-- ejemplo,
--    divisoresPropios1 220  ==  [1,2,4,5,10,11,20,22,44,55,110]
--    divisoresPropios1 284  ==  [1,2,4,71,142]
divisoresPropios1 :: Integer -> [Integer]
divisoresPropios1 x = [n | n <- [1..x-1], x `mod` n == 0]

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

sumaAmigosMenores2 :: Integer -> Integer
sumaAmigosMenores2 n =
  sum [x+y | (x,y) <- amigosMenores2 n]

amigosMenores2 :: Integer -> [(Integer,Integer)]
amigosMenores2 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos2

sucesionAmigos2 :: [(Integer,Integer)]
sucesionAmigos2 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios2 x,
           y > x,
           sumaDivisoresPropios2 y == x]

sumaDivisoresPropios2 :: Integer -> Integer
sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]
divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

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

sumaAmigosMenores3 :: Integer -> Integer
sumaAmigosMenores3 n =
  sum [x+y | (x,y) <- amigosMenores3 n]

amigosMenores3 :: Integer -> [(Integer,Integer)]
amigosMenores3 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos3

sucesionAmigos3 :: [(Integer,Integer)]
sucesionAmigos3 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios3 x,
           y > x,
           sumaDivisoresPropios3 y == x]

sumaDivisoresPropios3 :: Integer -> Integer
sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]
divisoresPropios3 =
  init . nub . sort . map product . subsequences . primeFactors

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

sumaAmigosMenores4 :: Integer -> Integer
sumaAmigosMenores4 n =
  sum [x+y | (x,y) <- amigosMenores4 n]

amigosMenores4 :: Integer -> [(Integer,Integer)]
amigosMenores4 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos4

sucesionAmigos4 :: [(Integer,Integer)]
sucesionAmigos4 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios4 x,
           y > x,
           sumaDivisoresPropios4 y == x]

sumaDivisoresPropios4 :: Integer -> Integer
sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]
divisoresPropios4 =
  init
  . sort
  . map (product . concat)
  . productoCartesiano
  . map inits
  . group
  . primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos
-- xss. Por ejemplo,
--    λ> productoCartesiano [[1,3],[2,5],[6,4]]
--    [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
productoCartesiano :: [[a]] -> [[a]]
productoCartesiano []       = [[]]
productoCartesiano (xs:xss) =
  [x:ys | x <- xs, ys <- productoCartesiano xss]

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

sumaAmigosMenores5 :: Integer -> Integer
sumaAmigosMenores5 n =
  sum [x+y | (x,y) <- amigosMenores5 n]

amigosMenores5 :: Integer -> [(Integer,Integer)]
amigosMenores5 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos5

sucesionAmigos5 :: [(Integer,Integer)]
sucesionAmigos5 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios5 x,
           y > x,
           sumaDivisoresPropios5 y == x]

sumaDivisoresPropios5 :: Integer -> Integer
sumaDivisoresPropios5 = sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]
divisoresPropios5 =
  init
  . sort
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

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

sumaAmigosMenores6 :: Integer -> Integer
sumaAmigosMenores6 n =
  sum [x+y | (x,y) <- amigosMenores6 n]

amigosMenores6 :: Integer -> [(Integer,Integer)]
amigosMenores6 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos6

sucesionAmigos6 :: [(Integer,Integer)]
sucesionAmigos6 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios6 x,
           y > x,
           sumaDivisoresPropios6 y == x]

sumaDivisoresPropios6 :: Integer -> Integer
sumaDivisoresPropios6 =
  sum
  . init
  . map (product . concat)
  . sequence
  . map inits
  . group
  . primeFactors

-- 7ª solución                                                   --
-- ===========

sumaAmigosMenores7 :: Integer -> Integer
sumaAmigosMenores7 n =
  sum [x+y | (x,y) <- amigosMenores7 n]

amigosMenores7 :: Integer -> [(Integer,Integer)]
amigosMenores7 n =
  takeWhile (\(_,y) -> y < n) sucesionAmigos7

sucesionAmigos7 :: [(Integer,Integer)]
sucesionAmigos7 =
  [(x,y) | x <- [1..],
           let y = sumaDivisoresPropios7 x,
           y > x,
           sumaDivisoresPropios7 y == x]

-- Si la descomposición de x en factores primos es
--    x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)
-- entonces la suma de los divisores de x es
--    p(1)^(e(1)+1) - 1     p(2)^(e(2)+1) - 1       p(n)^(e(2)+1) - 1
--   ------------------- . ------------------- ... -------------------
--        p(1)-1                p(2)-1                  p(n)-1
-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisoresPropios7 :: Integer -> Integer
sumaDivisoresPropios7 x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la
-- descomposición prima de x. Por ejemplo,
--    factorizacion 600  ==  [(2,3),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs
-- y la longitud de xs. Por ejemplo,
--    primeroYlongitud [3,2,5,7] == (3,4)
primeroYlongitud :: [a] -> (a,Integer)
primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

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

-- La comparación es
--    λ> sumaAmigosMenores1 6000
--    19026
--    (10.37 secs, 5,261,392,352 bytes)
--    λ> sumaAmigosMenores2 6000
--    19026
--    (3.86 secs, 3,161,700,400 bytes)
--    λ> sumaAmigosMenores3 6000
--    19026
--    (0.15 secs, 308,520,248 bytes)
--    λ> sumaAmigosMenores4 6000
--    19026
--    (0.23 secs, 271,421,184 bytes)
--    λ> sumaAmigosMenores5 6000
--    19026
--    (0.13 secs, 230,042,112 bytes)
--    λ> sumaAmigosMenores6 6000
--    19026
--    (0.12 secs, 202,638,880 bytes)
--    λ> sumaAmigosMenores7 6000
--    19026
--    (0.13 secs, 159,022,448 bytes)
--
--    λ> sumaAmigosMenores3 (10^5)
--    852810
--    (4.83 secs, 10,726,377,728 bytes)
--    λ> sumaAmigosMenores4 (10^5)
--    852810
--    (4.79 secs, 7,832,234,120 bytes)
--    λ> sumaAmigosMenores5 (10^5)
--    852810
--    (2.79 secs, 6,837,118,464 bytes)
--    λ> sumaAmigosMenores6 (10^5)
--    852810
--    (2.39 secs, 6,229,730,472 bytes)
--    λ> sumaAmigosMenores7 (10^5)
--    852810
--    (2.65 secs, 5,170,949,168 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

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

261

262

263

264

265

266

267

268

269

270

import Data.List (genericLength, group, inits, nub, sort, subsequences)

import Data.Numbers.Primes (primeFactors)

-- 1ª solución --

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

sumaAmigosMenores1 :: Integer -> Integer

sumaAmigosMenores1 n =

sum [x+y | (x,y) <- amigosMenores1 n]

-- (amigosMenores1 n) es la lista de los pares de números amigos (con la

-- primera componente menor que la segunda) que son menores que n. Por

-- ejemplo,

-- amigosMenores1 2000 == [(220,284),(1184,1210)]

amigosMenores1 :: Integer -> [(Integer,Integer)]

amigosMenores1 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos1

sucesionAmigos1 :: [(Integer,Integer)]

sucesionAmigos1 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios1 x,

y > x,

sumaDivisoresPropios1 y == x]

-- (sumaDivisoresPropios1 x) es la suma de los divisores propios de

-- x. Por ejemplo,

-- sumaDivisoresPropios1 220 == 284

-- sumaDivisoresPropios1 284 == 220

sumaDivisoresPropios1 :: Integer -> Integer

sumaDivisoresPropios1 = sum . divisoresPropios1

-- (divisoresPropios1 x) es la lista de los divisores propios de x. Por

-- ejemplo,

-- divisoresPropios1 220 == [1,2,4,5,10,11,20,22,44,55,110]

-- divisoresPropios1 284 == [1,2,4,71,142]

divisoresPropios1 :: Integer -> [Integer]

divisoresPropios1 x = [n | n <- [1..x-1], x `mod` n == 0]

-- 2ª solución --

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

sumaAmigosMenores2 :: Integer -> Integer

sumaAmigosMenores2 n =

sum [x+y | (x,y) <- amigosMenores2 n]

amigosMenores2 :: Integer -> [(Integer,Integer)]

amigosMenores2 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos2

sucesionAmigos2 :: [(Integer,Integer)]

sucesionAmigos2 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios2 x,

y > x,

sumaDivisoresPropios2 y == x]

sumaDivisoresPropios2 :: Integer -> Integer

sumaDivisoresPropios2 = sum . divisoresPropios2

divisoresPropios2 :: Integer -> [Integer]

divisoresPropios2 x = filter ((== 0) . mod x) [1..x-1]

-- 3ª solución --

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

sumaAmigosMenores3 :: Integer -> Integer

sumaAmigosMenores3 n =

sum [x+y | (x,y) <- amigosMenores3 n]

amigosMenores3 :: Integer -> [(Integer,Integer)]

amigosMenores3 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos3

sucesionAmigos3 :: [(Integer,Integer)]

sucesionAmigos3 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios3 x,

y > x,

sumaDivisoresPropios3 y == x]

sumaDivisoresPropios3 :: Integer -> Integer

sumaDivisoresPropios3 = sum . divisoresPropios3

divisoresPropios3 :: Integer -> [Integer]

divisoresPropios3 =

init . nub . sort . map product . subsequences . primeFactors

-- 4ª solución --

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

sumaAmigosMenores4 :: Integer -> Integer

sumaAmigosMenores4 n =

sum [x+y | (x,y) <- amigosMenores4 n]

amigosMenores4 :: Integer -> [(Integer,Integer)]

amigosMenores4 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos4

sucesionAmigos4 :: [(Integer,Integer)]

sucesionAmigos4 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios4 x,

y > x,

sumaDivisoresPropios4 y == x]

sumaDivisoresPropios4 :: Integer -> Integer

sumaDivisoresPropios4 = sum . divisoresPropios4

divisoresPropios4 :: Integer -> [Integer]

divisoresPropios4 =

init

. sort

. map (product . concat)

. productoCartesiano

. map inits

. group

. primeFactors

-- (productoCartesiano xss) es el producto cartesiano de los conjuntos

-- xss. Por ejemplo,

-- λ> productoCartesiano [[1,3],[2,5],[6,4]]

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

productoCartesiano :: [[a]] -> [[a]]

productoCartesiano [] = [[]]

productoCartesiano (xs:xss) =

[x:ys | x <- xs, ys <- productoCartesiano xss]

-- 5ª solución --

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

sumaAmigosMenores5 :: Integer -> Integer

sumaAmigosMenores5 n =

sum [x+y | (x,y) <- amigosMenores5 n]

amigosMenores5 :: Integer -> [(Integer,Integer)]

amigosMenores5 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos5

sucesionAmigos5 :: [(Integer,Integer)]

sucesionAmigos5 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios5 x,

y > x,

sumaDivisoresPropios5 y == x]

sumaDivisoresPropios5 :: Integer -> Integer

sumaDivisoresPropios5 = sum . divisoresPropios5

divisoresPropios5 :: Integer -> [Integer]

divisoresPropios5 =

init

. sort

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 6ª solución --

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

sumaAmigosMenores6 :: Integer -> Integer

sumaAmigosMenores6 n =

sum [x+y | (x,y) <- amigosMenores6 n]

amigosMenores6 :: Integer -> [(Integer,Integer)]

amigosMenores6 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos6

sucesionAmigos6 :: [(Integer,Integer)]

sucesionAmigos6 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios6 x,

y > x,

sumaDivisoresPropios6 y == x]

sumaDivisoresPropios6 :: Integer -> Integer

sumaDivisoresPropios6 =

sum

. init

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

-- 7ª solución --

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

sumaAmigosMenores7 :: Integer -> Integer

sumaAmigosMenores7 n =

sum [x+y | (x,y) <- amigosMenores7 n]

amigosMenores7 :: Integer -> [(Integer,Integer)]

amigosMenores7 n =

takeWhile (\(_,y) -> y < n) sucesionAmigos7

sucesionAmigos7 :: [(Integer,Integer)]

sucesionAmigos7 =

[(x,y) | x <- [1..],

let y = sumaDivisoresPropios7 x,

y > x,

sumaDivisoresPropios7 y == x]

-- Si la descomposición de x en factores primos es

-- x = p(1)^e(1) . p(2)^e(2) . .... . p(n)^e(n)

-- entonces la suma de los divisores de x es

-- p(1)^(e(1)+1) - 1 p(2)^(e(2)+1) - 1 p(n)^(e(2)+1) - 1

-- ------------------- . ------------------- ... -------------------

-- p(1)-1 p(2)-1 p(n)-1

-- Ver la demostración en http://bit.ly/2zUXZPc

sumaDivisoresPropios7 :: Integer -> Integer

sumaDivisoresPropios7 x =

product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x] - x

-- (factorizacion x) es la lista de las bases y exponentes de la

-- descomposición prima de x. Por ejemplo,

-- factorizacion 600 == [(2,3),(3,1),(5,2)]

factorizacion :: Integer -> [(Integer,Integer)]

factorizacion = map primeroYlongitud . group . primeFactors

-- (primeroYlongitud xs) es el par formado por el primer elemento de xs

-- y la longitud de xs. Por ejemplo,

-- primeroYlongitud [3,2,5,7] == (3,4)

primeroYlongitud :: [a] -> (a,Integer)

primeroYlongitud (x:xs) = (x, 1 + genericLength xs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaAmigosMenores1 6000

-- 19026

-- (10.37 secs, 5,261,392,352 bytes)

-- λ> sumaAmigosMenores2 6000

-- 19026

-- (3.86 secs, 3,161,700,400 bytes)

-- λ> sumaAmigosMenores3 6000

-- 19026

-- (0.15 secs, 308,520,248 bytes)

-- λ> sumaAmigosMenores4 6000

-- 19026

-- (0.23 secs, 271,421,184 bytes)

-- λ> sumaAmigosMenores5 6000

-- 19026

-- (0.13 secs, 230,042,112 bytes)

-- λ> sumaAmigosMenores6 6000

-- 19026

-- (0.12 secs, 202,638,880 bytes)

-- λ> sumaAmigosMenores7 6000

-- 19026

-- (0.13 secs, 159,022,448 bytes)

-- λ> sumaAmigosMenores3 (10^5)

-- 852810

-- (4.83 secs, 10,726,377,728 bytes)

-- λ> sumaAmigosMenores4 (10^5)

-- 852810

-- (4.79 secs, 7,832,234,120 bytes)

-- λ> sumaAmigosMenores5 (10^5)

-- 852810

-- (2.79 secs, 6,837,118,464 bytes)

-- λ> sumaAmigosMenores6 (10^5)

-- 852810

-- (2.39 secs, 6,229,730,472 bytes)

-- λ> sumaAmigosMenores7 (10^5)

-- 852810

-- (2.65 secs, 5,170,949,168 bytes)

El código se encuentra en GitHub.

Mayor órbita de la sucesión de Collatz

PorJosé A. Alonso 11-febrero-202215-abril-2022

Se considera la siguiente operación, aplicable a cualquier número entero positivo:

Si el número es par, se divide entre 2.
Si el número es impar, se multiplica por 3 y se suma 1.

Dado un número cualquiera, podemos calcular su órbita; es decir, las imágenes sucesivas al iterar la función. Por ejemplo, la órbita de 13 es

   13, 40, 20, 10, 5, 16, 8, 4, 2, 1, 4, 2, 1,...

1	13, 40, 20, 10, 5, 16, 8, 4, 2, 1, 4, 2, 1,...

Si observamos este ejemplo, la órbita de 13 es periódica, es decir, se repite indefinidamente a partir de un momento dado). La conjetura de Collatz dice que siempre alcanzaremos el 1 para cualquier número con el que comencemos. Por ejemplo,

Empezando en n = 6 se obtiene 6, 3, 10, 5, 16, 8, 4, 2, 1.
Empezando en n = 11 se obtiene: 11, 34, 17, 52, 26, 13, 40, 20, 10, 5, 16, 8, 4, 2, 1.
Empezando en n = 27, la sucesión tiene 112 pasos, llegando hasta 9232 antes de descender a 1: 27, 82, 41, 124, 62, 31, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1.

Definir la función

   mayoresGeneradores :: Integer -> [Integer]

1	mayoresGeneradores :: Integer -> [Integer]

tal que (mayoresGeneradores n) es la lista de los números menores o iguales que n cuyas órbitas de Collatz son las de mayor longitud. Por ejemplo,

   mayoresGeneradores 20      ==  [18,19]
   mayoresGeneradores (10^6)  ==  [837799]

1 2	mayoresGeneradores 20 == [18,19] mayoresGeneradores (10^6) == [837799]

Soluciones

import qualified Data.MemoCombinators as Memo (integral)
import Data.List (genericLength, genericTake, maximumBy)
import Test.QuickCheck (Positive(..), quickCheck)

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

mayoresGeneradores :: Integer -> [Integer]
mayoresGeneradores n =
  [x | (x,y) <- ps, y == m]
  where ps = genericTake n longitudesOrbitas
        m  = maximum (map snd ps)

-- longitudesOrbita es la lista de los números junto a las longitudes de
-- las órbitas de Collatz que generan. Por ejemplo,
--    λ> take 10 longitudesOrbitas
--    [(1,1),(2,2),(3,8),(4,3),(5,6),(6,9),(7,17),(8,4),(9,20),(10,7)]
longitudesOrbitas :: [(Integer, Integer)]
longitudesOrbitas =
  [(n, genericLength (collatz n)) | n <- [1..]]

-- (siguiente n) es el siguiente de n en la sucesión de Collatz. Por
-- ejemplo,
--    siguiente 13  ==  40
--    siguiente 40  ==  20
siguiente :: Integer -> Integer
siguiente n | even n    = n `div` 2
            | otherwise = 3*n+1

-- (collatz1 n) es la órbita de Collatz de n hasta alcanzar el
-- 1. Por ejemplo,
--    collatz 13  ==  [13,40,20,10,5,16,8,4,2,1]

-- 1ª definición de collatz
collatz1 :: Integer -> [Integer]
collatz1 1 = [1]
collatz1 n = n : collatz1 (siguiente n)

-- 2ª definición de collatz
collatz2 :: Integer -> [Integer]
collatz2 n = takeWhile (/=1) (iterate siguiente n) ++ [1]

-- Usaremos la 2ª definición de collatz
collatz :: Integer -> [Integer]
collatz = collatz2

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

mayoresGeneradores2 :: Integer -> [Integer]
mayoresGeneradores2 n =
  [x | (x,y) <- ps, y == m]
  where ps = [(x, longitudOrbita x) | x <- [1..n]]
        m  = maximum (map snd ps)

-- (longitudOrbita x) es la longitud de la órbita de x. Por ejemplo,
--    longitudOrbita 13  ==  10
longitudOrbita :: Integer -> Integer
longitudOrbita 1 = 1
longitudOrbita x = 1 + longitudOrbita (siguiente x)

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

mayoresGeneradores3 :: Integer -> [Integer]
mayoresGeneradores3 n =
  [x | (x,y) <- ps, y == m]
  where ps = [(x, longitudOrbita2 x) | x <- [1..n]]
        m  = maximum (map snd ps)

longitudOrbita2 :: Integer -> Integer
longitudOrbita2 = Memo.integral longitudOrbita2'
  where
    longitudOrbita2' 1 = 1
    longitudOrbita2' x = 1 + longitudOrbita2 (siguiente x)


-- Equivalencia de definiciones
-- ============================

-- La propiedad es
prop_mayoresGeneradores :: (Positive Integer) -> Bool
prop_mayoresGeneradores (Positive n) =
  all (== (mayoresGeneradores n))
      [mayoresGeneradores2 n,
       mayoresGeneradores3 n]

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

-- Comprobación de eficiencia
-- ==========================

-- La comprobación es
--    λ> mayoresGeneradores (10^5)
--    [77031]
--    (5.43 secs, 6,232,320,064 bytes)
--    λ> mayoresGeneradores2 (10^5)
--    [77031]
--    (7.68 secs, 5,238,991,616 bytes)
--    λ> mayoresGeneradores3 (10^5)
--    [77031]
--    (0.88 secs, 571,788,736 bytes)

100

101

102

103

104

import qualified Data.MemoCombinators as Memo (integral)

import Data.List (genericLength, genericTake, maximumBy)

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

-- 1ª solución

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

mayoresGeneradores :: Integer -> [Integer]

mayoresGeneradores n =

[x | (x,y) <- ps, y == m]

where ps = genericTake n longitudesOrbitas

m = maximum (map snd ps)

-- longitudesOrbita es la lista de los números junto a las longitudes de

-- las órbitas de Collatz que generan. Por ejemplo,

-- λ> take 10 longitudesOrbitas

-- [(1,1),(2,2),(3,8),(4,3),(5,6),(6,9),(7,17),(8,4),(9,20),(10,7)]

longitudesOrbitas :: [(Integer, Integer)]

longitudesOrbitas =

[(n, genericLength (collatz n)) | n <- [1..]]

-- (siguiente n) es el siguiente de n en la sucesión de Collatz. Por

-- ejemplo,

-- siguiente 13 == 40

-- siguiente 40 == 20

siguiente :: Integer -> Integer

siguiente n | even n = n `div` 2

| otherwise = 3*n+1

-- (collatz1 n) es la órbita de Collatz de n hasta alcanzar el

-- 1. Por ejemplo,

-- collatz 13 == [13,40,20,10,5,16,8,4,2,1]

-- 1ª definición de collatz

collatz1 :: Integer -> [Integer]

collatz1 1 = [1]

collatz1 n = n : collatz1 (siguiente n)

-- 2ª definición de collatz

collatz2 :: Integer -> [Integer]

collatz2 n = takeWhile (/=1) (iterate siguiente n) ++ [1]

-- Usaremos la 2ª definición de collatz

collatz :: Integer -> [Integer]

collatz = collatz2

-- 2ª solución

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

mayoresGeneradores2 :: Integer -> [Integer]

mayoresGeneradores2 n =

[x | (x,y) <- ps, y == m]

where ps = [(x, longitudOrbita x) | x <- [1..n]]

m = maximum (map snd ps)

-- (longitudOrbita x) es la longitud de la órbita de x. Por ejemplo,

-- longitudOrbita 13 == 10

longitudOrbita :: Integer -> Integer

longitudOrbita 1 = 1

longitudOrbita x = 1 + longitudOrbita (siguiente x)

-- 3ª solución

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

mayoresGeneradores3 :: Integer -> [Integer]

mayoresGeneradores3 n =

[x | (x,y) <- ps, y == m]

where ps = [(x, longitudOrbita2 x) | x <- [1..n]]

m = maximum (map snd ps)

longitudOrbita2 :: Integer -> Integer

longitudOrbita2 = Memo.integral longitudOrbita2'

where

longitudOrbita2' 1 = 1

longitudOrbita2' x = 1 + longitudOrbita2 (siguiente x)

-- Equivalencia de definiciones

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

-- La propiedad es

prop_mayoresGeneradores :: (Positive Integer) -> Bool

prop_mayoresGeneradores (Positive n) =

all (== (mayoresGeneradores n))

[mayoresGeneradores2 n,

mayoresGeneradores3 n]

-- La comprobación es

-- λ> quickCheck prop_mayoresGeneradores

-- +++ OK, passed 100 tests.

-- Comprobación de eficiencia

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

-- La comprobación es

-- λ> mayoresGeneradores (10^5)

-- [77031]

-- (5.43 secs, 6,232,320,064 bytes)

-- λ> mayoresGeneradores2 (10^5)

-- [77031]

-- (7.68 secs, 5,238,991,616 bytes)

-- λ> mayoresGeneradores3 (10^5)

-- [77031]

-- (0.88 secs, 571,788,736 bytes)

El código se encuentra en GitHub.

Exponente en la factorización

PorJosé A. Alonso 8-febrero-202215-abril-2022

Definir la función

   exponente :: Integer -> Integer -> Int

1	exponente :: Integer -> Integer -> Int

tal que (exponente x n) es el exponente de x en la factorizacón prima de n (se supone que x > 1 y n > 0). Por ejemplo,

   exponente 2 24  ==  3
   exponente 3 24  ==  1
   exponente 6 24  ==  0
   exponente 7 24  ==  0

exponente 2 24 == 3

exponente 3 24 == 1

exponente 6 24 == 0

exponente 7 24 == 0

Soluciones

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

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

exponente1 :: Integer -> Integer -> Int
exponente1 x n
  | esPrimo x = aux n
  | otherwise = 0
  where aux m | m `mod` x == 0 = 1 + aux (m `div` x)
              | otherwise      = 0

-- (esPrimo x) se verifica si x es un número primo. Por ejemplo,
--    esPrimo 7  ==  True
--    esPrimo 8  ==  False
esPrimo :: Integer -> Bool
esPrimo x =
  [y | y <- [1..x], x `mod` y == 0] == [1,x]

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

exponente2 :: Integer -> Integer -> Int
exponente2 x n
  | esPrimo x = length (takeWhile (`divisible` x) (iterate (`div` x) n))
  | otherwise = 0

-- (divisible n x) se verifica si ne divisible por x. Por ejemplo,
--    divisible 6 2  ==  True
--    divisible 7 2  ==  False
divisible :: Integer -> Integer -> Bool
divisible n x = n `mod` x == 0

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

exponente3 :: Integer -> Integer -> Int
exponente3 x n =
  length (filter (==x) (primeFactors n))

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_exponente :: Integer -> Integer -> Property
prop_exponente x n =
  x > 1 && n > 0 ==>
  exponente1 x n == exponente2 x n &&
  exponente1 x n == exponente3 x n

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

import Data.Numbers.Primes (primeFactors)

import Test.QuickCheck

-- 1ª solución

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

exponente1 :: Integer -> Integer -> Int

exponente1 x n

| esPrimo x = aux n

| otherwise = 0

where aux m | m `mod` x == 0 = 1 + aux (m `div` x)

| otherwise = 0

-- (esPrimo x) se verifica si x es un número primo. Por ejemplo,

-- esPrimo 7 == True

-- esPrimo 8 == False

esPrimo :: Integer -> Bool

esPrimo x =

[y | y <- [1..x], x `mod` y == 0] == [1,x]

-- 2ª solución

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

exponente2 :: Integer -> Integer -> Int

exponente2 x n

| esPrimo x = length (takeWhile (`divisible` x) (iterate (`div` x) n))

| otherwise = 0

-- (divisible n x) se verifica si ne divisible por x. Por ejemplo,

-- divisible 6 2 == True

-- divisible 7 2 == False

divisible :: Integer -> Integer -> Bool

divisible n x = n `mod` x == 0

-- 3ª solución

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

exponente3 :: Integer -> Integer -> Int

exponente3 x n =

length (filter (==x) (primeFactors n))

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_exponente :: Integer -> Integer -> Property

prop_exponente x n =

x > 1 && n > 0 ==>

exponente1 x n == exponente2 x n &&

exponente1 x n == exponente3 x n

-- La comprobación es

-- λ> quickCheck prop_exponente

-- +++ OK, passed 100 tests.

El código se encuentra en GitHub.

Reconocimiento de potencias de 4

PorJosé A. Alonso 4-febrero-202215-abril-2022

Definir la función

   esPotenciaDe4 :: Integral a => a -> Bool

1	esPotenciaDe4 :: Integral a => a -> Bool

tal que (esPotenciaDe4 n) se verifica si n es una potencia de 4. Por ejemplo,

   esPotenciaDe4 16                ==  True
   esPotenciaDe4 17                ==  False
   esPotenciaDe4 (4^(4*10^5))      ==  True
   esPotenciaDe4 (1 + 4^(4*10^5))  ==  False

esPotenciaDe4 16 == True

esPotenciaDe4 17 == False

esPotenciaDe4 (4^(4*10^5)) == True

esPotenciaDe4 (1 + 4^(4*10^5)) == False

Soluciones

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

esPotenciaDe4_1 :: Integral a => a -> Bool
esPotenciaDe4_1 0 = False
esPotenciaDe4_1 1 = True
esPotenciaDe4_1 n = n `mod` 4 == 0 && esPotenciaDe4_1 (n `div` 4)

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

esPotenciaDe4_2 :: Integral a => a -> Bool
esPotenciaDe4_2 n = n `pertenece` potenciasDe4

-- potenciassDe4 es la lista de las potencias de 4. Por ejemplo,
--    take 5 potenciasDe4  ==  [1,4,16,64,256]
potenciasDe4 :: Integral a => [a]
potenciasDe4 = [4^x | x <- [0..]]

-- (pertenece x ys) se verifica si x pertenece a la lista ordenada
-- (posiblemente infinita xs). Por ejemplo,
--    pertenece 8 [2,4..]  ==  True
--    pertenece 9 [2,4..]  ==  False
pertenece :: Integral a => a -> [a] -> Bool
pertenece x ys = x == head (dropWhile (<x) ys)

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

esPotenciaDe4_3 :: Integral a => a -> Bool
esPotenciaDe4_3 n = n `pertenece` potenciasDe4_2

-- potenciassDe4 es la lista de las potencias de 4. Por ejemplo,
--    take 5 potenciasDe4  ==  [1,4,16,64,256]
potenciasDe4_2 :: Integral a => [a]
potenciasDe4_2 = iterate (*4) 1

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

esPotenciaDe4_4 :: Integral n => n -> Bool
esPotenciaDe4_4 n =
  n == head (dropWhile (<n) (iterate (*4) 1))

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

esPotenciaDe4_5 :: Integral n => n -> Bool
esPotenciaDe4_5 n =
  n == until (>=n) (*4) 1

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

-- La comparación es
--    λ> esPotenciaDe4_1 (4^(4*10^4))
--    True
--    (0.18 secs, 233,903,248 bytes)
--    λ> esPotenciaDe4_2 (4^(4*10^4))
--    True
--    (2.01 secs, 756,125,712 bytes)
--    λ> esPotenciaDe4_3 (4^(4*10^4))
--    True
--    (0.05 secs, 212,019,464 bytes)
--    λ> esPotenciaDe4_4 (4^(4*10^4))
--    True
--    (0.05 secs, 212,019,368 bytes)
--    λ> esPotenciaDe4_5 (4^(4*10^4))
--    True
--    (0.07 secs, 209,779,888 bytes)
--
--    λ> esPotenciaDe4_3 (4^(2*10^5))
--    True
--    (0.64 secs, 5,184,667,280 bytes)
--    λ> esPotenciaDe4_4 (4^(2*10^5))
--    True
--    (0.64 secs, 5,184,667,200 bytes)
--    λ> esPotenciaDe4_5 (4^(2*10^5))
--    True
--    (0.63 secs, 5,173,467,656 bytes)
--
--    λ> esPotenciaDe4_3 (4^(4*10^5))
--    True
--    (2.27 secs, 20,681,727,464 bytes)
--    λ> esPotenciaDe4_4 (4^(4*10^5))
--    True
--    (2.30 secs, 20,681,727,320 bytes)
--    λ> esPotenciaDe4_5 (4^(4*10^5))
--    True
--    (2.28 secs, 20,659,327,352 bytes)

-- 1ª solución

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

esPotenciaDe4_1 :: Integral a => a -> Bool

esPotenciaDe4_1 0 = False

esPotenciaDe4_1 1 = True

esPotenciaDe4_1 n = n `mod` 4 == 0 && esPotenciaDe4_1 (n `div` 4)

-- 2ª solución

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

esPotenciaDe4_2 :: Integral a => a -> Bool

esPotenciaDe4_2 n = n `pertenece` potenciasDe4

-- potenciassDe4 es la lista de las potencias de 4. Por ejemplo,

-- take 5 potenciasDe4 == [1,4,16,64,256]

potenciasDe4 :: Integral a => [a]

potenciasDe4 = [4^x | x <- [0..]]

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

-- (posiblemente infinita xs). Por ejemplo,

-- pertenece 8 [2,4..] == True

-- pertenece 9 [2,4..] == False

pertenece :: Integral a => a -> [a] -> Bool

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

-- 3ª solución

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

esPotenciaDe4_3 :: Integral a => a -> Bool

esPotenciaDe4_3 n = n `pertenece` potenciasDe4_2

-- potenciassDe4 es la lista de las potencias de 4. Por ejemplo,

-- take 5 potenciasDe4 == [1,4,16,64,256]

potenciasDe4_2 :: Integral a => [a]

potenciasDe4_2 = iterate (*4) 1

-- 4ª solución

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

esPotenciaDe4_4 :: Integral n => n -> Bool

esPotenciaDe4_4 n =

n == head (dropWhile (<n) (iterate (*4) 1))

-- 5ª solución

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

esPotenciaDe4_5 :: Integral n => n -> Bool

esPotenciaDe4_5 n =

n == until (>=n) (*4) 1

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esPotenciaDe4_1 (4^(4*10^4))

-- True

-- (0.18 secs, 233,903,248 bytes)

-- λ> esPotenciaDe4_2 (4^(4*10^4))

-- True

-- (2.01 secs, 756,125,712 bytes)

-- λ> esPotenciaDe4_3 (4^(4*10^4))

-- True

-- (0.05 secs, 212,019,464 bytes)

-- λ> esPotenciaDe4_4 (4^(4*10^4))

-- True

-- (0.05 secs, 212,019,368 bytes)

-- λ> esPotenciaDe4_5 (4^(4*10^4))

-- True

-- (0.07 secs, 209,779,888 bytes)

-- λ> esPotenciaDe4_3 (4^(2*10^5))

-- True

-- (0.64 secs, 5,184,667,280 bytes)

-- λ> esPotenciaDe4_4 (4^(2*10^5))

-- True

-- (0.64 secs, 5,184,667,200 bytes)

-- λ> esPotenciaDe4_5 (4^(2*10^5))

-- True

-- (0.63 secs, 5,173,467,656 bytes)

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

-- True

-- (2.27 secs, 20,681,727,464 bytes)

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

-- True

-- (2.30 secs, 20,681,727,320 bytes)

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

-- True

-- (2.28 secs, 20,659,327,352 bytes)

El código se encuentra en GitHub.

Reiteración de suma de consecutivos

PorJosé A. Alonso 2-febrero-202223-febrero-2022

La reiteración de la suma de los elementos consecutivos de la lista [1,5,3] es 14 como se explica en el siguiente diagrama

1 + 5 = 6

==> 14

5 + 3 = 8

y la de la lista [1,5,3,4] es 29 como se explica en el siguiente diagrama

   1 + 5 = 6
             \
              ==> 14
             /       \
   5 + 3 = 8          ==> 29
             \       /
              ==> 15
             /
   3 + 4 = 7

1 + 5 = 6

==> 14

/ \

5 + 3 = 8 ==> 29

\ /

==> 15

3 + 4 = 7

Definir la función

   sumaReiterada :: Num a => [a] -> a

1	sumaReiterada :: Num a => [a] -> a

tal que (sumaReiterada xs) es la suma reiterada de los elementos consecutivos de la lista no vacía xs. Por ejemplo,

   sumaReiterada [1,5,3]    ==  14
   sumaReiterada [1,5,3,4]  ==  29

1 2	sumaReiterada [1,5,3] == 14 sumaReiterada [1,5,3,4] == 29

Soluciones

import Test.QuickCheck

import Test.QuickCheck

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

sumaReiterada1 :: Num a => [a] -> a
sumaReiterada1 [x] = x
sumaReiterada1 xs  = sumaReiterada1 [x+y | (x,y) <- consecutivos xs]

-- (consecutivos xs) es la lista de pares de elementos consecutivos de
-- xs. Por ejemplo,
--    consecutivos [1,5,3,4]  ==  [(1,5),(5,3),(3,4)]
consecutivos :: [a] -> [(a,a)]
consecutivos xs = zip xs (tail xs)

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

sumaReiterada2 :: Num a => [a] -> a
sumaReiterada2 [x] = x
sumaReiterada2 xs  = sumaReiterada2 (sumaConsecutivos xs)

-- (sumaConsecutivos xs) es la suma de los de pares de elementos
-- consecutivos de xs. Por ejemplo,
--    sumaConsecutivos [1,5,3,4]   ==  [6,8,7]
sumaConsecutivos :: Num a => [a] -> [a]
sumaConsecutivos xs = zipWith (+) xs (tail xs)

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

sumaReiterada3 :: Num a => [a] -> a
sumaReiterada3 [x] = x
sumaReiterada3 xs  = sumaReiterada3 (zipWith (+) xs (tail xs))

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

sumaReiterada4 :: Num a => [a] -> a
sumaReiterada4 [x]    = x
sumaReiterada4 (x:xs) = sumaReiterada4 (zipWith (+) (x:xs) xs)

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

sumaReiterada5 :: Num a => [a] -> a
sumaReiterada5 [x]       = x
sumaReiterada5 xs@(_:ys) = sumaReiterada5 (zipWith (+) xs ys)

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

sumaReiterada6 :: Num a => [a] -> a
sumaReiterada6 xs =
  head (head (dropWhile noEsUnitaria (iterate sumaConsecutivos xs)))

-- (noEsUnitaria xs) se verifica si la lista xs no tiene sólo un
-- elemento. Por ejemplo,
--    noEsUnitaria []     ==  True
--    noEsUnitaria [7,5]  ==  True
--    noEsUnitaria [7]    ==  False
noEsUnitaria :: [a] -> Bool
noEsUnitaria [_] = False
noEsUnitaria _   = True

-- 7ª solución
-- ===========

sumaReiterada7 :: Num a => [a] -> a
sumaReiterada7 =
  head . head . dropWhile (not . null . tail) . iterate sumaConsecutivos

-- 8ª solución
-- ===========

sumaReiterada8 :: Num a => [a] -> a
sumaReiterada8 =
  head . head . dropWhile (not . null . tail) . iterate (zipWith (+) =<< tail)

-- 9ª solución
-- ===========

sumaReiterada9 :: Num a => [a] -> a
sumaReiterada9 = head . until ((==1) . length) (zipWith (+) <*> tail)

-- 10ª solución
-- ===========

sumaReiterada10 :: Num a => [a] -> a
sumaReiterada10 xs =
  sum (zipWith (*) xs (map fromIntegral (pascal !! (length xs - 1))))

-- pascal es la lista de las filas del triángulo de Pascal. Por ejemplo,
--    λ> take 7 pascal
--    [[1],[1,1],[1,2,1],[1,3,3,1],[1,4,6,4,1],[1,5,10,10,5,1],[1,6,15,20,15,6,1]]
pascal :: [[Integer]]
pascal = [1] : map f pascal
  where f xs = zipWith (+) (0:xs) (xs++[0])

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_sumaReiterada :: [Integer] -> Property
prop_sumaReiterada xs =
  not (null xs) ==>
  all (== (sumaReiterada1 xs))
      [f xs | f <- [sumaReiterada2,
                    sumaReiterada3,
                    sumaReiterada4,
                    sumaReiterada5,
                    sumaReiterada6,
                    sumaReiterada7,
                    sumaReiterada8,
                    sumaReiterada9,
                    sumaReiterada10 ]]

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

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

-- La comparación es
--    λ> length (show (sumaReiterada1 [1..4000]))
--    1208
--    (4.84 secs, 4,444,754,000 bytes)
--    λ> length (show (sumaReiterada2 [1..4000]))
--    1208
--    (3.07 secs, 3,332,858,616 bytes)
--    λ> length (show (sumaReiterada3 [1..4000]))
--    1208
--    (3.04 secs, 3,270,112,112 bytes)
--    λ> length (show (sumaReiterada4 [1..4000]))
--    1208
--    (3.05 secs, 3,332,857,768 bytes)
--    λ> length (show (sumaReiterada5 [1..4000]))
--    1208
--    (3.08 secs, 3,332,570,672 bytes)
--    λ> length (show (sumaReiterada6 [1..4000]))
--    1208
--    (3.03 secs, 3,270,469,704 bytes)
--    λ> length (show (sumaReiterada7 [1..4000]))
--    1208
--    (3.03 secs, 3,270,598,416 bytes)
--    λ> length (show (sumaReiterada8 [1..4000]))
--    1208
--    (3.14 secs, 3,202,183,352 bytes)
--    λ> length (show (sumaReiterada9 [1..4000]))
--    1208
--    (3.71 secs, 2,869,137,232 bytes)
--    λ> length (show (sumaReiterada10 [1..4000]))
--    1208
--    (6.48 secs, 4,621,303,752 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

import Test.QuickCheck

-- 1ª solución

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

sumaReiterada1 :: Num a => [a] -> a

sumaReiterada1 [x] = x

sumaReiterada1 xs = sumaReiterada1 [x+y | (x,y) <- consecutivos xs]

-- (consecutivos xs) es la lista de pares de elementos consecutivos de

-- xs. Por ejemplo,

-- consecutivos [1,5,3,4] == [(1,5),(5,3),(3,4)]

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

consecutivos xs = zip xs (tail xs)

-- 2ª solución

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

sumaReiterada2 :: Num a => [a] -> a

sumaReiterada2 [x] = x

sumaReiterada2 xs = sumaReiterada2 (sumaConsecutivos xs)

-- (sumaConsecutivos xs) es la suma de los de pares de elementos

-- consecutivos de xs. Por ejemplo,

-- sumaConsecutivos [1,5,3,4] == [6,8,7]

sumaConsecutivos :: Num a => [a] -> [a]

sumaConsecutivos xs = zipWith (+) xs (tail xs)

-- 3ª solución

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

sumaReiterada3 :: Num a => [a] -> a

sumaReiterada3 [x] = x

sumaReiterada3 xs = sumaReiterada3 (zipWith (+) xs (tail xs))

-- 4ª solución

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

sumaReiterada4 :: Num a => [a] -> a

sumaReiterada4 [x] = x

sumaReiterada4 (x:xs) = sumaReiterada4 (zipWith (+) (x:xs) xs)

-- 5ª solución

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

sumaReiterada5 :: Num a => [a] -> a

sumaReiterada5 [x] = x

sumaReiterada5 xs@(_:ys) = sumaReiterada5 (zipWith (+) xs ys)

-- 6ª solución

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

sumaReiterada6 :: Num a => [a] -> a

sumaReiterada6 xs =

head (head (dropWhile noEsUnitaria (iterate sumaConsecutivos xs)))

-- (noEsUnitaria xs) se verifica si la lista xs no tiene sólo un

-- elemento. Por ejemplo,

-- noEsUnitaria [] == True

-- noEsUnitaria [7,5] == True

-- noEsUnitaria [7] == False

noEsUnitaria :: [a] -> Bool

noEsUnitaria [_] = False

noEsUnitaria _ = True

-- 7ª solución

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

sumaReiterada7 :: Num a => [a] -> a

sumaReiterada7 =

head . head . dropWhile (not . null . tail) . iterate sumaConsecutivos

-- 8ª solución

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

sumaReiterada8 :: Num a => [a] -> a

sumaReiterada8 =

head . head . dropWhile (not . null . tail) . iterate (zipWith (+) =<< tail)

-- 9ª solución

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

sumaReiterada9 :: Num a => [a] -> a

sumaReiterada9 = head . until ((==1) . length) (zipWith (+) <*> tail)

-- 10ª solución

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

sumaReiterada10 :: Num a => [a] -> a

sumaReiterada10 xs =

sum (zipWith (*) xs (map fromIntegral (pascal !! (length xs - 1))))

-- pascal es la lista de las filas del triángulo de Pascal. Por ejemplo,

-- λ> take 7 pascal

-- [[1],[1,1],[1,2,1],[1,3,3,1],[1,4,6,4,1],[1,5,10,10,5,1],[1,6,15,20,15,6,1]]

pascal :: [[Integer]]

pascal = [1] : map f pascal

where f xs = zipWith (+) (0:xs) (xs++[0])

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_sumaReiterada :: [Integer] -> Property

prop_sumaReiterada xs =

not (null xs) ==>

all (== (sumaReiterada1 xs))

[f xs | f <- [sumaReiterada2,

sumaReiterada3,

sumaReiterada4,

sumaReiterada5,

sumaReiterada6,

sumaReiterada7,

sumaReiterada8,

sumaReiterada9,

sumaReiterada10 ]]

-- La comprobación es

-- λ> quickCheck prop_sumaReiterada

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (show (sumaReiterada1 [1..4000]))

-- 1208

-- (4.84 secs, 4,444,754,000 bytes)

-- λ> length (show (sumaReiterada2 [1..4000]))

-- 1208

-- (3.07 secs, 3,332,858,616 bytes)

-- λ> length (show (sumaReiterada3 [1..4000]))

-- 1208

-- (3.04 secs, 3,270,112,112 bytes)

-- λ> length (show (sumaReiterada4 [1..4000]))

-- 1208

-- (3.05 secs, 3,332,857,768 bytes)

-- λ> length (show (sumaReiterada5 [1..4000]))

-- 1208

-- (3.08 secs, 3,332,570,672 bytes)

-- λ> length (show (sumaReiterada6 [1..4000]))

-- 1208

-- (3.03 secs, 3,270,469,704 bytes)

-- λ> length (show (sumaReiterada7 [1..4000]))

-- 1208

-- (3.03 secs, 3,270,598,416 bytes)

-- λ> length (show (sumaReiterada8 [1..4000]))

-- 1208

-- (3.14 secs, 3,202,183,352 bytes)

-- λ> length (show (sumaReiterada9 [1..4000]))

-- 1208

-- (3.71 secs, 2,869,137,232 bytes)

-- λ> length (show (sumaReiterada10 [1..4000]))

-- 1208

-- (6.48 secs, 4,621,303,752 bytes)

El código se encuentra en GitHub.

Sistema factorádico de numeración

PorJosé A. Alonso 28-enero-202215-abril-2022

El sistema factorádico es un sistema numérico basado en factoriales en el que el n-ésimo dígito, empezando desde la derecha, debe ser multiplicado por n! Por ejemplo, el número «341010» en el sistema factorádico es 463 en el sistema decimal ya que

   3×5! + 4×4! + 1×3! + 0×2! + 1×1! + 0×0! = 463

1	3×5! + 4×4! + 1×3! + 0×2! + 1×1! + 0×0! = 463

En este sistema numérico, el dígito de más a la derecha es siempre 0, el segundo 0 o 1, el tercero 0,1 o 2 y así sucesivamente.

Con los dígitos del 0 al 9 el mayor número que podemos codificar es el 10!-1 = 3628799. En cambio, si lo ampliamos con las letras A a Z podemos codificar hasta 36!-1 = 37199332678990121746799944815083519999999910.

Definir las funciones

   factoradicoAdecimal :: String -> Integer
   decimalAfactoradico :: Integer -> String

1 2	factoradicoAdecimal :: String -> Integer decimalAfactoradico :: Integer -> String

tales que

(factoradicoAdecimal cs) es el número decimal correspondiente al número factorádico cs. Por ejemplo,

     λ> decimalAfactoradico 463
     "341010"
     λ> decimalAfactoradico 2022
     "2441000"
     λ> decimalAfactoradico 36288000
     "A0000000000"
     λ> map decimalAfactoradico [1..10]
     ["10","100","110","200","210","1000","1010","1100","1110","1200"]
     λ> decimalAfactoradico 37199332678990121746799944815083519999999
     "3KXWVUTSRQPONMLKJIHGFEDCBA9876543210"

λ> decimalAfactoradico 463

"341010"

λ> decimalAfactoradico 2022

"2441000"

λ> decimalAfactoradico 36288000

"A0000000000"

λ> map decimalAfactoradico [1..10]

["10","100","110","200","210","1000","1010","1100","1110","1200"]

λ> decimalAfactoradico 37199332678990121746799944815083519999999

"3KXWVUTSRQPONMLKJIHGFEDCBA9876543210"

(decimalAfactoradico n) es el número factorádico correpondiente al número decimal n. Por ejemplo,

     λ> factoradicoAdecimal "341010"
     463
     λ> factoradicoAdecimal "2441000"
     2022
     λ> factoradicoAdecimal "A0000000000"
     36288000
     λ> map factoradicoAdecimal ["10","100","110","200","210","1000","1010","1100","1110","1200"]
     [1,2,3,4,5,6,7,8,9,10]
     λ> factoradicoAdecimal "3KXWVUTSRQPONMLKJIHGFEDCBA9876543210"
     37199332678990121746799944815083519999999

λ> factoradicoAdecimal "341010"

463

λ> factoradicoAdecimal "2441000"

2022

λ> factoradicoAdecimal "A0000000000"

36288000

λ> map factoradicoAdecimal ["10","100","110","200","210","1000","1010","1100","1110","1200"]

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

λ> factoradicoAdecimal "3KXWVUTSRQPONMLKJIHGFEDCBA9876543210"

37199332678990121746799944815083519999999

Comprobar con QuickCheck que, para cualquier entero positivo n,

   factoradicoAdecimal (decimalAfactoradico n) == n

1	factoradicoAdecimal (decimalAfactoradico n) == n

Soluciones

{-# LANGUAGE TupleSections #-}

import Data.List (genericIndex, genericLength)
import qualified Data.Map as M
import Test.QuickCheck
import Test.Hspec

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

factoradicoAdecimal1 :: String -> Integer
factoradicoAdecimal1 cs = sum (zipWith (*) xs ys)
  where xs = map caracterAentero cs
        n  = length cs
        ys = reverse (take n facts)

-- (caracterAentero c) es la posición del carácter c en la lista de
-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,
--    caracterAentero '0'  ==  0
--    caracterAentero '1'  ==  1
--    caracterAentero '9'  ==  9
--    caracterAentero 'A'  ==  10
--    caracterAentero 'B'  ==  11
--    caracterAentero 'Z'  ==  35
caracterAentero :: Char -> Integer
caracterAentero c =
  head [n | (n,x) <- zip [0..] caracteres, x == c]

-- caracteres es la lista de caracteres
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']
caracteres :: String
caracteres = ['0'..'9'] ++ ['A'..'Z']

-- facts es la lista de los factoriales. Por ejemplo,
--    λ> take 12 facts
--    [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]
facts :: [Integer]
facts = scanl (*) 1 [1..]

decimalAfactoradico1 :: Integer -> String
decimalAfactoradico1 n = aux n (reverse (takeWhile (<=n) facts))
  where aux 0 xs     = ['0' | _ <- xs]
        aux m (x:xs) = enteroAcaracter (m `div` x) : aux (m `mod` x) xs

-- (enteroAcaracter k) es el k-ésimo elemento de la lista
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,
--    enteroAcaracter 0   ==  '0'
--    enteroAcaracter 1   ==  '1'
--    enteroAcaracter 9   ==  '9'
--    enteroAcaracter 10  ==  'A'
--    enteroAcaracter 11  ==  'B'
--    enteroAcaracter 35  ==  'Z'
enteroAcaracter :: Integer -> Char
enteroAcaracter k = caracteres `genericIndex` k

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

factoradicoAdecimal2 :: String -> Integer
factoradicoAdecimal2 cs = sum (zipWith (*) xs ys)
    where xs = map caracterAentero2 cs
          n  = length cs
          ys = reverse (take n facts)

-- (caracterAentero2 c) es la posición del carácter c en la lista de
-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,
--    caracterAentero2 '0'  ==  0
--    caracterAentero2 '1'  ==  1
--    caracterAentero2 '9'  ==  9
--    caracterAentero2 'A'  ==  10
--    caracterAentero2 'B'  ==  11
--    caracterAentero2 'Z'  ==  35
caracterAentero2 :: Char -> Integer
caracterAentero2 c = caracteresEnteros M.! c

-- caracteresEnteros es el diccionario cuyas claves son los caracteres y
-- las claves son los números de 0 a 35.
caracteresEnteros :: M.Map Char Integer
caracteresEnteros = M.fromList (zip (['0'..'9'] ++ ['A'..'Z']) [0..])

decimalAfactoradico2 :: Integer -> String
decimalAfactoradico2 n = aux n (reverse (takeWhile (<=n) facts))
    where aux 0 xs     = ['0' | _ <- xs]
          aux m (x:xs) = enteroAcaracter2 (m `div` x) : aux (m `mod` x) xs

-- (enteroAcaracter2 k) es el k-ésimo elemento de la lista
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,
--    enteroAcaracter2 0   ==  '0'
--    enteroAcaracter2 1   ==  '1'
--    enteroAcaracter2 9   ==  '9'
--    enteroAcaracter2 10  ==  'A'
--    enteroAcaracter2 11  ==  'B'
--    enteroAcaracter2 35  ==  'Z'
enteroAcaracter2 :: Integer -> Char
enteroAcaracter2 k = enterosCaracteres M.! k

-- enterosCaracteres es el diccionario cuyas claves son los número de 0
-- a 35 y las claves son los caracteres.
enterosCaracteres :: M.Map Integer Char
enterosCaracteres = M.fromList (zip [0..] caracteres)

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

factoradicoAdecimal3 :: String -> Integer
factoradicoAdecimal3 cs =
  sum (zipWith (*) facts (reverse (map caracterAentero3 cs)))

-- (caracterAentero3 c) es la posición del carácter c en la lista de
-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,
--    caracterAentero3 '0'  ==  0
--    caracterAentero3 '1'  ==  1
--    caracterAentero3 '9'  ==  9
--    caracterAentero3 'A'  ==  10
--    caracterAentero3 'B'  ==  11
--    caracterAentero3 'Z'  ==  35
caracterAentero3 :: Char -> Integer
caracterAentero3 c =
  genericLength (takeWhile (/= c) caracteres)

decimalAfactoradico3 :: Integer -> String
decimalAfactoradico3 n = aux "" 2 (n, 0)
  where aux s _ (0, 0) = s
        aux s n (d, r) = aux (enteroAcaracter3 r: s) (n + 1) (d `divMod` n)

-- (enteroAcaracter3 k) es el k-ésimo elemento de la lista
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,
--    enteroAcaracter3 0   ==  '0'
--    enteroAcaracter3 1   ==  '1'
--    enteroAcaracter3 9   ==  '9'
--    enteroAcaracter3 10  ==  'A'
--    enteroAcaracter3 11  ==  'B'
--    enteroAcaracter3 35  ==  'Z'
enteroAcaracter3 :: Integer -> Char
enteroAcaracter3 n =
  caracteres !! (fromInteger n)

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

factoradicoAdecimal4 :: String -> Integer
factoradicoAdecimal4 =
  sum . zipWith (*) facts . reverse . map caracterAentero4

-- (caracterAentero4 c) es la posición del carácter c en la lista de
-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,
--    caracterAentero4 '0'  ==  0
--    caracterAentero4 '1'  ==  1
--    caracterAentero4 '9'  ==  9
--    caracterAentero4 'A'  ==  10
--    caracterAentero4 'B'  ==  11
--    caracterAentero4 'Z'  ==  35
caracterAentero4 :: Char -> Integer
caracterAentero4 =
  genericLength . flip takeWhile caracteres . (/=)

decimalAfactoradico4 :: Integer -> String
decimalAfactoradico4 = f "" 2 . (, 0)
  where f s _ (0, 0) = s
        f s n (d, r) = f (enteroAcaracter4 r: s) (n + 1) (d `divMod` n)

-- (enteroAcaracter4 k) es el k-ésimo elemento de la lista
-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,
--    enteroAcaracter4 0   ==  '0'
--    enteroAcaracter4 1   ==  '1'
--    enteroAcaracter4 9   ==  '9'
--    enteroAcaracter4 10  ==  'A'
--    enteroAcaracter4 11  ==  'B'
--    enteroAcaracter4 35  ==  'Z'
enteroAcaracter4 :: Integer -> Char
enteroAcaracter4 = (caracteres `genericIndex`)

-- Propiedad de inverso
-- ====================

prop_factoradico :: Integer -> Property
prop_factoradico n =
  n >= 0 ==>
  factoradicoAdecimal1 (decimalAfactoradico1 n) == n &&
  factoradicoAdecimal2 (decimalAfactoradico2 n) == n &&
  factoradicoAdecimal3 (decimalAfactoradico3 n) == n &&
  factoradicoAdecimal4 (decimalAfactoradico4 n) == n

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

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

-- La comparación es
--    λ> length (decimalAfactoradico1 (10^300000))
--    68191
--    (2.46 secs, 9,088,634,744 bytes)
--    λ> length (decimalAfactoradico2 (10^300000))
--    68191
--    (2.36 secs, 9,088,634,800 bytes)
--    λ> length (decimalAfactoradico3 (10^300000))
--    68191
--    (2.18 secs, 4,490,856,416 bytes)
--    λ> length (decimalAfactoradico4 (10^300000))
--    68191
--    (1.98 secs, 4,490,311,536 bytes)
--
--    λ> length (show (factoradicoAdecimal1 (show (10^50000))))
--    213237
--    (0.93 secs, 2,654,156,680 bytes)
--    λ> length (show (factoradicoAdecimal2 (show (10^50000))))
--    213237
--    (0.51 secs, 2,633,367,168 bytes)
--    λ> length (show (factoradicoAdecimal3 (show (10^50000))))
--    213237
--    (0.93 secs, 2,635,792,192 bytes)
--    λ> length (show (factoradicoAdecimal4 (show (10^50000))))
--    213237
--    (0.43 secs, 2,636,996,848 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

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

{-# LANGUAGE TupleSections #-}

import Data.List (genericIndex, genericLength)

import qualified Data.Map as M

import Test.QuickCheck

import Test.Hspec

-- 1ª solución

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

factoradicoAdecimal1 :: String -> Integer

factoradicoAdecimal1 cs = sum (zipWith (*) xs ys)

where xs = map caracterAentero cs

n = length cs

ys = reverse (take n facts)

-- (caracterAentero c) es la posición del carácter c en la lista de

-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,

-- caracterAentero '0' == 0

-- caracterAentero '1' == 1

-- caracterAentero '9' == 9

-- caracterAentero 'A' == 10

-- caracterAentero 'B' == 11

-- caracterAentero 'Z' == 35

caracterAentero :: Char -> Integer

caracterAentero c =

head [n | (n,x) <- zip [0..] caracteres, x == c]

-- caracteres es la lista de caracteres

-- ['0', '1',..., '9', 'A', 'B',..., 'Z']

caracteres :: String

caracteres = ['0'..'9'] ++ ['A'..'Z']

-- facts es la lista de los factoriales. Por ejemplo,

-- λ> take 12 facts

-- [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800]

facts :: [Integer]

facts = scanl (*) 1 [1..]

decimalAfactoradico1 :: Integer -> String

decimalAfactoradico1 n = aux n (reverse (takeWhile (<=n) facts))

where aux 0 xs = ['0' | _ <- xs]

aux m (x:xs) = enteroAcaracter (m `div` x) : aux (m `mod` x) xs

-- (enteroAcaracter k) es el k-ésimo elemento de la lista

-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,

-- enteroAcaracter 0 == '0'

-- enteroAcaracter 1 == '1'

-- enteroAcaracter 9 == '9'

-- enteroAcaracter 10 == 'A'

-- enteroAcaracter 11 == 'B'

-- enteroAcaracter 35 == 'Z'

enteroAcaracter :: Integer -> Char

enteroAcaracter k = caracteres `genericIndex` k

-- 2ª solución

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

factoradicoAdecimal2 :: String -> Integer

factoradicoAdecimal2 cs = sum (zipWith (*) xs ys)

where xs = map caracterAentero2 cs

n = length cs

ys = reverse (take n facts)

-- (caracterAentero2 c) es la posición del carácter c en la lista de

-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,

-- caracterAentero2 '0' == 0

-- caracterAentero2 '1' == 1

-- caracterAentero2 '9' == 9

-- caracterAentero2 'A' == 10

-- caracterAentero2 'B' == 11

-- caracterAentero2 'Z' == 35

caracterAentero2 :: Char -> Integer

caracterAentero2 c = caracteresEnteros M.! c

-- caracteresEnteros es el diccionario cuyas claves son los caracteres y

-- las claves son los números de 0 a 35.

caracteresEnteros :: M.Map Char Integer

caracteresEnteros = M.fromList (zip (['0'..'9'] ++ ['A'..'Z']) [0..])

decimalAfactoradico2 :: Integer -> String

decimalAfactoradico2 n = aux n (reverse (takeWhile (<=n) facts))

where aux 0 xs = ['0' | _ <- xs]

aux m (x:xs) = enteroAcaracter2 (m `div` x) : aux (m `mod` x) xs

-- (enteroAcaracter2 k) es el k-ésimo elemento de la lista

-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,

-- enteroAcaracter2 0 == '0'

-- enteroAcaracter2 1 == '1'

-- enteroAcaracter2 9 == '9'

-- enteroAcaracter2 10 == 'A'

-- enteroAcaracter2 11 == 'B'

-- enteroAcaracter2 35 == 'Z'

enteroAcaracter2 :: Integer -> Char

enteroAcaracter2 k = enterosCaracteres M.! k

-- enterosCaracteres es el diccionario cuyas claves son los número de 0

-- a 35 y las claves son los caracteres.

enterosCaracteres :: M.Map Integer Char

enterosCaracteres = M.fromList (zip [0..] caracteres)

-- 3ª solución

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

factoradicoAdecimal3 :: String -> Integer

factoradicoAdecimal3 cs =

sum (zipWith (*) facts (reverse (map caracterAentero3 cs)))

-- (caracterAentero3 c) es la posición del carácter c en la lista de

-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,

-- caracterAentero3 '0' == 0

-- caracterAentero3 '1' == 1

-- caracterAentero3 '9' == 9

-- caracterAentero3 'A' == 10

-- caracterAentero3 'B' == 11

-- caracterAentero3 'Z' == 35

caracterAentero3 :: Char -> Integer

caracterAentero3 c =

genericLength (takeWhile (/= c) caracteres)

decimalAfactoradico3 :: Integer -> String

decimalAfactoradico3 n = aux "" 2 (n, 0)

where aux s _ (0, 0) = s

aux s n (d, r) = aux (enteroAcaracter3 r: s) (n + 1) (d `divMod` n)

-- (enteroAcaracter3 k) es el k-ésimo elemento de la lista

-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,

-- enteroAcaracter3 0 == '0'

-- enteroAcaracter3 1 == '1'

-- enteroAcaracter3 9 == '9'

-- enteroAcaracter3 10 == 'A'

-- enteroAcaracter3 11 == 'B'

-- enteroAcaracter3 35 == 'Z'

enteroAcaracter3 :: Integer -> Char

enteroAcaracter3 n =

caracteres !! (fromInteger n)

-- 4ª solución

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

factoradicoAdecimal4 :: String -> Integer

factoradicoAdecimal4 =

sum . zipWith (*) facts . reverse . map caracterAentero4

-- (caracterAentero4 c) es la posición del carácter c en la lista de

-- caracteres ['0', '1',..., '9', 'A', 'B',..., 'Z']. Por ejemplo,

-- caracterAentero4 '0' == 0

-- caracterAentero4 '1' == 1

-- caracterAentero4 '9' == 9

-- caracterAentero4 'A' == 10

-- caracterAentero4 'B' == 11

-- caracterAentero4 'Z' == 35

caracterAentero4 :: Char -> Integer

caracterAentero4 =

genericLength . flip takeWhile caracteres . (/=)

decimalAfactoradico4 :: Integer -> String

decimalAfactoradico4 = f "" 2 . (, 0)

where f s _ (0, 0) = s

f s n (d, r) = f (enteroAcaracter4 r: s) (n + 1) (d `divMod` n)

-- (enteroAcaracter4 k) es el k-ésimo elemento de la lista

-- ['0', '1',..., '9', 'A', 'B',..., 'Z']. . Por ejemplo,

-- enteroAcaracter4 0 == '0'

-- enteroAcaracter4 1 == '1'

-- enteroAcaracter4 9 == '9'

-- enteroAcaracter4 10 == 'A'

-- enteroAcaracter4 11 == 'B'

-- enteroAcaracter4 35 == 'Z'

enteroAcaracter4 :: Integer -> Char

enteroAcaracter4 = (caracteres `genericIndex`)

-- Propiedad de inverso

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

prop_factoradico :: Integer -> Property

prop_factoradico n =

n >= 0 ==>

factoradicoAdecimal1 (decimalAfactoradico1 n) == n &&

factoradicoAdecimal2 (decimalAfactoradico2 n) == n &&

factoradicoAdecimal3 (decimalAfactoradico3 n) == n &&

factoradicoAdecimal4 (decimalAfactoradico4 n) == n

-- La comprobación es

-- λ> quickCheck prop_factoradico

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (decimalAfactoradico1 (10^300000))

-- 68191

-- (2.46 secs, 9,088,634,744 bytes)

-- λ> length (decimalAfactoradico2 (10^300000))

-- 68191

-- (2.36 secs, 9,088,634,800 bytes)

-- λ> length (decimalAfactoradico3 (10^300000))

-- 68191

-- (2.18 secs, 4,490,856,416 bytes)

-- λ> length (decimalAfactoradico4 (10^300000))

-- 68191

-- (1.98 secs, 4,490,311,536 bytes)

-- λ> length (show (factoradicoAdecimal1 (show (10^50000))))

-- 213237

-- (0.93 secs, 2,654,156,680 bytes)

-- λ> length (show (factoradicoAdecimal2 (show (10^50000))))

-- 213237

-- (0.51 secs, 2,633,367,168 bytes)

-- λ> length (show (factoradicoAdecimal3 (show (10^50000))))

-- 213237

-- (0.93 secs, 2,635,792,192 bytes)

-- λ> length (show (factoradicoAdecimal4 (show (10^50000))))

-- 213237

-- (0.43 secs, 2,636,996,848 bytes)

El código se encuentra en GitHub.

Operaciones con series de potencias

PorJosé A. Alonso 29-mayo-202025-marzo-2022

Una serie de potencias es una serie de la forma

   a₀ + a₁x + a₂x² + a₃x³ + ...

1	a₀ + a₁x + a₂x² + a₃x³ + ...

Las series de potencias se pueden representar mediante listas infinitas. Por ejemplo, la serie de la función exponencial es

   e^x = 1 + x + x²/2! + x³/3! + ...

1	e^x = 1 + x + x²/2! + x³/3! + ...

y se puede representar por [1, 1, 1/2, 1/6, 1/24, 1/120, …]

Las operaciones con series se pueden ver como una generalización de las de los polinomios.

En lo que sigue, usaremos el tipo (Serie a) para representar las series de potencias con coeficientes en a y su definición es

   type Serie a = [a]

1	type Serie a = [a]

Definir las siguientes funciones

   opuesta      :: Num a => Serie a -> Serie a
   suma         :: Num a => Serie a -> Serie a -> Serie a
   resta        :: Num a => Serie a -> Serie a -> Serie a
   producto     :: Num a => Serie a -> Serie a -> Serie a
   cociente     :: Fractional a => Serie a -> Serie a -> Serie a
   derivada     :: (Num a, Enum a) => Serie a -> Serie a
   integral     :: (Fractional a, Enum a) => Serie a -> Serie a
   expx         :: Serie Rational

opuesta :: Num a => Serie a -> Serie a

suma :: Num a => Serie a -> Serie a -> Serie a

resta :: Num a => Serie a -> Serie a -> Serie a

producto :: Num a => Serie a -> Serie a -> Serie a

cociente :: Fractional a => Serie a -> Serie a -> Serie a

derivada :: (Num a, Enum a) => Serie a -> Serie a

integral :: (Fractional a, Enum a) => Serie a -> Serie a

expx :: Serie Rational

tales que

(opuesta xs) es la opuesta de la serie xs. Por ejemplo,

     λ> take 7 (opuesta [-6,-4..])
     [6,4,2,0,-2,-4,-6]

1 2	λ> take 7 (opuesta [-6,-4..]) [6,4,2,0,-2,-4,-6]

(suma xs ys) es la suma de las series xs e ys. Por ejemplo,

     λ> take 7 (suma [1,3..] [2,4..])
     [3,7,11,15,19,23,27]

1 2	λ> take 7 (suma [1,3..] [2,4..]) [3,7,11,15,19,23,27]

(resta xs ys) es la resta de las series xs es ys. Por ejemplo,

     λ> take 7 (resta [3,5..] [2,4..])
     [1,1,1,1,1,1,1]
     λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])
     [2,4,6,8,10,12,14]

λ> take 7 (resta [3,5..] [2,4..])

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

λ> take 7 (resta ([3,7,11,15,19,23,27] ++ repeat 0) [1,3..])

[2,4,6,8,10,12,14]

(producto xs ys) es el producto de las series xs e ys. Por ejemplo,

     λ> take 7 (producto [3,5..] [2,4..])
     [6,22,52,100,170,266,392]

1 2	λ> take 7 (producto [3,5..] [2,4..]) [6,22,52,100,170,266,392]

(cociente xs ys) es el cociente de las series xs e ys. Por ejemplo,

     λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..])
     [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (cociente ([6,22,52,100,170,266,392] ++ repeat 0) [3,5..]) [2.0,4.0,6.0,8.0,10.0,12.0,14.0]

(derivada xs) es la derivada de la serie xs. Por ejemplo,

     λ> take 7 (derivada [2,4..])
     [4,12,24,40,60,84,112]

1 2	λ> take 7 (derivada [2,4..]) [4,12,24,40,60,84,112]

(integral xs) es la integral de la serie xs. Por ejemplo,

     λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0))
     [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

1 2	λ> take 7 (integral ([4,12,24,40,60,84,112] ++ repeat 0)) [0.0,4.0,6.0,8.0,10.0,12.0,14.0]

expx es la serie de la función exponencial. Por ejemplo,

     λ> take 8 expx
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (derivada expx)
     [1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]
     λ> take 8 (integral expx)
     [0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 expx

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (derivada expx)

[1 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

λ> take 8 (integral expx)

[0 % 1,1 % 1,1 % 2,1 % 6,1 % 24,1 % 120,1 % 720,1 % 5040]

Soluciones

type Serie a = [a] 

opuesta :: Num a => Serie a -> Serie a
opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a
suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a
resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a
producto (x:xs) zs@(y:ys) = 
    x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a
cociente (x:xs) (y:ys) = zs 
    where zs = x/y : map (/y) (resta xs (producto zs ys))  

derivada :: (Num a, Enum a) => Serie a -> Serie a
derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a
integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational
expx = map (1/) (map fromIntegral factoriales)

-- factoriales es la lista de los factoriales. Por ejemplo, 
--    take 7 factoriales  ==  [1,1,2,6,24,120,720]
factoriales :: [Integer]
factoriales = 1 : scanl1 (*) [1..]

type Serie a = [a]

opuesta :: Num a => Serie a -> Serie a

opuesta = map negate

suma :: Num a => Serie a -> Serie a -> Serie a

suma = zipWith (+)

resta :: Num a => Serie a -> Serie a -> Serie a

resta xs ys = suma xs (opuesta ys)

producto :: Num a => Serie a -> Serie a -> Serie a

producto (x:xs) zs@(y:ys) =

x*y : suma (producto xs zs) (map (x*) ys)

cociente :: Fractional a => Serie a -> Serie a -> Serie a

cociente (x:xs) (y:ys) = zs

where zs = x/y : map (/y) (resta xs (producto zs ys))

derivada :: (Num a, Enum a) => Serie a -> Serie a

derivada (_:xs) = zipWith (*) xs [1..]

integral :: (Fractional a, Enum a) => Serie a -> Serie a

integral xs = 0 : zipWith (/) xs [1..]

expx :: Serie Rational

expx = map (1/) (map fromIntegral factoriales)

-- factoriales es la lista de los factoriales. Por ejemplo,

-- take 7 factoriales == [1,1,2,6,24,120,720]

factoriales :: [Integer]

factoriales = 1 : scanl1 (*) [1..]

Las sucesiones de Loomis

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

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

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

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

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

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

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

Definir las siguientes funciones

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

sucLoomis :: Integer -> [Integer]

convergencia :: Integer -> Integer

graficaConvergencia :: [Integer] -> IO ()

tales que

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

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

λ> take 15 (sucLoomis 1)

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

λ> take 15 (sucLoomis 2)

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

λ> take 15 (sucLoomis 3)

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

λ> take 15 (sucLoomis 4)

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

λ> take 15 (sucLoomis 5)

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

λ> take 15 (sucLoomis 20)

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

λ> take 15 (sucLoomis 100)

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

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

235180736652

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

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

convergencia 2 == 2

convergencia 3 == 26

convergencia 4 == 4

convergencia 17 == 38

convergencia 19 == 102

convergencia 43 == 162

convergencia 27 == 202

convergencia 58 == 474

convergencia 63 == 150056

convergencia 81 == 150056

convergencia 89 == 150056

convergencia (10^12) == 1000101125092

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

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

Soluciones

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

sucLoomisDe1 :: [Integer]
sucLoomisDe1 = sucLoomis 1

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

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

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

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

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

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

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

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

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

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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

import Data.List ((\\))

import Data.Char (digitToInt)

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

-- 1ª definición de sucLoomis

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

sucLoomis :: Integer -> [Integer]

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

loomis :: Integer -> Integer -> Integer

loomis x 0 = x

loomis x n = y + productoDigitosNoNulos y

where y = loomis x (n-1)

productoDigitosNoNulos :: Integer -> Integer

productoDigitosNoNulos = product . digitosNoNulos

digitosNoNulos :: Integer -> [Integer]

digitosNoNulos x =

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

-- 2ª definición de sucLoomis

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

sucLoomis2 :: Integer -> [Integer]

sucLoomis2 = iterate siguienteLoomis

siguienteLoomis :: Integer -> Integer

siguienteLoomis y = y + productoDigitosNoNulos y

-- 3ª definición de sucLoomis

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

sucLoomis3 :: Integer -> [Integer]

sucLoomis3 =

iterate ((+) <*> product .

map (toInteger . digitToInt) .

filter (/= '0') . show)

-- Comparación de eficiencia

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

-- λ> sucLoomis 1 !! 30000

-- 6571272766

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

-- λ> sucLoomis2 1 !! 30000

-- 6571272766

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

-- λ> sucLoomis3 1 !! 30000

-- 6571272766

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

-- 1ª definición de convergencia

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

convergencia1 :: Integer -> Integer

convergencia1 x =

head (dropWhile noEnSucLoomisDe1 (sucLoomis x))

noEnSucLoomisDe1 :: Integer -> Bool

noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1)

sucLoomisDe1 :: [Integer]

sucLoomisDe1 = sucLoomis 1

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

pertenece x ys =

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

-- 2ª definición de convergencia

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

convergencia2 :: Integer -> Integer

convergencia2 = aux (sucLoomis3 1) . sucLoomis3

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

| x < y = aux xs bs

| otherwise = aux as ys

-- 3ª definición de convergencia

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

convergencia3 :: Integer -> Integer

convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3

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

-- e ys. Por ejemplo,

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

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

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

interseccion = aux

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

LT -> aux xs bs

EQ -> x : aux xs ys

GT -> aux as ys

aux _ _ = []

-- 4ª definición de convergencia

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

convergencia4 :: Integer -> Integer

convergencia4 x = perteneceA (sucLoomis3 x) 1

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

| otherwise = perteneceA ys c

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

-- Comparación de eficiencia

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

-- λ> convergencia1 (10^4)

-- 150056

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

-- λ> convergencia2 (10^4)

-- 150056

-- (0.03 secs, 700,240 bytes)

-- λ> convergencia3 (10^4)

-- 150056

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

-- λ> convergencia4 (10^4)

-- 150056

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

-- λ> convergencia2 (10^12)

-- 1000101125092

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

-- λ> convergencia3 (10^12)

-- 1000101125092

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

-- λ> convergencia4 (10^12)

-- 1000101125092

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

-- Definición de graficaConvergencia

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

graficaConvergencia :: [Integer] -> IO ()

graficaConvergencia xs =

plotList [ Key Nothing

, Title "Convergencia de sucesiones de Loomis"

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

, PNG "Las_sucesiones_de_Loomis_2.png"

]

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

Cálculo de pi mediante la serie de Nilakantha

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

Una serie infinita para el cálculo de pi, publicada por Nilakantha en el siglo XV, es

Definir las funciones

   aproximacionPi :: Int -> Double
   tabla          :: FilePath -> [Int] -> IO ()

1 2	aproximacionPi :: Int -> Double tabla :: FilePath -> [Int] -> IO ()

tales que

(aproximacionPi n) es la n-ésima aproximación de pi obtenido sumando los n primeros términos de la serie de Nilakantha. Por ejemplo,

     aproximacionPi 0        ==  3.0
     aproximacionPi 1        ==  3.1666666666666665
     aproximacionPi 2        ==  3.1333333333333333
     aproximacionPi 3        ==  3.145238095238095
     aproximacionPi 4        ==  3.1396825396825396
     aproximacionPi 5        ==  3.1427128427128426
     aproximacionPi 10       ==  3.1414067184965018
     aproximacionPi 100      ==  3.1415924109719824
     aproximacionPi 1000     ==  3.141592653340544
     aproximacionPi 10000    ==  3.141592653589538
     aproximacionPi 100000   ==  3.1415926535897865
     aproximacionPi 1000000  ==  3.141592653589787
     pi                      ==  3.141592653589793

aproximacionPi 0 == 3.0

aproximacionPi 1 == 3.1666666666666665

aproximacionPi 2 == 3.1333333333333333

aproximacionPi 3 == 3.145238095238095

aproximacionPi 4 == 3.1396825396825396

aproximacionPi 5 == 3.1427128427128426

aproximacionPi 10 == 3.1414067184965018

aproximacionPi 100 == 3.1415924109719824

aproximacionPi 1000 == 3.141592653340544

aproximacionPi 10000 == 3.141592653589538

aproximacionPi 100000 == 3.1415926535897865

aproximacionPi 1000000 == 3.141592653589787

pi == 3.141592653589793

(tabla f ns) escribe en el fichero f las n-ésimas aproximaciones de pi, donde n toma los valores de la lista ns, junto con sus errores. Por ejemplo, al evaluar la expresión

     tabla "AproximacionesPi.txt" [0,10..100]

1	tabla "AproximacionesPi.txt" [0,10..100]

hace que el contenido del fichero «AproximacionesPi.txt» sea

+------+----------------+----------------+
| n    | Aproximación   | Error          |
+------+----------------+----------------+
|    0 | 3.000000000000 | 0.141592653590 |
|   10 | 3.141406718497 | 0.000185935093 |
|   20 | 3.141565734659 | 0.000026918931 |
|   30 | 3.141584272675 | 0.000008380915 |
|   40 | 3.141589028941 | 0.000003624649 |
|   50 | 3.141590769850 | 0.000001883740 |
|   60 | 3.141591552546 | 0.000001101044 |
|   70 | 3.141591955265 | 0.000000698325 |
|   80 | 3.141592183260 | 0.000000470330 |
|   90 | 3.141592321886 | 0.000000331704 |
|  100 | 3.141592410972 | 0.000000242618 |
+------+----------------+----------------+

+------+----------------+----------------+

| n | Aproximación | Error |

+------+----------------+----------------+

| 0 | 3.000000000000 | 0.141592653590 |

| 10 | 3.141406718497 | 0.000185935093 |

| 20 | 3.141565734659 | 0.000026918931 |

| 30 | 3.141584272675 | 0.000008380915 |

| 40 | 3.141589028941 | 0.000003624649 |

| 50 | 3.141590769850 | 0.000001883740 |

| 60 | 3.141591552546 | 0.000001101044 |

| 70 | 3.141591955265 | 0.000000698325 |

| 80 | 3.141592183260 | 0.000000470330 |

| 90 | 3.141592321886 | 0.000000331704 |

| 100 | 3.141592410972 | 0.000000242618 |

+------+----------------+----------------+

al evaluar la expresión

     tabla "AproximacionesPi.txt" [0,500..5000]

1	tabla "AproximacionesPi.txt" [0,500..5000]

hace que el contenido del fichero «AproximacionesPi.txt» sea

+------+----------------+----------------+
| n    | Aproximación   | Error          |
+------+----------------+----------------+
|    0 | 3.000000000000 | 0.141592653590 |
|  500 | 3.141592651602 | 0.000000001988 |
| 1000 | 3.141592653341 | 0.000000000249 |
| 1500 | 3.141592653516 | 0.000000000074 |
| 2000 | 3.141592653559 | 0.000000000031 |
| 2500 | 3.141592653574 | 0.000000000016 |
| 3000 | 3.141592653581 | 0.000000000009 |
| 3500 | 3.141592653584 | 0.000000000006 |
| 4000 | 3.141592653586 | 0.000000000004 |
| 4500 | 3.141592653587 | 0.000000000003 |
| 5000 | 3.141592653588 | 0.000000000002 |
+------+----------------+----------------+

+------+----------------+----------------+

| n | Aproximación | Error |

+------+----------------+----------------+

| 0 | 3.000000000000 | 0.141592653590 |

| 500 | 3.141592651602 | 0.000000001988 |

| 1000 | 3.141592653341 | 0.000000000249 |

| 1500 | 3.141592653516 | 0.000000000074 |

| 2000 | 3.141592653559 | 0.000000000031 |

| 2500 | 3.141592653574 | 0.000000000016 |

| 3000 | 3.141592653581 | 0.000000000009 |

| 3500 | 3.141592653584 | 0.000000000006 |

| 4000 | 3.141592653586 | 0.000000000004 |

| 4500 | 3.141592653587 | 0.000000000003 |

| 5000 | 3.141592653588 | 0.000000000002 |

+------+----------------+----------------+

Soluciones

import Text.Printf

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

aproximacionPi :: Int -> Double
aproximacionPi n = serieNilakantha !! n

serieNilakantha :: [Double]
serieNilakantha = scanl1 (+) terminosNilakantha

terminosNilakantha :: [Double]
terminosNilakantha = zipWith (/) numeradores denominadores
  where numeradores   = 3 : cycle [4,-4]
        denominadores = 1 : [n*(n+1)*(n+2) | n <- [2,4..]]

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

aproximacionPi2 :: Int -> Double
aproximacionPi2 = aux 3 2 1
  where aux x _ _ 0 = x
        aux x y z m =
          aux (x+4/product[y..y+2]*z) (y+2) (negate z) (m-1)

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

--    λ> aproximacionPi (2*10^5)
--    3.141592653589787
--    (0.82 secs, 145,964,728 bytes)
--    λ> aproximacionPi2 (2*10^5)
--    3.141592653589787
--    (2.27 secs, 432,463,496 bytes)
--    λ> aproximacionPi (3*10^5)
--    3.141592653589787
--    (0.34 secs, 73,056,488 bytes)
--    λ> aproximacionPi2 (3*10^5)
--    3.141592653589787
--    (3.24 secs, 648,603,824 bytes)

-- Definicioń de tabla
-- ===================

tabla :: FilePath -> [Int] -> IO ()
tabla f ns = do
  writeFile f (tablaAux ns)

tablaAux :: [Int] -> String
tablaAux ns =
     linea
  ++ cabecera
  ++ linea
  ++ concat [printf "| %4d | %.12f | %.12f |\n" n a e
            | n <- ns
            , let a = aproximacionPi n
            , let e = abs (pi - a)]
  ++ linea

linea :: String
linea = "+------+----------------+----------------+\n"

cabecera :: String
cabecera = "| n    | Aproximación   | Error          |\n"

import Text.Printf

-- 1ª solución

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

aproximacionPi :: Int -> Double

aproximacionPi n = serieNilakantha !! n

serieNilakantha :: [Double]

serieNilakantha = scanl1 (+) terminosNilakantha

terminosNilakantha :: [Double]

terminosNilakantha = zipWith (/) numeradores denominadores

where numeradores = 3 : cycle [4,-4]

denominadores = 1 : [n*(n+1)*(n+2) | n <- [2,4..]]

-- 2ª solución

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

aproximacionPi2 :: Int -> Double

aproximacionPi2 = aux 3 2 1

where aux x _ _ 0 = x

aux x y z m =

aux (x+4/product[y..y+2]*z) (y+2) (negate z) (m-1)

-- Comparación de eficiencia

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

-- λ> aproximacionPi (2*10^5)

-- 3.141592653589787

-- (0.82 secs, 145,964,728 bytes)

-- λ> aproximacionPi2 (2*10^5)

-- 3.141592653589787

-- (2.27 secs, 432,463,496 bytes)

-- λ> aproximacionPi (3*10^5)

-- 3.141592653589787

-- (0.34 secs, 73,056,488 bytes)

-- λ> aproximacionPi2 (3*10^5)

-- 3.141592653589787

-- (3.24 secs, 648,603,824 bytes)

-- Definicioń de tabla

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

tabla :: FilePath -> [Int] -> IO ()

tabla f ns = do

writeFile f (tablaAux ns)

tablaAux :: [Int] -> String

tablaAux ns =

linea

++ cabecera

++ linea

++ concat [printf "| %4d | %.12f | %.12f |\n" n a e

| n <- ns

, let a = aproximacionPi n

, let e = abs (pi - a)]

++ linea

linea :: String

linea = "+------+----------------+----------------+\n"

cabecera :: String

cabecera = "| n | Aproximación | Error |\n"

Producto de Fibonaccis consecutivos

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

Los números de Fibonacci son los números F(n) de la siguiente sucesión

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

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

que comienza con 0 y 1 y los siguientes términos son las sumas de los dos anteriores.

Un número x es el producto de dos números de Fibonacci consecutivos si existe un n tal que

   F(n) * F(n+1) = x

1	F(n) * F(n+1) = x

y su prueba es (F(n),F(n+1),True). Por ejemplo, 714 es el producto de dos números de Fibonacci consecutivos ya que

F(8) = 21, F(9) = 34 y 714 = 21 * 34.

1	F(8) = 21, F(9) = 34 y 714 = 21 * 34.

Su prueba es (21, 34, True).

Un número x no es el producto de dos números de Fibonacci consecutivos si no existe un n tal que

   F(n) * F(n+1) = x

1	F(n) * F(n+1) = x

y su prueba es (F(m),F(m+1),False) donde m es el menor número tal que

   F(m) * F(m+1) > x

1	F(m) * F(m+1) > x

Por ejemplo, 800 no es el producto de dos números de Fibonacci consecutivos, ya que

 F(8) = 21, F(9) = 34, F(10) = 55 y 21 * 34 < 800 < 34 * 55.

1	F(8) = 21, F(9) = 34, F(10) = 55 y 21 * 34 < 800 < 34 * 55.

Su prueba es (34, 55, False),

Definir la función

   productoFib :: Integer -> (Integer, Integer, Bool)

1	productoFib :: Integer -> (Integer, Integer, Bool)

tal que (productoFib x) es la prueba de que es, o no es, el producto de dos números de Fibonacci consecutivos. Por ejemplo,

   productoFib 714  == (21,  34, True)
   productoFib 800  == (34,  55, False)
   productoFib 4895 == (55,  89, True)
   productoFib 5895 == (89, 144, False)

productoFib 714 == (21, 34, True)

productoFib 800 == (34, 55, False)

productoFib 4895 == (55, 89, True)

productoFib 5895 == (89, 144, False)

Soluciones

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

productoFib :: Integer -> (Integer, Integer, Bool)
productoFib n
  | c == n    = (a,b,True)
  | otherwise = (a,b,False)
  where (a,b,c) = head (dropWhile (\(x,y,z) -> z < n) productos) 

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

-- productos es la lista de las ternas (a,b,c) tales que a y b son dos
-- números de Fibonacci consecutivos y c es su producto. Por ejemplo,
--    λ> take 7 productos
--    [(0,1,0),(1,1,1),(1,2,2),(2,3,6),(3,5,15),(5,8,40),(8,13,104)]
productos :: [(Integer,Integer,Integer)]
productos = [(x,y,x*y) | (x,y) <- zip fibs (tail fibs)] 

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

productoFib2 :: Integer -> (Integer, Integer, Bool)
productoFib2 n = aux 0 1 n
  where
    aux a b c
        | a * b >= c = (a, b, a * b == c)
        | otherwise  = aux b (a + b) c
           
-- 3ª solución
-- ===========

productoFib3 :: Integer -> (Integer, Integer, Bool)
productoFib3 x = aux 0 1
  where
    aux a b | a * b >= x = (a, b, x == a * b)
            | otherwise  = aux b (a + b)

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

-- La comparación es
--    λ> let (x,_,_) = productoFib (10^20000) in length (show x)
--    10000
--    (1.15 secs, 323,396,360 bytes)
--    λ> let (x,_,_) = productoFib2 (10^20000) in length (show x)
--    10000
--    (1.10 secs, 317,268,672 bytes)
--    λ> let (x,_,_) = productoFib3 (10^20000) in length (show x)
--    10000
--    (1.08 secs, 314,972,440 bytes)

-- 1ª solución

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

productoFib :: Integer -> (Integer, Integer, Bool)

productoFib n

| c == n = (a,b,True)

| otherwise = (a,b,False)

where (a,b,c) = head (dropWhile (\(x,y,z) -> z < n) productos)

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

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

fibs :: [Integer]

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

-- productos es la lista de las ternas (a,b,c) tales que a y b son dos

-- números de Fibonacci consecutivos y c es su producto. Por ejemplo,

-- λ> take 7 productos

-- [(0,1,0),(1,1,1),(1,2,2),(2,3,6),(3,5,15),(5,8,40),(8,13,104)]

productos :: [(Integer,Integer,Integer)]

productos = [(x,y,x*y) | (x,y) <- zip fibs (tail fibs)]

-- 2ª solución

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

productoFib2 :: Integer -> (Integer, Integer, Bool)

productoFib2 n = aux 0 1 n

where

aux a b c

| a * b >= c = (a, b, a * b == c)

| otherwise = aux b (a + b) c

-- 3ª solución

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

productoFib3 :: Integer -> (Integer, Integer, Bool)

productoFib3 x = aux 0 1

where

aux a b | a * b >= x = (a, b, x == a * b)

| otherwise = aux b (a + b)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> let (x,_,_) = productoFib (10^20000) in length (show x)

-- 10000

-- (1.15 secs, 323,396,360 bytes)

-- λ> let (x,_,_) = productoFib2 (10^20000) in length (show x)

-- 10000

-- (1.10 secs, 317,268,672 bytes)

-- λ> let (x,_,_) = productoFib3 (10^20000) in length (show x)

-- 10000

-- (1.08 secs, 314,972,440 bytes)

Otras soluciones

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

Pensamiento

«El placer que obtenemos de la música proviene de contar, pero contando inconscientemente. La música no es más que aritmética inconsciente.»

Gottfried Wilhelm Leibniz.

Entre dos potencias sucesivas

PorJosé A. Alonso 3-febrero-202010-febrero-2020

Se dice que un número entero está entre potencias sucesivas de n si x-1 es una potencia n-ésima y x+1 es una potencia (n+1)-ésima; es decir, si existen a y b tales que x-1 es a^n y x+1 es b^(n+1). Por ejemplo,

 2 está entre potencias sucesivas de 0, ya que  1 =  1^0 y  3 = 3^1
15 está entre potencias sucesivas de 1, ya que 14 = 14^1 y 16 = 4^2
26 está entre potencias sucesivas de 2, ya que 25 =  5^2 y 27 = 3^3

2 está entre potencias sucesivas de 0, ya que 1 = 1^0 y 3 = 3^1

15 está entre potencias sucesivas de 1, ya que 14 = 14^1 y 16 = 4^2

26 está entre potencias sucesivas de 2, ya que 25 = 5^2 y 27 = 3^3

Definir las funciones

   entrePotencias :: Integer -> Integer -> Bool
   pares :: [(Integer,Integer)]
   paresEntrePotencias :: [(Integer,Integer)]

entrePotencias :: Integer -> Integer -> Bool

pares :: [(Integer,Integer)]

paresEntrePotencias :: [(Integer,Integer)]

tales que

(entrePotencias n x) se verifica si x está entre potencias sucesivas de n. Por ejemplo,

     entrePotencias 0 2   ==  True
     entrePotencias 1 15  ==  True
     entrePotencias 2 26  ==  True

entrePotencias 0 2 == True

entrePotencias 1 15 == True

entrePotencias 2 26 == True

pares es la lista de los números enteros ordenados por su suma y primer elemento. Por ejemplo,

     λ> take 11 pares
     [(0,0),(0,1),(1,0),(0,2),(1,1),(2,0),(0,3),(1,2),(2,1),(3,0),(0,4)]

1 2	λ> take 11 pares [(0,0),(0,1),(1,0),(0,2),(1,1),(2,0),(0,3),(1,2),(2,1),(3,0),(0,4)]

paresEntrePotencias es la lista de los pares (n,x) tales que x está entre potencias sucesivas de n. Por ejemplo,

     λ> take 10 paresEntrePotencias
     [(1,0),(0,2),(1,3),(1,8),(1,15),(1,24),(2,26),(1,35),(1,48),(1,63)]

1 2	λ> take 10 paresEntrePotencias [(1,0),(0,2),(1,3),(1,8),(1,15),(1,24),(2,26),(1,35),(1,48),(1,63)]

Comprobar con QuickCheck que 26 es el único número que está entre potencias sucesivas con exponentes mayor que 1; es decir, que el único par (n,x) tal que x está entre potencias sucesivas de n con n mayor que uno es el (2,26).

Nota: Este ejercicio ha sido propuesto por Rebeca Isabel González Gordillo y está basado en el artículo El número 26 … ¡un número especial! de Amadeo Artacho en MatematicasCercanas.

Soluciones

import Test.QuickCheck

entrePotencias :: Integer -> Integer -> Bool
entrePotencias n x = esPotencia n (x-1) && esPotencia (n+1) (x+1)

-- (esPotencia n x) se verifica si x es una potencia n-ésima. Por
-- ejemplo, 
--    esPotencia 3 27  ==  True
--    esPotencia 3 25  ==  False
esPotencia :: Integer -> Integer -> Bool
esPotencia n x = x == r^n
  where r = ceiling ((fromIntegral x)**(1/fromIntegral n))

pares :: [(Integer,Integer)]
pares = [(x,n-x) | n <- [0..], x <- [0..n]]

paresEntrePotencias :: [(Integer,Integer)]
paresEntrePotencias =
  [(n,x) | (n,x) <- pares
         , entrePotencias n x]

prop_entrePotencias :: Integer -> Integer -> Property
prop_entrePotencias n x =
  n > 1 ==> entrePotencias n x == ((n,x) == (2,26))

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

import Test.QuickCheck

entrePotencias :: Integer -> Integer -> Bool

entrePotencias n x = esPotencia n (x-1) && esPotencia (n+1) (x+1)

-- (esPotencia n x) se verifica si x es una potencia n-ésima. Por

-- ejemplo,

-- esPotencia 3 27 == True

-- esPotencia 3 25 == False

esPotencia :: Integer -> Integer -> Bool

esPotencia n x = x == r^n

where r = ceiling ((fromIntegral x)**(1/fromIntegral n))

pares :: [(Integer,Integer)]

pares = [(x,n-x) | n <- [0..], x <- [0..n]]

paresEntrePotencias :: [(Integer,Integer)]

paresEntrePotencias =

[(n,x) | (n,x) <- pares

, entrePotencias n x]

prop_entrePotencias :: Integer -> Integer -> Property

prop_entrePotencias n x =

n > 1 ==> entrePotencias n x == ((n,x) == (2,26))

-- La comprobación es

-- λ> quickCheck prop_entrePotencias

-- +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

«El verdadero objetivo de la ciencia es el honor de la mente humana.»

Carl Gustav Jacob Jacobi

Cocientes y restos de la transformación decimal

PorJosé A. Alonso 29-enero-20205-febrero-2020

La transformación de una fracción en un número decimal se realiza mediante una sucesión de divisiones. Por ejemplo, para transformar a decimal la fracción

   247813    |19980
  -19980     ---------------
  -------     12.40305305...
    48013
   -39960
   ------
     80530
    -79920
    ------
       6100
      -   0
      -----
       61000
      -59940
      ------
        10600
       -    0
       ------
        106000
       - 99900
       -------
          61000
          -59940
          ------
           10600
          -    0
          ------
          106000
         - 99900
         -------
           61000

247813 |19980

-19980 ---------------

------- 12.40305305...

48013

-39960

------

80530

-79920

------

6100

- 0

-----

61000

-59940

------

10600

- 0

------

106000

- 99900

-------

61000

-59940

------

10600

- 0

------

106000

- 99900

-------

61000

La transformación anterior se puede representar mediante la siguiente lista de cocientes y restos

   [(12,8053),(4,610),(0,6100),(3,1060),(0,10600),(5,6100),
                               (3,1060),(0,10600),(5,6100)]

1 2	[(12,8053),(4,610),(0,6100),(3,1060),(0,10600),(5,6100), (3,1060),(0,10600),(5,6100)]

Definir la función

   cocientesRestos :: (Integer,Integer) -> [(Integer,Integer)]

1	cocientesRestos :: (Integer,Integer) -> [(Integer,Integer)]

tal que (cocientesRestos (n,d)) es la lista de los cocientes y restos de la transformación decimal de la fracción n/d como se ha indicado anteriormente. Por ejemplo,

   λ> take 9 (cocientesRestos (247813,19980))
   [(12,8053),(4,610),(0,6100),(3,1060),(0,10600),(5,6100),
                               (3,1060),(0,10600),(5,6100)]
   λ> take 10 (cocientesRestos (6,2))
   [(3,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0)]
   λ> take 10 (cocientesRestos (1,2))
   [(0,1),(5,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0)]
   λ> take 10 (cocientesRestos (1,3))
   [(0,1),(3,1),(3,1),(3,1),(3,1),(3,1),(3,1),(3,1),(3,1),(3,1)]
   λ> take 10 (cocientesRestos (23,14))
   [(1,9),(6,6),(4,4),(2,12),(8,8),(5,10),(7,2),(1,6),(4,4),(2,12)]

λ> take 9 (cocientesRestos (247813,19980))

[(12,8053),(4,610),(0,6100),(3,1060),(0,10600),(5,6100),

(3,1060),(0,10600),(5,6100)]

λ> take 10 (cocientesRestos (6,2))

[(3,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0)]

λ> take 10 (cocientesRestos (1,2))

[(0,1),(5,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0),(0,0)]

λ> take 10 (cocientesRestos (1,3))

[(0,1),(3,1),(3,1),(3,1),(3,1),(3,1),(3,1),(3,1),(3,1),(3,1)]

λ> take 10 (cocientesRestos (23,14))

[(1,9),(6,6),(4,4),(2,12),(8,8),(5,10),(7,2),(1,6),(4,4),(2,12)]

Soluciones

cocientesRestos :: (Integer,Integer) -> [(Integer,Integer)]
cocientesRestos (n,d) =
  (q,r) : cocientesRestos (10*r, d)
  where (q,r) = quotRem n d

cocientesRestos :: (Integer,Integer) -> [(Integer,Integer)]

cocientesRestos (n,d) =

(q,r) : cocientesRestos (10*r, d)

where (q,r) = quotRem n d

Otras soluciones

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

Pensamiento

«Hay dos maneras de diseñar un software. Una forma es hacerlo tan simple que obviamente no haya deficiencias. Y la otra forma es hacerlo tan complicado que no haya deficiencias obvias.»

Tony Hoare.

Sucesiones sin progresiones aritméticas de longitud 3

PorJosé A. Alonso 21-enero-202025-marzo-2022

Tres números x, y, z está en progresión aritmética (PA) si existe un d tal que y = x+d y z = y+d. Por ejemplo, 1, 3, 5 están en PA ya que 3 = 1+2 y 5 = 3+2.

Se considera la sucesión donde cada uno de sus términos es el número natural tal que no está en PA con cualesquiera dos términos anteriores de la sucesión. Por ejemplo, si representamos por f(n) el n-ésimo término de la sucesión, entonces

f(0) = 0, que es el menor número natural;
f(1) = 1, que es el menor número natural que no está en la sucesión; 
f(2) = 3, ya que [0, 1, 2] están en PA y
                 [0, 1, 3] no están en PA;
f(3) = 4, ya que [0, 1, 4], [0, 3, 4] y [1, 3, 4] no están en PA;
f(4) = 9, ya que se descartan
          + el 5 porque [1, 3, 5] están en PA
          + el 6 porque [0, 3, 6] están en PA
          + el 7 porque [1, 4, 7] están en PA
          + el 8 porque [0, 4, 8] estan en PA
          y se acepta el 9 porque no están en PA niguna de [0,1,9],
          [0,3,9], [0,4,9], [1,3,9], [1,4,9], [3,4,9].

f(0) = 0, que es el menor número natural;

f(1) = 1, que es el menor número natural que no está en la sucesión;

f(2) = 3, ya que [0, 1, 2] están en PA y

[0, 1, 3] no están en PA;

f(3) = 4, ya que [0, 1, 4], [0, 3, 4] y [1, 3, 4] no están en PA;

f(4) = 9, ya que se descartan

+ el 5 porque [1, 3, 5] están en PA

+ el 6 porque [0, 3, 6] están en PA

+ el 7 porque [1, 4, 7] están en PA

+ el 8 porque [0, 4, 8] estan en PA

y se acepta el 9 porque no están en PA niguna de [0,1,9],

[0,3,9], [0,4,9], [1,3,9], [1,4,9], [3,4,9].

Definir la sucesión

   sucesionSin3enPA :: [Integer]

1	sucesionSin3enPA :: [Integer]

donde cada uno de sus términos es el menor número natural tal que no está en PA con cualesquiera dos términos anteriores de la sucesión. Por ejemplo,

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

λ> take 20 sucesionSin3enPA

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

λ> sucesionSin3enPA !! 250

3270

Soluciones

import Data.List ((\\), delete, tails)

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

sucesionSin3enPA :: [Integer]
sucesionSin3enPA = aux []  
  where aux xs = x : aux (x:xs)
          where x = head (noEnPAConDos xs)

noEnPAConDos :: [Integer] -> [Integer]
noEnPAConDos xs = [z | z <- [0..]
                   , z `notElem` xs
                   , and [z - y /= y - x | x <- xs
                                         , y <- dropWhile (<= x) xs]]

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

-- Si x, y, z están en progresión aritmética, entonces
--    y = (x + z) / 2
-- Por tanto,
--    z = 2 * y - x
--
-- Teniendo en cuenta la relación auterior se define (aux xs ys) tal que
-- xs es la lista de los términos actuales de la sucesión e ys es la
-- lista de los números que no están en PA con cualesquieras dos de xs.

sucesionSin3enPA2 :: [Integer]
sucesionSin3enPA2 = aux [] [0..] 
  where
    aux xs (y:ys) = y : aux (y:xs) (ys \\ [2 * y - x | x <- xs])

-- 3º solución
-- ===========

sucesionSin3enPA3 :: [Integer]
sucesionSin3enPA3 = 0 : aux [1]
  where aux (x:xs) = x : aux (xs ++ [3*x,3*x+1])


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

-- La comparación es
--    λ> sucesionSin3enPA !! 70
--    741
--    (7.97 secs, 5,444,053,240 bytes)
--    λ> sucesionSin3enPA2 !! 70
--    741
--    (0.03 secs, 35,781,952 bytes)
--    λ> sucesionSin3enPA3 !! 70
--    741
--    (0.01 secs, 192,864 bytes)
--    
--    λ> sucesionSin3enPA2 !! 350
--    7410
--    (9.46 secs, 10,119,851,016 bytes)
--    λ> sucesionSin3enPA3 !! 350
--    7410
--    (0.01 secs, 1,931,296 bytes)

import Data.List ((\\), delete, tails)

-- 1ª solución

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

sucesionSin3enPA :: [Integer]

sucesionSin3enPA = aux []

where aux xs = x : aux (x:xs)

where x = head (noEnPAConDos xs)

noEnPAConDos :: [Integer] -> [Integer]

noEnPAConDos xs = [z | z <- [0..]

, z `notElem` xs

, and [z - y /= y - x | x <- xs

, y <- dropWhile (<= x) xs]]

-- 2ª solución

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

-- Si x, y, z están en progresión aritmética, entonces

-- y = (x + z) / 2

-- Por tanto,

-- z = 2 * y - x

-- Teniendo en cuenta la relación auterior se define (aux xs ys) tal que

-- xs es la lista de los términos actuales de la sucesión e ys es la

-- lista de los números que no están en PA con cualesquieras dos de xs.

sucesionSin3enPA2 :: [Integer]

sucesionSin3enPA2 = aux [] [0..]

where

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

-- 3º solución

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

sucesionSin3enPA3 :: [Integer]

sucesionSin3enPA3 = 0 : aux [1]

where aux (x:xs) = x : aux (xs ++ [3*x,3*x+1])

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sucesionSin3enPA !! 70

-- 741

-- (7.97 secs, 5,444,053,240 bytes)

-- λ> sucesionSin3enPA2 !! 70

-- 741

-- (0.03 secs, 35,781,952 bytes)

-- λ> sucesionSin3enPA3 !! 70

-- 741

-- (0.01 secs, 192,864 bytes)

-- λ> sucesionSin3enPA2 !! 350

-- 7410

-- (9.46 secs, 10,119,851,016 bytes)

-- λ> sucesionSin3enPA3 !! 350

-- 7410

-- (0.01 secs, 1,931,296 bytes)

Otras soluciones

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

Pensamiento

Quien se vive se pierde, Abel decía.
¡Oh, distancia, distancia!, que la estrella
que nadie toca, guía.
¿Quién navegó sin ella?

Antonio Machado

Las conjeturas de Catalan y de Pillai

PorJosé A. Alonso 15-enero-202022-enero-2020

La conjetura de Catalan, enunciada en 1844 por Eugène Charles Catalan y demostrada 2002 por Preda Mihăilescu1, afirma que

Las únicas dos potencias de números enteros consecutivos son 8 y 9 (que son respectivamente 2³ y 3²).

En otras palabras, la única solución entera de la ecuación

   x^a - y^b = 1

1	x^a - y^b = 1

para x, a, y, b > 1 es x = 3, a = 2, y = 2, b = 3.

La conjetura de Pillai, propuesta por S.S. Pillai en 1942, generaliza este resultado y es un problema abierto. Afirma que cada entero se puede escribir sólo un número finito de veces como una diferencia de dos potencias perfectas. En otras palabras, para todo entero positivo n, el conjunto de soluciones de

   x^a - y^b = n

1	x^a - y^b = n

para x, a, y, b > 1 es finito.

Por ejemplo, para n = 4, hay 3 soluciones

   (2,3, 2,2) ya que 2³ -  2² =   8 -   4 = 4
   (6,2, 2,5) ya que 6² -  2⁵ =  36 -  32 = 4
   (5,3,11,2) ya que 5³ - 11² = 125 - 121 = 4

(2,3, 2,2) ya que 2³ - 2² = 8 - 4 = 4

(6,2, 2,5) ya que 6² - 2⁵ = 36 - 32 = 4

(5,3,11,2) ya que 5³ - 11² = 125 - 121 = 4

Las soluciones se pueden representar por la menor potencia (en el caso anterior, por 4, 32 y 121) ya que dado n (en el caso anterior es 4), la potencia mayor es la menor más n.

Definir las funciones

   potenciasPerfectas :: [Integer]
   solucionesPillati :: Integer -> [Integer]
   solucionesPillatiAcotadas :: Integer -> Integer -> [Integer]

potenciasPerfectas :: [Integer]

solucionesPillati :: Integer -> [Integer]

solucionesPillatiAcotadas :: Integer -> Integer -> [Integer]

tales que

potenciasPerfectas es la lista de las potencias perfectas (es decir, de los números de la forma x^a con x y a mayores que 1). Por ejemplo,

     take 10 potenciasPerfectas  ==  [4,8,9,16,25,27,32,36,49,64]
     potenciasPerfectas !! 200   ==  28224

1 2	take 10 potenciasPerfectas == [4,8,9,16,25,27,32,36,49,64] potenciasPerfectas !! 200 == 28224

(solucionesPillati n) es la lista de las menores potencias de las soluciones de la ecuación de Pillati x^a – y^b = n; es decir, es la lista de los u tales que u y u+n son potencias perfectas. Por ejemplo,

     take 3 (solucionesPillati 4)  ==  [4,32,121]
     take 2 (solucionesPillati 5)  ==  [4,27]
     take 4 (solucionesPillati 7)  ==  [9,25,121,32761]

take 3 (solucionesPillati 4) == [4,32,121]

take 2 (solucionesPillati 5) == [4,27]

take 4 (solucionesPillati 7) == [9,25,121,32761]

(solucionesPillatiAcotadas c n) es la lista de elementos de (solucionesPillati n) menores que n. Por ejemplo,

     solucionesPillatiAcotadas (10^3) 1  ==  [8]
     solucionesPillatiAcotadas (10^3) 2  ==  [25]
     solucionesPillatiAcotadas (10^3) 3  ==  [125]
     solucionesPillatiAcotadas (10^3) 4  ==  [4,32,121]
     solucionesPillatiAcotadas (10^3) 5  ==  [4,27]
     solucionesPillatiAcotadas (10^3) 6  ==  []
     solucionesPillatiAcotadas (10^3) 7  ==  [9,25,121]
     solucionesPillatiAcotadas (10^5) 7  ==  [9,25,121,32761]

solucionesPillatiAcotadas (10^3) 1 == [8]

solucionesPillatiAcotadas (10^3) 2 == [25]

solucionesPillatiAcotadas (10^3) 3 == [125]

solucionesPillatiAcotadas (10^3) 4 == [4,32,121]

solucionesPillatiAcotadas (10^3) 5 == [4,27]

solucionesPillatiAcotadas (10^3) 6 == []

solucionesPillatiAcotadas (10^3) 7 == [9,25,121]

solucionesPillatiAcotadas (10^5) 7 == [9,25,121,32761]

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)

-- Definiciones de potenciasPerfectas
-- ==================================

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

potenciasPerfectas1 :: [Integer]
potenciasPerfectas1 = filter esPotenciaPerfecta [4..]

-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por
-- ejemplo, 
--    esPotenciaPerfecta 36  ==  True
--    esPotenciaPerfecta 72  ==  False
esPotenciaPerfecta :: Integer -> Bool
esPotenciaPerfecta = not . null. potenciasPerfectasDe 

-- (potenciasPerfectasDe x) es la lista de pares (a,b) tales que 
-- x = a^b. Por ejemplo,
--    potenciasPerfectasDe 64  ==  [(2,6),(4,3),(8,2)]
--    potenciasPerfectasDe 72  ==  []
potenciasPerfectasDe :: Integer -> [(Integer,Integer)]
potenciasPerfectasDe n = 
    [(m,k) | m <- takeWhile (\x -> x*x <= n) [2..]
           , k <- takeWhile (\x -> m^x <= n) [2..]
           , m^k == n]

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

potenciasPerfectas2 :: [Integer]
potenciasPerfectas2 = [x | x <- [4..], esPotenciaPerfecta2 x]

-- (esPotenciaPerfecta2 x) se verifica si x es una potencia perfecta. Por
-- ejemplo, 
--    esPotenciaPerfecta2 36  ==  True
--    esPotenciaPerfecta2 72  ==  False
esPotenciaPerfecta2 :: Integer -> Bool
esPotenciaPerfecta2 x = mcd (exponentes x) > 1

-- (exponentes x) es la lista de los exponentes de l factorización prima
-- de x. Por ejemplos,
--    exponentes 36  ==  [2,2]
--    exponentes 72  ==  [3,2]
exponentes :: Integer -> [Int]
exponentes x = [length ys | ys <- group (primeFactors x)] 

-- (mcd xs) es el máximo común divisor de la lista xs. Por ejemplo,
--    mcd [4,6,10]  ==  2
--    mcd [4,5,10]  ==  1
mcd :: [Int] -> Int
mcd = foldl1 gcd

-- 3ª definición
-- -------------

potenciasPerfectas3 :: [Integer]
potenciasPerfectas3 = mezclaTodas potencias

-- potencias es la lista las listas de potencias de todos los números
-- mayores que 1 con exponentes mayores que 1. Por ejemplo,
--    λ> map (take 3) (take 4 potencias)
--    [[4,8,16],[9,27,81],[16,64,256],[25,125,625]]
potencias :: [[Integer]]
potencias = [[n^k | k <- [2..]] | n <- [2..]]

-- (mezclaTodas xss) es la mezcla ordenada sin repeticiones de las
-- listas ordenadas xss. Por ejemplo,
--    take 7 (mezclaTodas potencias)  ==  [4,8,9,16,25,27,32]
mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla ordenada sin repeticiones de las
-- listas ordenadas xs e ys. Por ejemplo,
--    take 7 (mezcla [2,5..] [4,6..])  ==  [2,4,5,6,8,10,11]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla (x:xs) (y:ys) | x < y  = x : mezcla xs (y:ys)
                     | x == y = x : mezcla xs ys
                     | x > y  = y : mezcla (x:xs) ys

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

--    λ> potenciasPerfectas1 !! 200
--    28224
--    (7.24 secs, 9,245,991,160 bytes)
--    λ> potenciasPerfectas2 !! 200
--    28224
--    (0.30 secs, 814,597,152 bytes)
--    λ> potenciasPerfectas3 !! 200
--    28224
--    (0.01 secs, 7,061,120 bytes)

-- En lo que sigue se usa la 3ª definición
potenciasPerfectas :: [Integer]
potenciasPerfectas = potenciasPerfectas3

-- Definición de solucionesPillati
-- ===============================

solucionesPillati :: Integer -> [Integer]
solucionesPillati n =
  [x | x <- potenciasPerfectas
     , esPotenciaPerfecta2 (x+n)]

-- Definición de solucionesPillatiAcotadas
-- =======================================

solucionesPillatiAcotadas :: Integer -> Integer -> [Integer]
solucionesPillatiAcotadas c n =
  [x | x <- takeWhile (< (c-n)) potenciasPerfectas
     , esPotenciaPerfecta2 (x+n)]

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List (group)

import Data.Numbers.Primes (primeFactors)

-- Definiciones de potenciasPerfectas

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

-- 1ª definición

-- -------------

potenciasPerfectas1 :: [Integer]

potenciasPerfectas1 = filter esPotenciaPerfecta [4..]

-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por

-- ejemplo,

-- esPotenciaPerfecta 36 == True

-- esPotenciaPerfecta 72 == False

esPotenciaPerfecta :: Integer -> Bool

esPotenciaPerfecta = not . null. potenciasPerfectasDe

-- (potenciasPerfectasDe x) es la lista de pares (a,b) tales que

-- x = a^b. Por ejemplo,

-- potenciasPerfectasDe 64 == [(2,6),(4,3),(8,2)]

-- potenciasPerfectasDe 72 == []

potenciasPerfectasDe :: Integer -> [(Integer,Integer)]

potenciasPerfectasDe n =

[(m,k) | m <- takeWhile (\x -> x*x <= n) [2..]

, k <- takeWhile (\x -> m^x <= n) [2..]

, m^k == n]

-- 2ª definición

-- -------------

potenciasPerfectas2 :: [Integer]

potenciasPerfectas2 = [x | x <- [4..], esPotenciaPerfecta2 x]

-- (esPotenciaPerfecta2 x) se verifica si x es una potencia perfecta. Por

-- ejemplo,

-- esPotenciaPerfecta2 36 == True

-- esPotenciaPerfecta2 72 == False

esPotenciaPerfecta2 :: Integer -> Bool

esPotenciaPerfecta2 x = mcd (exponentes x) > 1

-- (exponentes x) es la lista de los exponentes de l factorización prima

-- de x. Por ejemplos,

-- exponentes 36 == [2,2]

-- exponentes 72 == [3,2]

exponentes :: Integer -> [Int]

exponentes x = [length ys | ys <- group (primeFactors x)]

-- (mcd xs) es el máximo común divisor de la lista xs. Por ejemplo,

-- mcd [4,6,10] == 2

-- mcd [4,5,10] == 1

mcd :: [Int] -> Int

mcd = foldl1 gcd

-- 3ª definición

-- -------------

potenciasPerfectas3 :: [Integer]

potenciasPerfectas3 = mezclaTodas potencias

-- potencias es la lista las listas de potencias de todos los números

-- mayores que 1 con exponentes mayores que 1. Por ejemplo,

-- λ> map (take 3) (take 4 potencias)

-- [[4,8,16],[9,27,81],[16,64,256],[25,125,625]]

potencias :: [[Integer]]

potencias = [[n^k | k <- [2..]] | n <- [2..]]

-- (mezclaTodas xss) es la mezcla ordenada sin repeticiones de las

-- listas ordenadas xss. Por ejemplo,

-- take 7 (mezclaTodas potencias) == [4,8,9,16,25,27,32]

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

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la mezcla ordenada sin repeticiones de las

-- listas ordenadas xs e ys. Por ejemplo,

-- take 7 (mezcla [2,5..] [4,6..]) == [2,4,5,6,8,10,11]

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

mezcla (x:xs) (y:ys) | x < y = x : mezcla xs (y:ys)

| x == y = x : mezcla xs ys

| x > y = y : mezcla (x:xs) ys

-- Comparación de eficiencia

-- -------------------------

-- λ> potenciasPerfectas1 !! 200

-- 28224

-- (7.24 secs, 9,245,991,160 bytes)

-- λ> potenciasPerfectas2 !! 200

-- 28224

-- (0.30 secs, 814,597,152 bytes)

-- λ> potenciasPerfectas3 !! 200

-- 28224

-- (0.01 secs, 7,061,120 bytes)

-- En lo que sigue se usa la 3ª definición

potenciasPerfectas :: [Integer]

potenciasPerfectas = potenciasPerfectas3

-- Definición de solucionesPillati

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

solucionesPillati :: Integer -> [Integer]

solucionesPillati n =

[x | x <- potenciasPerfectas

, esPotenciaPerfecta2 (x+n)]

-- Definición de solucionesPillatiAcotadas

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

solucionesPillatiAcotadas :: Integer -> Integer -> [Integer]

solucionesPillatiAcotadas c n =

[x | x <- takeWhile (< (c-n)) potenciasPerfectas

, esPotenciaPerfecta2 (x+n)]

Referencia

Catalan’s conjecture en Wikipedia.

Pensamiento

Y te enviaré mi canción:
«Se canta lo que se pierde»,
con un papagayo verde
que la diga en tu balcón.

Antonio Machado

La mayor potencia de dos no es divisor

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

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

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

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

de los números desde el 1 hasta n.

Definir la función

   mayorPotenciaDeDosEnS :: Integer -> Integer

1	mayorPotenciaDeDosEnS :: Integer -> Integer

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

   mayorPotenciaDeDosEnS 3  ==  2
   mayorPotenciaDeDosEnS 4  ==  4

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

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

Soluciones

import Data.List (delete)
import Test.QuickCheck

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

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

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

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

import Data.List (delete)

import Test.QuickCheck

mayorPotenciaDeDosEnS :: Integer -> Integer

mayorPotenciaDeDosEnS n =

last (takeWhile (<=n) potenciasDeDos)

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

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

potenciasDeDos :: [Integer]

potenciasDeDos = iterate (*2) 1

-- La propiedad es

prop_mayorPotenciaDeDosEnS :: Integer -> Property

prop_mayorPotenciaDeDosEnS n =

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

where x = mayorPotenciaDeDosEnS n

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

-- La comprobación es

-- λ> quickCheck prop_mayorPotenciaDeDosEnS

-- +++ OK, passed 100 tests.

Referencia

Basado en Greatest power of two not divisor de ProofWiki.

Pensamiento

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

Antonio Machado

Conjetura de Grimm

PorJosé A. Alonso 2-enero-202015-enero-2020

La conjetura de Grimm establece que a cada elemento de un conjunto de números compuestos consecutivos se puede asignar un número primo que lo divide, de forma que cada uno de los números primos elegidos es distinto de todos los demás. Más formalmente, si n+1, n+2, …, n+k son números compuestos, entonces existen números primos p(i), distintos entre sí, tales que p(i) divide a n+i para 1 ≤ i ≤ k.

Diremos que la lista ps = [p(1),…,p(k)] es una sucesión de Grim para la lista xs = [x(1),…,x(k)] si p(i) son números primos distintos y p(i) divide a x(i), para 1 ≤ i ≤ k. Por ejemplo, 2, 5, 13, 3, 7 es una sucesión de Grim de 24, 25, 26, 27, 28.

Definir las funciones

   compuestos :: Integer -> [Integer]
   sucesionesDeGrim :: [Integer] -> [[Integer]]

1 2	compuestos :: Integer -> [Integer] sucesionesDeGrim :: [Integer] -> [[Integer]]

tales que

(compuestos n) es la mayor lista de números enteros consecutivos empezando en n. Por ejemplo,

     compuestos 24  ==  [24,25,26,27,28]
     compuestos  8  ==  [8,9,10]
     compuestos 15  ==  [15,16]
     compuestos 16  ==  [16]
     compuestos 17  ==  []

compuestos 24 == [24,25,26,27,28]

compuestos 8 == [8,9,10]

compuestos 15 == [15,16]

compuestos 16 == [16]

compuestos 17 == []

(sucesionesDeGrim xs) es la lista de las sucesiones de Grim de xs. Por ejemplo,

     sucesionesDeGrim [15,16]          == [[3,2],[5,2]]
     sucesionesDeGrim [8,9,10]         == [[2,3,5]]
     sucesionesDeGrim [9,10]           == [[3,2],[3,5]]
     sucesionesDeGrim [24,25,26,27,28] == [[2,5,13,3,7]]
     sucesionesDeGrim [25,26,27,28]    == [[5,2,3,7],[5,13,3,2],[5,13,3,7]]

sucesionesDeGrim [15,16] == [[3,2],[5,2]]

sucesionesDeGrim [8,9,10] == [[2,3,5]]

sucesionesDeGrim [9,10] == [[3,2],[3,5]]

sucesionesDeGrim [24,25,26,27,28] == [[2,5,13,3,7]]

sucesionesDeGrim [25,26,27,28] == [[5,2,3,7],[5,13,3,2],[5,13,3,7]]

Comprobar con QuickCheck la conjetura de Grim; es decir, para todo número n > 1, (sucesionesDeGrim (compuestos n)) es una lista no vacía.

Soluciones

import Data.List (nub)
import Data.Numbers.Primes (isPrime, primeFactors)
import Test.QuickCheck

compuestos :: Integer -> [Integer]
compuestos n = takeWhile (not . isPrime) [n..]

sucesionesDeGrim :: [Integer] -> [[Integer]]
sucesionesDeGrim [] = [[]]
sucesionesDeGrim (x:xs) =
  [y:ys | y <- divisoresPrimos x
        , ys <- sucesionesDeGrim xs
        , y `notElem` ys]

-- (divisoresPrimos n) es la lista de los divisores primos de n. Por
-- ejemplo, 
--    divisoresPrimos 60  ==  [2,3,5]
divisoresPrimos :: Integer -> [Integer]
divisoresPrimos = nub . primeFactors

-- La propiedad es
conjeturaDeGrim :: Integer -> Property
conjeturaDeGrim n =
  n > 1 ==> not (null (sucesionesDeGrim (compuestos n))) 

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

import Data.List (nub)

import Data.Numbers.Primes (isPrime, primeFactors)

import Test.QuickCheck

compuestos :: Integer -> [Integer]

compuestos n = takeWhile (not . isPrime) [n..]

sucesionesDeGrim :: [Integer] -> [[Integer]]

sucesionesDeGrim [] = [[]]

sucesionesDeGrim (x:xs) =

[y:ys | y <- divisoresPrimos x

, ys <- sucesionesDeGrim xs

, y `notElem` ys]

-- (divisoresPrimos n) es la lista de los divisores primos de n. Por

-- ejemplo,

-- divisoresPrimos 60 == [2,3,5]

divisoresPrimos :: Integer -> [Integer]

divisoresPrimos = nub . primeFactors

-- La propiedad es

conjeturaDeGrim :: Integer -> Property

conjeturaDeGrim n =

n > 1 ==> not (null (sucesionesDeGrim (compuestos n)))

-- La comprobación es

-- λ> quickCheck conjeturaDeGrim

-- +++ OK, passed 100 tests.

Pensamiento

De encinar en encinar
se va fatigando el día.

Antonio Machado

Teorema de Carmichael

PorJosé A. Alonso 1-enero-20208-enero-2020

La sucesión de Fibonacci, F(n), es la siguiente sucesión infinita de números naturales:

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

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

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

El teorema de Carmichael establece que para todo n mayor que 12, el n-ésimo número de Fibonacci F(n) tiene al menos un factor primo que no es factor de ninguno de los términos anteriores de la sucesión.

Si un número primo p es un factor de F(n) y no es factor de ningún F(m) con m < n, entonces se dice que p es un factor característico o un divisor primitivo de F(n).

Definir la función

   factoresCaracteristicos :: Int -> [Integer]

1	factoresCaracteristicos :: Int -> [Integer]

tal que (factoresCaracteristicos n) es la lista de los factores característicos de F(n). Por ejemplo,

   factoresCaracteristicos  4  ==  [3]
   factoresCaracteristicos  6  ==  []
   factoresCaracteristicos 19  ==  [37,113]
   factoresCaracteristicos 20  ==  [41]
   factoresCaracteristicos 37  ==  [73,149,2221]

factoresCaracteristicos 4 == [3]

factoresCaracteristicos 6 == []

factoresCaracteristicos 19 == [37,113]

factoresCaracteristicos 20 == [41]

factoresCaracteristicos 37 == [73,149,2221]

Comprobar con QuickCheck el teorema de Carmichael; es decir, para todo número entero (factoresCaracteristicos (13 + abs n)) es una lista no vacía.

Soluciones

import Data.List (nub)
import Data.Numbers.Primes
import Test.QuickCheck

factoresCaracteristicos :: Int -> [Integer]
factoresCaracteristicos n =
  [x | x <- factoresPrimos (fib n)
     , and [fib m `mod` x /= 0 | m <- [1..n-1]]]

-- (fib n) es el n-ésimo término de la sucesión de Fibonacci. Por
-- ejemplo,
--    fib 6  ==  8
fib :: Int -> Integer
fib n = fibs !! n

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

-- (factoresPrimos n) es la lista de los factores primos de n. Por
-- ejemplo, 
--    factoresPrimos 600  ==  [2,3,5]
factoresPrimos :: Integer -> [Integer]
factoresPrimos 0 = []
factoresPrimos n = nub (primeFactors n)

-- Teorema
-- =======

-- El teorema es
teorema_de_Carmichael :: Int -> Bool
teorema_de_Carmichael n =
  not (null (factoresCaracteristicos n'))
  where n' = 13 + abs n

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

import Data.List (nub)

import Data.Numbers.Primes

import Test.QuickCheck

factoresCaracteristicos :: Int -> [Integer]

factoresCaracteristicos n =

[x | x <- factoresPrimos (fib n)

, and [fib m `mod` x /= 0 | m <- [1..n-1]]]

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

-- ejemplo,

-- fib 6 == 8

fib :: Int -> Integer

fib n = fibs !! n

-- fibs es la lista de términos de la sucesión de Fibonacci. Por ejemplo,

-- λ> take 20 fibs

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

fibs :: [Integer]

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

-- (factoresPrimos n) es la lista de los factores primos de n. Por

-- ejemplo,

-- factoresPrimos 600 == [2,3,5]

factoresPrimos :: Integer -> [Integer]

factoresPrimos 0 = []

factoresPrimos n = nub (primeFactors n)

-- Teorema

-- =======

-- El teorema es

teorema_de_Carmichael :: Int -> Bool

teorema_de_Carmichael n =

not (null (factoresCaracteristicos n'))

where n' = 13 + abs n

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=50}) teorema_de_Carmichael

-- +++ OK, passed 100 tests.

Pensamiento

No puede ser
amor de tanta fortuna:
dos soledades en una.

Antonio Machado

Postulado de Bertrand

PorJosé A. Alonso 30-diciembre-20196-enero-2020

El postulado de Bertrand afirma que para cualquier número entero n > 1, existe al menos un número primo p con n < p < 2n.

Definir la función

   siguientePrimo :: Integer -> Integer

1	siguientePrimo :: Integer -> Integer

tal que (siguientePrimo n) es el menor primo mayor que n. Por ejemplo,

   siguientePrimo 8   ==  11
   siguientePrimo 11  ==  13

1 2	siguientePrimo 8 == 11 siguientePrimo 11 == 13

Comprobar con QuickCheck el postulado de Bertrand; es decir, para todo entero n > 1, se verifica que n < p < 2n, donde p es (siguientePrimo n).

Soluciones

import Data.Numbers.Primes
import Test.QuickCheck

siguientePrimo :: Integer -> Integer
siguientePrimo n = head (dropWhile (<= n) primes)

-- La propiedad es
postuladoDeBertrand :: Integer -> Property
postuladoDeBertrand n =
  n > 1 ==> n < p && p < 2 * n
  where p = siguientePrimo n

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

import Data.Numbers.Primes

import Test.QuickCheck

siguientePrimo :: Integer -> Integer

siguientePrimo n = head (dropWhile (<= n) primes)

-- La propiedad es

postuladoDeBertrand :: Integer -> Property

postuladoDeBertrand n =

n > 1 ==> n < p && p < 2 * n

where p = siguientePrimo n

-- La comprobación es

-- λ> quickCheck postuladoDeBertrand

-- +++ OK, passed 100 tests.

Referencias

Bertrand’s postulate en Wikipedia.

Pensamiento

Pero caer de cabeza,
en esta noche sin luna,
en medio de esta maleza,
junto a la negra laguna.

Antonio Machado

Posiciones de conjuntos finitos de naturales

PorJosé A. Alonso 27-diciembre-20193-enero-2020

En un ejercicio anterior se mostró que los conjuntos finitos de números naturales se pueden enumerar como sigue

    0: []
    1: [0]
    2: [1]
    3: [1,0]
    4: [2]
    5: [2,0]
    6: [2,1]
    7: [2,1,0]
    8: [3]
    9: [3,0]
   10: [3,1]
   11: [3,1,0]
   12: [3,2]
   13: [3,2,0]
   14: [3,2,1]
   15: [3,2,1,0]
   16: [4]
   17: [4,0]
   18: [4,1]
   19: [4,1,0]

0: []

1: [0]

2: [1]

3: [1,0]

4: [2]

5: [2,0]

6: [2,1]

7: [2,1,0]

8: [3]

9: [3,0]

10: [3,1]

11: [3,1,0]

12: [3,2]

13: [3,2,0]

14: [3,2,1]

15: [3,2,1,0]

16: [4]

17: [4,0]

18: [4,1]

19: [4,1,0]

en la que los elementos están ordenados de manera decreciente.

Además, se definió la constante

   enumeracionCFN :: [[Integer]]

1	enumeracionCFN :: [[Integer]]

tal que sus elementos son los conjuntos de los números naturales con la ordenación descrita anteriormente. Por ejemplo,

   λ> take 20 enumeracionCFN
   [[],
    [0],
    [1],[1,0],
    [2],[2,0],[2,1],[2,1,0],
    [3],[3,0],[3,1],[3,1,0],[3,2],[3,2,0],[3,2,1],[3,2,1,0],
    [4],[4,0],[4,1],[4,1,0]]

λ> take 20 enumeracionCFN

[[],

[0],

[1],[1,0],

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

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

[4],[4,0],[4,1],[4,1,0]]

Definir la función

   posicion :: [Integer] -> Integer

1	posicion :: [Integer] -> Integer

tal que (posicion xs) es la posición del conjunto finito de números naturales xs, representado por una lista decreciente, en enumeracionCFN. Por ejemplo,

   posicion [2,0]          ==  5
   posicion [2,1]          ==  6
   posicion [2,1,0]        ==  7
   posicion [0]            ==  1
   posicion [1,0]          ==  3
   posicion [2,1,0]        ==  7
   posicion [3,2,1,0]      ==  15
   posicion [4,3,2,1,0]    ==  31
   posicion [5,4,3,2,1,0]  ==  63
   length (show (posicion [3*10^7])) == 9030900

posicion [2,0] == 5

posicion [2,1] == 6

posicion [2,1,0] == 7

posicion [0] == 1

posicion [1,0] == 3

posicion [2,1,0] == 7

posicion [3,2,1,0] == 15

posicion [4,3,2,1,0] == 31

posicion [5,4,3,2,1,0] == 63

length (show (posicion [3*10^7])) == 9030900

Comprobar con QuickCheck que para todo número natural n,

   posicion [n,n-1..0] == 2^(n+1) - 1.

1	posicion [n,n-1..0] == 2^(n+1) - 1.

Soluciones

import Data.List (genericLength, nub, sort)
import Test.QuickCheck

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

posicion :: [Integer] -> Integer
posicion xs =
  genericLength (takeWhile (< xs) enumeracionCFN)

enumeracionCFN :: [[Integer]]
enumeracionCFN = concatMap enumeracionCFNHasta [0..]

-- (enumeracionCFNHasta n) es la lista de conjuntos con la enumeración
-- anterior cuyo primer elemento es n. Por ejemplo,
--    λ> enumeracionCFNHasta 1
--    [[1],[1,0]]
--    λ> enumeracionCFNHasta 2
--    [[2],[2,0],[2,1],[2,1,0]]
--    λ> enumeracionCFNHasta 3
--    [[3],[3,0],[3,1],[3,1,0],[3,2],[3,2,0],[3,2,1],[3,2,1,0]]
enumeracionCFNHasta :: Integer -> [[Integer]]
enumeracionCFNHasta 0 = [[],[0]]
enumeracionCFNHasta n =
  [n:xs | k <- [0..n-1], xs <- enumeracionCFNHasta k]

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

posicion2 :: [Integer] -> Integer
posicion2 []     = 0
posicion2 (x:xs) = 2^x + posicion2 xs

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

posicion3 :: [Integer] -> Integer
posicion3 = foldr (\x -> (+) (2^x)) 0 

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

posicion4 :: [Integer] -> Integer
posicion4 xs = sum [2^x | x <- xs ]

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_equiv :: [Integer] -> Bool
prop_equiv xs =
  all (== posicion xs') [f xs' | f <- [ posicion2
                                      , posicion3
                                      , posicion4]]
  where xs' = reverse (sort (nub (map abs xs)))

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

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

-- La comparación es
--    λ> posicion [19,18,17,16,14,9,6]
--    1000000
--    (2.61 secs, 1,754,265,776 bytes)
--    λ> posicion2 [19,18,17,16,14,9,6]
--    1000000
--    (0.01 secs, 111,808 bytes)
--    λ> posicion3 [19,18,17,16,14,9,6]
--    1000000
--    λ> posicion4 [19,18,17,16,14,9,6]
--    1000000
--    (0.01 secs, 111,704 bytes)

--    λ> length (show (posicion2 [3*10^7]))
--    9030900
--    (2.06 secs, 571,911,304 bytes)
--    λ> length (show (posicion3 [3*10^7]))
--    9030900
--    (2.06 secs, 571,911,544 bytes)
--    λ> length (show (posicion4 [3*10^7]))
--    9030900
--    (2.05 secs, 571,911,464 bytes)

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

-- La propiedad es
prop_posicion :: Integer -> Property
prop_posicion n =
  n >= 0 ==> posicion3 [n,n-1..0] == 2^(n+1) - 1

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

import Data.List (genericLength, nub, sort)

import Test.QuickCheck

-- 1ª solución

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

posicion :: [Integer] -> Integer

posicion xs =

genericLength (takeWhile (< xs) enumeracionCFN)

enumeracionCFN :: [[Integer]]

enumeracionCFN = concatMap enumeracionCFNHasta [0..]

-- (enumeracionCFNHasta n) es la lista de conjuntos con la enumeración

-- anterior cuyo primer elemento es n. Por ejemplo,

-- λ> enumeracionCFNHasta 1

-- [[1],[1,0]]

-- λ> enumeracionCFNHasta 2

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

-- λ> enumeracionCFNHasta 3

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

enumeracionCFNHasta :: Integer -> [[Integer]]

enumeracionCFNHasta 0 = [[],[0]]

enumeracionCFNHasta n =

[n:xs | k <- [0..n-1], xs <- enumeracionCFNHasta k]

-- 2ª solución

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

posicion2 :: [Integer] -> Integer

posicion2 [] = 0

posicion2 (x:xs) = 2^x + posicion2 xs

-- 3ª solución

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

posicion3 :: [Integer] -> Integer

posicion3 = foldr (\x -> (+) (2^x)) 0

-- 4ª solución

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

posicion4 :: [Integer] -> Integer

posicion4 xs = sum [2^x | x <- xs ]

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_equiv :: [Integer] -> Bool

prop_equiv xs =

all (== posicion xs') [f xs' | f <- [ posicion2

, posicion3

, posicion4]]

where xs' = reverse (sort (nub (map abs xs)))

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=15}) prop_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> posicion [19,18,17,16,14,9,6]

-- 1000000

-- (2.61 secs, 1,754,265,776 bytes)

-- λ> posicion2 [19,18,17,16,14,9,6]

-- 1000000

-- (0.01 secs, 111,808 bytes)

-- λ> posicion3 [19,18,17,16,14,9,6]

-- 1000000

-- λ> posicion4 [19,18,17,16,14,9,6]

-- 1000000

-- (0.01 secs, 111,704 bytes)

-- λ> length (show (posicion2 [3*10^7]))

-- 9030900

-- (2.06 secs, 571,911,304 bytes)

-- λ> length (show (posicion3 [3*10^7]))

-- 9030900

-- (2.06 secs, 571,911,544 bytes)

-- λ> length (show (posicion4 [3*10^7]))

-- 9030900

-- (2.05 secs, 571,911,464 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_posicion :: Integer -> Property

prop_posicion n =

n >= 0 ==> posicion3 [n,n-1..0] == 2^(n+1) - 1

-- La comprobación es

-- λ> quickCheck prop_posicion

-- +++ OK, passed 100 tests.

Pensamiento

¡Volar sin alas donde todo es cielo!

Antonio Machado

Conjuntos con más sumas que restas

PorJosé A. Alonso 26-diciembre-20192-enero-2020

Dado un conjunto de números naturales, por ejemplo A = {0, 2, 3, 4}, calculamos las sumas de todos los pares de elementos de A. Como A tiene 4 elementos hay 16 pares, pero no todas sus sumas son distintas. En este caso solo hay 8 sumas distintas: {0, 2, 3, 4, 5, 6, 7, 8}. Procediendo análogamente hay 9 diferencias distinatas entre los pares de A: {-4, -3, -2, -1, 0, 1, 2, 3, 4}.

Experimentando con más conjuntos, se puede conjeturar que el número de restas es mayor que el de sumas y argumentar que que mientras que con dos números distintos sólo se produce una suma distints sin embargo se producen dos restas distintas. Por ejemplo, con 5 y 7 sólo se produce una suma (ya que 5+7 y 7+5 ambos dan 12) pero dos restas (ya que 5-7 y 7-5 dan -2 y 2, respectivamente).

Sin embargo, la conjetura es falsa. Un contraejemplo en el conjunto {0, 2, 3, 4, 7, 11, 12, 14}, que tiene 26 sumas distintas con sus pares de elementos pero sólo 25 restas.

Los conjuntos con más sumas distintas con sus pares de elementos que restas se llaman conjuntos MSQR (por «más sumas que restas»).

El objetivo de este ejercicio es calcular los conjuntos MSQR.

Definir las funciones

   tieneMSQR :: [Integer] -> Bool
   conjuntosMSQR :: [[Integer]]

1 2	tieneMSQR :: [Integer] -> Bool conjuntosMSQR :: [[Integer]]

tales que

(tieneMSQR xs) se verifica si el conjunto xs tiene más sumas que restas. Por ejemplo,

     tieneMSQR [0, 2, 3, 4]                 ==  False
     tieneMSQR [0, 2, 3, 4, 7, 11, 12, 14]  ==  True

1 2	tieneMSQR [0, 2, 3, 4] == False tieneMSQR [0, 2, 3, 4, 7, 11, 12, 14] == True

conjuntosMSQR es la lista de los conjuntos MSQR. Por ejemplo,

     λ> take 5 conjuntosMSQR
     [[14,12,11,7,4,3,2,0],
      [14,12,11,10,7,3,2,0],
      [14,13,12,9,5,4,2,1,0],
      [14,13,12,10,9,5,2,1,0],
      [15,13,12,8,5,4,3,1]]
   
      length (takeWhile (< [14]) conjuntosMSQR)   ==  0
      length (takeWhile (< [15]) conjuntosMSQR)   ==  4
      length (takeWhile (< [16]) conjuntosMSQR)   ==  10
      length (takeWhile (< [17]) conjuntosMSQR)   ==  30

λ> take 5 conjuntosMSQR

[[14,12,11,7,4,3,2,0],

[14,12,11,10,7,3,2,0],

[14,13,12,9,5,4,2,1,0],

[14,13,12,10,9,5,2,1,0],

[15,13,12,8,5,4,3,1]]

length (takeWhile (< [14]) conjuntosMSQR) == 0

length (takeWhile (< [15]) conjuntosMSQR) == 4

length (takeWhile (< [16]) conjuntosMSQR) == 10

length (takeWhile (< [17]) conjuntosMSQR) == 30

Soluciones

import Data.List (tails, nub, sort)

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

-- (sumas xs) es el conjunto de las sumas de pares de elementos de
-- xs. Por ejemplo,
--    sumas2 [0,2,3,4]  ==  [0,2,3,4,5,6,7,8]
sumas :: [Integer] -> [Integer]
sumas xs = nub [x + y | x <- xs, y <- xs]

-- (restas xs) es el conjunto de las restas de pares de elementos de
-- xs. Por ejemplo,
--    restas [0,2,3,4]  ==  [0,-2,-3,-4,2,-1,3,1,4]
restas :: [Integer] -> [Integer]
restas xs = nub [x - y | x <- xs, y <- xs]

tieneMSQR :: [Integer] -> Bool
tieneMSQR xs = length (sumas xs) > length (restas xs)

conjuntosMSQR :: [[Integer]]
conjuntosMSQR = [xs | xs <- enumeracionCFN, tieneMSQR xs]

-- enumeracionCFN es la enumeración de los conjuntos finitos de números
-- naturales del ejercicio anterior.
enumeracionCFN :: [[Integer]]
enumeracionCFN = concatMap enumeracionCFNHasta [0..]

-- (enumeracionCFNHasta n) es la lista de conjuntos con la enumeración
-- anterior cuyo primer elemento es n. Por ejemplo,
--    λ> enumeracionCFNHasta 1
--    [[1],[1,0]]
--    λ> enumeracionCFNHasta 2
--    [[2],[2,0],[2,1],[2,1,0]]
--    λ> enumeracionCFNHasta 3
--    [[3],[3,0],[3,1],[3,1,0],[3,2],[3,2,0],[3,2,1],[3,2,1,0]]
enumeracionCFNHasta :: Integer -> [[Integer]]
enumeracionCFNHasta 0 = [[],[0]]
enumeracionCFNHasta n =
  [n:xs | k <- [0..n-1], xs <- enumeracionCFNHasta k]

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

-- (sumas2 xs) es el conjunto de las sumas de pares de elementos de
-- xs. Por ejemplo,
--    sumas2 [0,2,3,4]  ==  [0,2,3,4,5,6,7,8]
--    sumas2 [0,2,3,4]  ==  [0,2,3,4,5,6,7,8]
sumas2 :: [Integer] -> [Integer]
sumas2 xs = nub [x + y | (x:ys) <- tails xs, y <- (x:ys)]

-- (restas2 xs) es el conjunto de las restas de pares de elementos de
-- xs. Por ejemplo,
--    sumas2 [0,2,3,4]  ==  [0,2,3,4,5,6,7,8]
--    restas2 [0,2,3,4]  ==  [0,-2,-3,-4,2,-1,3,1,4]
restas2 :: [Integer] -> [Integer]
restas2 xs = 0 : ys ++ map negate ys
  where ys = nub [x - y | (x:ys) <- tails (sort xs), y <- ys]

tieneMSQR2 :: [Integer] -> Bool
tieneMSQR2 xs = length (sumas2 xs) > length (restas2 xs)

conjuntosMSQR2 :: [[Integer]]
conjuntosMSQR2 = [xs | xs <- enumeracionCFN, tieneMSQR2 xs]

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

--    λ> length (takeWhile (< [17,16..0]) conjuntosMSQR)
--    66
--    (21.36 secs, 10,301,222,168 bytes)
--    λ> length (takeWhile (< [17,16..0]) conjuntosMSQR2)
--    66
--    (10.13 secs, 7,088,969,752 bytes)

import Data.List (tails, nub, sort)

-- 1ª solución

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

-- (sumas xs) es el conjunto de las sumas de pares de elementos de

-- xs. Por ejemplo,

-- sumas2 [0,2,3,4] == [0,2,3,4,5,6,7,8]

sumas :: [Integer] -> [Integer]

sumas xs = nub [x + y | x <- xs, y <- xs]

-- (restas xs) es el conjunto de las restas de pares de elementos de

-- xs. Por ejemplo,

-- restas [0,2,3,4] == [0,-2,-3,-4,2,-1,3,1,4]

restas :: [Integer] -> [Integer]

restas xs = nub [x - y | x <- xs, y <- xs]

tieneMSQR :: [Integer] -> Bool

tieneMSQR xs = length (sumas xs) > length (restas xs)

conjuntosMSQR :: [[Integer]]

conjuntosMSQR = [xs | xs <- enumeracionCFN, tieneMSQR xs]

-- enumeracionCFN es la enumeración de los conjuntos finitos de números

-- naturales del ejercicio anterior.

enumeracionCFN :: [[Integer]]

enumeracionCFN = concatMap enumeracionCFNHasta [0..]

-- (enumeracionCFNHasta n) es la lista de conjuntos con la enumeración

-- anterior cuyo primer elemento es n. Por ejemplo,

-- λ> enumeracionCFNHasta 1

-- [[1],[1,0]]

-- λ> enumeracionCFNHasta 2

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

-- λ> enumeracionCFNHasta 3

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

enumeracionCFNHasta :: Integer -> [[Integer]]

enumeracionCFNHasta 0 = [[],[0]]

enumeracionCFNHasta n =

[n:xs | k <- [0..n-1], xs <- enumeracionCFNHasta k]

-- 2ª solución

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

-- (sumas2 xs) es el conjunto de las sumas de pares de elementos de

-- xs. Por ejemplo,

-- sumas2 [0,2,3,4] == [0,2,3,4,5,6,7,8]

sumas2 :: [Integer] -> [Integer]

sumas2 xs = nub [x + y | (x:ys) <- tails xs, y <- (x:ys)]

-- (restas2 xs) es el conjunto de las restas de pares de elementos de

-- xs. Por ejemplo,

-- sumas2 [0,2,3,4] == [0,2,3,4,5,6,7,8]

-- restas2 [0,2,3,4] == [0,-2,-3,-4,2,-1,3,1,4]

restas2 :: [Integer] -> [Integer]

restas2 xs = 0 : ys ++ map negate ys

where ys = nub [x - y | (x:ys) <- tails (sort xs), y <- ys]

tieneMSQR2 :: [Integer] -> Bool

tieneMSQR2 xs = length (sumas2 xs) > length (restas2 xs)

conjuntosMSQR2 :: [[Integer]]

conjuntosMSQR2 = [xs | xs <- enumeracionCFN, tieneMSQR2 xs]

-- Comparación de eficiencia

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

-- λ> length (takeWhile (< [17,16..0]) conjuntosMSQR)

-- 66

-- (21.36 secs, 10,301,222,168 bytes)

-- λ> length (takeWhile (< [17,16..0]) conjuntosMSQR2)

-- 66

-- (10.13 secs, 7,088,969,752 bytes)

Pensamiento

¡Qué fácil es volar, qué fácil es!
Todo consiste en no dejar que el suelo
se acerque a nuestros pies.

Antonio Machado

Enumeración de conjuntos finitos de naturales

PorJosé A. Alonso 25-diciembre-20191-enero-2020

Los conjuntos finitos de números naturales se pueden enumerar como sigue

    0: []
    1: [0]
    2: [1]
    3: [1,0]
    4: [2]
    5: [2,0]
    6: [2,1]
    7: [2,1,0]
    8: [3]
    9: [3,0]
   10: [3,1]
   11: [3,1,0]
   12: [3,2]
   13: [3,2,0]
   14: [3,2,1]
   15: [3,2,1,0]
   16: [4]
   17: [4,0]
   18: [4,1]
   19: [4,1,0]

0: []

1: [0]

2: [1]

3: [1,0]

4: [2]

5: [2,0]

6: [2,1]

7: [2,1,0]

8: [3]

9: [3,0]

10: [3,1]

11: [3,1,0]

12: [3,2]

13: [3,2,0]

14: [3,2,1]

15: [3,2,1,0]

16: [4]

17: [4,0]

18: [4,1]

19: [4,1,0]

en la que los elementos están ordenados de manera decreciente.

Definir la constante

   enumeracionCFN :: [[Integer]]

1	enumeracionCFN :: [[Integer]]

tal que sus elementos son los conjuntos de los números naturales con la ordenación descrita anteriormente. Por ejemplo,

   λ> take 20 enumeracionCFN
   [[],
    [0],
    [1],[1,0],
    [2],[2,0],[2,1],[2,1,0],
    [3],[3,0],[3,1],[3,1,0],[3,2],[3,2,0],[3,2,1],[3,2,1,0],
    [4],[4,0],[4,1],[4,1,0]]

λ> take 20 enumeracionCFN

[[],

[0],

[1],[1,0],

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

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

[4],[4,0],[4,1],[4,1,0]]

Comprobar con QuickCheck que

si (xs,ys) es un par de elementos consecutivos de enumeracionCFN, entonces xs < ys;
todo conjunto finito de números naturales, representado por una lista decreciente, está en enumeracionCFN.

Soluciones

import Data.List (genericLength, nub, sort)
import Test.QuickCheck

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

enumeracionCFN :: [[Integer]]
enumeracionCFN = concatMap enumeracionCFNHasta [0..]

-- (enumeracionCFNHasta n) es la lista de conjuntos con la enumeración
-- anterior cuyo primer elemento es n. Por ejemplo,
--    λ> enumeracionCFNHasta 1
--    [[1],[1,0]]
--    λ> enumeracionCFNHasta 2
--    [[2],[2,0],[2,1],[2,1,0]]
--    λ> enumeracionCFNHasta 3
--    [[3],[3,0],[3,1],[3,1,0],[3,2],[3,2,0],[3,2,1],[3,2,1,0]]
enumeracionCFNHasta :: Integer -> [[Integer]]
enumeracionCFNHasta 0 = [[],[0]]
enumeracionCFNHasta n =
  [n:xs | k <- [0..n-1], xs <- enumeracionCFNHasta k]

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

enumeracionCFN2 :: [[Integer]]
enumeracionCFN2 = [] : aux 0 [[]]
  where aux n xs = yss ++ aux (n+1) (xs ++ yss)
          where yss = map (n:) xs

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

enumeracionCFN3 :: [[Integer]]
enumeracionCFN3 = map conjunto [0..]

-- (conjunto n) es el conjunto en la posición n. Por ejemplo,
--   conjunto 6  ==  [2,1]
conjunto :: Integer -> [Integer]
conjunto n = reverse [x | (x,y) <- zip [0..] (binario n), y == 1]

-- (binario n) es la representación binarioa del número n (en orden
-- inverso). Por ejemplo,
--   binario 6  ==  [0,1,1]
binario :: Integer -> [Integer]
binario 0 = [0]
binario 1 = [1]
binario n = n `mod` 2 : binario (n `div` 2)

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

--    λ> enumeracionCFN !! (4*10^5)
--    [18,17,12,11,9,7]
--    (1.18 secs, 576,924,344 bytes)
--    λ> enumeracionCFN2 !! (4*10^5)
--    [18,17,12,11,9,7]
--    (0.10 secs, 72,399,784 bytes)
--    λ> enumeracionCFN3 !! (4*10^5)
--    [18,17,12,11,9,7]
--    (0.07 secs, 64,123,952 bytes)
--
--    λ> enumeracionCFN2 !! (6*10^6)
--    [22,20,19,17,16,15,11,10,8,7]
--    (1.25 secs, 1,082,690,216 bytes)
--    λ> enumeracionCFN3 !! (6*10^6)
--    [22,20,19,17,16,15,11,10,8,7]
--    (0.38 secs, 960,134,256 bytes)

-- Propiedades
-- ===========

-- La primera propiedad es
prop_enumeracionCFN :: Int -> Property
prop_enumeracionCFN n =
  n >= 0 ==> xs < ys
  where (xs:ys:_) = drop n enumeracionCFN

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

-- La segunda propiedad es
prop_completa :: [Integer] -> Bool
prop_completa xs =
  xs' `elem` enumeracionCFN
  where xs' = reverse (sort (nub (map abs xs)))

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

import Data.List (genericLength, nub, sort)

import Test.QuickCheck

-- 1ª solución

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

enumeracionCFN :: [[Integer]]

enumeracionCFN = concatMap enumeracionCFNHasta [0..]

-- (enumeracionCFNHasta n) es la lista de conjuntos con la enumeración

-- anterior cuyo primer elemento es n. Por ejemplo,

-- λ> enumeracionCFNHasta 1

-- [[1],[1,0]]

-- λ> enumeracionCFNHasta 2

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

-- λ> enumeracionCFNHasta 3

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

enumeracionCFNHasta :: Integer -> [[Integer]]

enumeracionCFNHasta 0 = [[],[0]]

enumeracionCFNHasta n =

[n:xs | k <- [0..n-1], xs <- enumeracionCFNHasta k]

-- 2ª solución

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

enumeracionCFN2 :: [[Integer]]

enumeracionCFN2 = [] : aux 0 [[]]

where aux n xs = yss ++ aux (n+1) (xs ++ yss)

where yss = map (n:) xs

-- 3ª solución

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

enumeracionCFN3 :: [[Integer]]

enumeracionCFN3 = map conjunto [0..]

-- (conjunto n) es el conjunto en la posición n. Por ejemplo,

-- conjunto 6 == [2,1]

conjunto :: Integer -> [Integer]

conjunto n = reverse [x | (x,y) <- zip [0..] (binario n), y == 1]

-- (binario n) es la representación binarioa del número n (en orden

-- inverso). Por ejemplo,

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

binario :: Integer -> [Integer]

binario 0 = [0]

binario 1 = [1]

binario n = n `mod` 2 : binario (n `div` 2)

-- Comparación de eficiencia

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

-- λ> enumeracionCFN !! (4*10^5)

-- [18,17,12,11,9,7]

-- (1.18 secs, 576,924,344 bytes)

-- λ> enumeracionCFN2 !! (4*10^5)

-- [18,17,12,11,9,7]

-- (0.10 secs, 72,399,784 bytes)

-- λ> enumeracionCFN3 !! (4*10^5)

-- [18,17,12,11,9,7]

-- (0.07 secs, 64,123,952 bytes)

-- λ> enumeracionCFN2 !! (6*10^6)

-- [22,20,19,17,16,15,11,10,8,7]

-- (1.25 secs, 1,082,690,216 bytes)

-- λ> enumeracionCFN3 !! (6*10^6)

-- [22,20,19,17,16,15,11,10,8,7]

-- (0.38 secs, 960,134,256 bytes)

-- Propiedades

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

-- La primera propiedad es

prop_enumeracionCFN :: Int -> Property

prop_enumeracionCFN n =

n >= 0 ==> xs < ys

where (xs:ys:_) = drop n enumeracionCFN

-- La comprobación es

-- λ> quickCheck prop_enumeracionCFN

-- +++ OK, passed 100 tests.

-- La segunda propiedad es

prop_completa :: [Integer] -> Bool

prop_completa xs =

xs' `elem` enumeracionCFN

where xs' = reverse (sort (nub (map abs xs)))

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=15}) prop_completa

-- +++ OK, passed 100 tests.

Pensamiento

Junto al agua fría,
en la senda clara,
sombra dará algún día,
ese arbolillo en que nadie repara.

Antonio Machado

Infinitud de primos gemelos

PorJosé A. Alonso 24-diciembre-201931-diciembre-2019

Un par de números primos (p,q) es un par de números primos gemelos si su distancia de 2; es decir, si q = p+2. Por ejemplo, (17,19) es una par de números primos gemelos.

La conjetura de los primos gemelos postula la existencia de infinitos pares de primos gemelos.

Definir la constante

   primosGemelos :: [(Integer,Integer)]

1	primosGemelos :: [(Integer,Integer)]

tal que sus elementos son los pares de primos gemelos. Por ejemplo,

   λ> take 7 primosGemelos
   [(3,5),(5,7),(11,13),(17,19),(29,31),(41,43),(59,61)]
   λ> primosGemelos !! (4*10^4)
   (6381911,6381913)

λ> take 7 primosGemelos

[(3,5),(5,7),(11,13),(17,19),(29,31),(41,43),(59,61)]

λ> primosGemelos !! (4*10^4)

(6381911,6381913)

Comprobar con QuickCheck la conjetura de los primos gemelos.

Soluciones

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

-- 1ª solución
primosGemelos :: [(Integer,Integer)]
primosGemelos = [(x,x+2) | x <- primes, isPrime (x+2)]

-- 2ª solución
primosGemelos2 :: [(Integer,Integer)]
primosGemelos2 = [(x,y) | (x,y) <- zip primes (tail primes)
                        , y - x == 2]

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

--    λ> primosGemelos !! (2*10^4)
--    (2840447,2840449)
--    (3.93 secs, 12,230,474,952 bytes)
--    λ> primosGemelos2 !! (2*10^4)
--    (2840447,2840449)
--    (0.77 secs, 2,202,822,456 bytes)

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

-- La propiedad es
prop_primosGemelos :: Integer -> Property
prop_primosGemelos n =
  n >= 0 ==> not (null [(x,y) | (x,y) <- primosGemelos2, x > n])

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

import Data.Numbers.Primes (primes, isPrime)

import Test.QuickCheck

-- 1ª solución

primosGemelos :: [(Integer,Integer)]

primosGemelos = [(x,x+2) | x <- primes, isPrime (x+2)]

-- 2ª solución

primosGemelos2 :: [(Integer,Integer)]

primosGemelos2 = [(x,y) | (x,y) <- zip primes (tail primes)

, y - x == 2]

-- Comparación de eficiencia

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

-- λ> primosGemelos !! (2*10^4)

-- (2840447,2840449)

-- (3.93 secs, 12,230,474,952 bytes)

-- λ> primosGemelos2 !! (2*10^4)

-- (2840447,2840449)

-- (0.77 secs, 2,202,822,456 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_primosGemelos :: Integer -> Property

prop_primosGemelos n =

n >= 0 ==> not (null [(x,y) | (x,y) <- primosGemelos2, x > n])

-- La comprobación es

-- λ> quickCheck prop_primosGemelos

-- +++ OK, passed 100 tests.

Pensamiento

El sentimiento ha de tener tanto de individual como de genérico; debe orientarse hacia valores universales, o que pretenden serlo.

Antonio Machado

Soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Referencia

Pensamiento

Soluciones

Referencia

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Referencias

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico