Ejercicio – Página 5

Suma de múltiplos de 3 o de 5

PorJosé A. Alonso 9-febrero-202223-febrero-2022

Los números naturales menores que 10 que son múltiplos de 3 ó 5 son 3, 5, 6 y 9. La suma de estos múltiplos es 23.

Definir la función

   sumaMultiplos :: Integer -> Integer

1	sumaMultiplos :: Integer -> Integer

tal que (sumaMultiplos n) es la suma de todos los múltiplos de 3 ó 5 menores que n. Por ejemplo,

   sumaMultiplos 10      ==  23
   sumaMultiplos (10^2)  ==  2318
   sumaMultiplos (10^3)  ==  233168
   sumaMultiplos (10^4)  ==  23331668
   sumaMultiplos (10^5)  ==  2333316668
   sumaMultiplos (10^6)  ==  233333166668
   sumaMultiplos (10^7)  ==  23333331666668

sumaMultiplos 10 == 23

sumaMultiplos (10^2) == 2318

sumaMultiplos (10^3) == 233168

sumaMultiplos (10^4) == 23331668

sumaMultiplos (10^5) == 2333316668

sumaMultiplos (10^6) == 233333166668

sumaMultiplos (10^7) == 23333331666668

Soluciones

import Data.List (nub, union)
import Test.QuickCheck (Positive(..), quickCheck)

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

sumaMultiplos1 :: Integer -> Integer
sumaMultiplos1 n = sum [x | x <- [1..n-1], multiplo x 3 || multiplo x 5]

-- (multiplo x y) se verifica si x es múltiplo de y. Por ejemplo,
--    multiplo 6 3  ==  True
--    multiplo 6 4  ==  False
multiplo :: Integer -> Integer -> Bool
multiplo x y = mod x y == 0

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

sumaMultiplos2 :: Integer -> Integer
sumaMultiplos2 n = sum [x | x <- [1..n-1], gcd x 15 > 1]

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

sumaMultiplos3 :: Integer -> Integer
sumaMultiplos3 n = sum [3,6..n-1] + sum [5,10..n-1] - sum [15,30..n-1]

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

sumaMultiplos4 :: Integer -> Integer
sumaMultiplos4 n = sum (nub ([3,6..n-1] ++ [5,10..n-1]))

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

sumaMultiplos5 :: Integer -> Integer
sumaMultiplos5 n = sum ([3,6..n-1] `union` [5,10..n-1])

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

sumaMultiplos6 :: Integer -> Integer
sumaMultiplos6 n = suma 3 n + suma 5 n - suma 15 n

-- (suma d x) es la suma de los múltiplos de d menores que x. Por
-- ejemplo,
--    suma 3 10  ==  18
--    suma 5 10  ==  5
suma :: Integer -> Integer -> Integer
suma d x = (a+b)*n `div` 2
    where a = d
          b = d * ((x-1) `div` d)
          n = 1 + (b-a) `div` d

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

-- La propiedad es
prop_sumaMultiplos :: Positive Integer -> Bool
prop_sumaMultiplos (Positive n) =
  all (== (sumaMultiplos1 n))
      [f n | f <- [sumaMultiplos1,
                   sumaMultiplos2,
                   sumaMultiplos3,
                   sumaMultiplos4,
                   sumaMultiplos5,
                   sumaMultiplos6]]

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

-- La comparación es
--    λ> sumaMultiplos1 (5*10^4)
--    583291668
--    (0.05 secs, 21,446,456 bytes)
--    λ> sumaMultiplos2 (5*10^4)
--    583291668
--    (0.05 secs, 26,804,944 bytes)
--    λ> sumaMultiplos3 (5*10^4)
--    583291668
--    (0.01 secs, 5,136,728 bytes)
--    λ> sumaMultiplos4 (5*10^4)
--    583291668
--    (3.05 secs, 7,474,304 bytes)
--    λ> sumaMultiplos5 (5*10^4)
--    583291668
--    (5.14 secs, 12,787,717,152 bytes)
--    λ> sumaMultiplos6 (5*10^4)
--    583291668
--    (0.01 secs, 108,448 bytes)
--
--    λ> sumaMultiplos1 (3*10^6)
--    2099998500000
--    (2.14 secs, 1,281,805,696 bytes)
--    λ> sumaMultiplos2 (3*10^6)
--    2099998500000
--    (1.86 secs, 1,603,407,272 bytes)
--    λ> sumaMultiplos3 (3*10^6)
--    2099998500000
--    (0.39 secs, 304,681,080 bytes)
--    λ> sumaMultiplos6 (3*10^6)
--    2099998500000
--    (0.01 secs, 112,544 bytes)
--
--    λ> sumaMultiplos3 (10^7)
--    23333331666668
--    (1.69 secs, 1,015,468,352 bytes)
--    λ> sumaMultiplos6 (10^7)
--    23333331666668
--    (0.01 secs, 112,336 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

import Data.List (nub, union)

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

-- 1ª solución

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

sumaMultiplos1 :: Integer -> Integer

sumaMultiplos1 n = sum [x | x <- [1..n-1], multiplo x 3 || multiplo x 5]

-- (multiplo x y) se verifica si x es múltiplo de y. Por ejemplo,

-- multiplo 6 3 == True

-- multiplo 6 4 == False

multiplo :: Integer -> Integer -> Bool

multiplo x y = mod x y == 0

-- 2ª solución --

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

sumaMultiplos2 :: Integer -> Integer

sumaMultiplos2 n = sum [x | x <- [1..n-1], gcd x 15 > 1]

-- 3ª solución --

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

sumaMultiplos3 :: Integer -> Integer

sumaMultiplos3 n = sum [3,6..n-1] + sum [5,10..n-1] - sum [15,30..n-1]

-- 4ª solución --

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

sumaMultiplos4 :: Integer -> Integer

sumaMultiplos4 n = sum (nub ([3,6..n-1] ++ [5,10..n-1]))

-- 5ª solución --

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

sumaMultiplos5 :: Integer -> Integer

sumaMultiplos5 n = sum ([3,6..n-1] `union` [5,10..n-1])

-- 6ª solución --

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

sumaMultiplos6 :: Integer -> Integer

sumaMultiplos6 n = suma 3 n + suma 5 n - suma 15 n

-- (suma d x) es la suma de los múltiplos de d menores que x. Por

-- ejemplo,

-- suma 3 10 == 18

-- suma 5 10 == 5

suma :: Integer -> Integer -> Integer

suma d x = (a+b)*n `div` 2

where a = d

b = d * ((x-1) `div` d)

n = 1 + (b-a) `div` d

-- Equivalencia de definiciones

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

-- La propiedad es

prop_sumaMultiplos :: Positive Integer -> Bool

prop_sumaMultiplos (Positive n) =

all (== (sumaMultiplos1 n))

[f n | f <- [sumaMultiplos1,

sumaMultiplos2,

sumaMultiplos3,

sumaMultiplos4,

sumaMultiplos5,

sumaMultiplos6]]

-- Comparación de eficiencia

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

-- La comparación es

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

-- 583291668

-- (0.05 secs, 21,446,456 bytes)

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

-- 583291668

-- (0.05 secs, 26,804,944 bytes)

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

-- 583291668

-- (0.01 secs, 5,136,728 bytes)

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

-- 583291668

-- (3.05 secs, 7,474,304 bytes)

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

-- 583291668

-- (5.14 secs, 12,787,717,152 bytes)

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

-- 583291668

-- (0.01 secs, 108,448 bytes)

-- λ> sumaMultiplos1 (3*10^6)

-- 2099998500000

-- (2.14 secs, 1,281,805,696 bytes)

-- λ> sumaMultiplos2 (3*10^6)

-- 2099998500000

-- (1.86 secs, 1,603,407,272 bytes)

-- λ> sumaMultiplos3 (3*10^6)

-- 2099998500000

-- (0.39 secs, 304,681,080 bytes)

-- λ> sumaMultiplos6 (3*10^6)

-- 2099998500000

-- (0.01 secs, 112,544 bytes)

-- λ> sumaMultiplos3 (10^7)

-- 23333331666668

-- (1.69 secs, 1,015,468,352 bytes)

-- λ> sumaMultiplos6 (10^7)

-- 23333331666668

-- (0.01 secs, 112,336 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.

Número de ocurrencias de elementos

PorJosé A. Alonso 7-febrero-202223-febrero-2022

Definir la función

   ocurrenciasElementos :: Ord a => [a] -> [(a,Int)]

1	ocurrenciasElementos :: Ord a => [a] -> [(a,Int)]

tal que (ocurrencias xs) es el conjunto de los elementos de xs junto con sus números de ocurrencias. Por ejemplo,

   ocurrenciasElementos1 [3,2,3,1,2,3,5,3] == [(3,4),(2,2),(1,1),(5,1)]
   ocurrenciasElementos1 "tictac"          == [('t',2),('i',1),('c',2),('a',1)]

1 2	ocurrenciasElementos1 [3,2,3,1,2,3,5,3] == [(3,4),(2,2),(1,1),(5,1)] ocurrenciasElementos1 "tictac" == [('t',2),('i',1),('c',2),('a',1)]

Soluciones

import Data.List (group, nub, sort)
import Data.Maybe (fromJust)
import qualified Data.Map as M
import Test.QuickCheck

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

ocurrenciasElementos1 :: Ord a => [a] -> [(a,Int)]
ocurrenciasElementos1 xs =
  [(x,ocurrencias x xs) | x <- nub xs]

-- (ocurrencias x xs) es el número de ocurrencias de x en xs. Por
-- ejemplo,
--    ocurrencias 'a' "Salamanca"  ==  4
ocurrencias :: Ord a => a -> [a] -> Int
ocurrencias x xs = length (filter (==x) xs)

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

ocurrenciasElementos2 :: Ord a => [a] -> [(a,Int)]
ocurrenciasElementos2 xs = map ocurrencias (nub xs)
  where ocurrencias x = (x,fromJust (lookup x (frecuencias xs)))

-- (frecuencias xs) es la lista ordenada de los elementos de xs juntos
-- con sus números de ocurrencias. Por ejemplo,
--    frecuencias [3,2,3,1,2,3,5,3]  ==  [(1,1),(2,2),(3,4),(5,1)]
frecuencias :: Ord a => [a] -> [(a, Int)]
frecuencias xs = [(head ys, length ys) | ys <- group (sort xs)]

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

ocurrenciasElementos3 :: Ord a => [a] -> [(a,Int)]
ocurrenciasElementos3 xs = map ocurrencias (nub xs)
  where diccionario   = dicFrecuencias xs
        ocurrencias x = (x, diccionario M.! x)

-- (dicFrecuencias xs) es el diccionario de los elementos de xs juntos
-- con sus números de ocurrencias. Por ejemplo,
--    λ> dicFrecuencias [3,2,3,1,2,3,5,3]
--    fromList [(1,1),(2,2),(3,4),(5,1)]
dicFrecuencias :: Ord a => [a] -> M.Map a Int
dicFrecuencias xs = M.fromListWith (+) (zip xs (repeat 1))

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

ocurrenciasElementos4 :: Ord a => [a] -> [(a,Int)]
ocurrenciasElementos4 = foldl aux []
  where
    aux [] y                     = [(y,1)]
    aux ((x,k):xs) y | x == y    = (x, k + 1) : xs
                     | otherwise = (x, k) : aux xs y

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

-- La propiedad es
prop_ocurrenciasElementos :: [Integer] -> Bool
prop_ocurrenciasElementos xs =
  all (== (ocurrenciasElementos1 xs))
      [f xs | f <- [ocurrenciasElementos2,
                    ocurrenciasElementos3,
                    ocurrenciasElementos4]]

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

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

-- La comparación es
--    λ> last (ocurrenciasElementos1 (show (product [1..10^5])))
--    ('5',42935)
--    (7.93 secs, 11,325,169,512 bytes)
--    λ> last (ocurrenciasElementos2 (show (product [1..10^5])))
--    ('5',42935)
--    (8.46 secs, 11,750,911,592 bytes)
--    λ> last (ocurrenciasElementos3 (show (product [1..10^5])))
--    ('5',42935)
--    (8.29 secs, 11,447,015,896 bytes)
--    λ> last (ocurrenciasElementos4 (show (product [1..10^5])))
--    ('5',42935)
--    (9.97 secs, 12,129,527,912 bytes)

import Data.List (group, nub, sort)

import Data.Maybe (fromJust)

import qualified Data.Map as M

import Test.QuickCheck

-- 1ª solución

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

ocurrenciasElementos1 :: Ord a => [a] -> [(a,Int)]

ocurrenciasElementos1 xs =

[(x,ocurrencias x xs) | x <- nub xs]

-- (ocurrencias x xs) es el número de ocurrencias de x en xs. Por

-- ejemplo,

-- ocurrencias 'a' "Salamanca" == 4

ocurrencias :: Ord a => a -> [a] -> Int

ocurrencias x xs = length (filter (==x) xs)

-- 2ª solución

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

ocurrenciasElementos2 :: Ord a => [a] -> [(a,Int)]

ocurrenciasElementos2 xs = map ocurrencias (nub xs)

where ocurrencias x = (x,fromJust (lookup x (frecuencias xs)))

-- (frecuencias xs) es la lista ordenada de los elementos de xs juntos

-- con sus números de ocurrencias. Por ejemplo,

-- frecuencias [3,2,3,1,2,3,5,3] == [(1,1),(2,2),(3,4),(5,1)]

frecuencias :: Ord a => [a] -> [(a, Int)]

frecuencias xs = [(head ys, length ys) | ys <- group (sort xs)]

-- 3ª solución

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

ocurrenciasElementos3 :: Ord a => [a] -> [(a,Int)]

ocurrenciasElementos3 xs = map ocurrencias (nub xs)

where diccionario = dicFrecuencias xs

ocurrencias x = (x, diccionario M.! x)

-- (dicFrecuencias xs) es el diccionario de los elementos de xs juntos

-- con sus números de ocurrencias. Por ejemplo,

-- λ> dicFrecuencias [3,2,3,1,2,3,5,3]

-- fromList [(1,1),(2,2),(3,4),(5,1)]

dicFrecuencias :: Ord a => [a] -> M.Map a Int

dicFrecuencias xs = M.fromListWith (+) (zip xs (repeat 1))

-- 4ª solución

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

ocurrenciasElementos4 :: Ord a => [a] -> [(a,Int)]

ocurrenciasElementos4 = foldl aux []

where

aux [] y = [(y,1)]

aux ((x,k):xs) y | x == y = (x, k + 1) : xs

| otherwise = (x, k) : aux xs y

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_ocurrenciasElementos :: [Integer] -> Bool

prop_ocurrenciasElementos xs =

all (== (ocurrenciasElementos1 xs))

[f xs | f <- [ocurrenciasElementos2,

ocurrenciasElementos3,

ocurrenciasElementos4]]

-- La comprobación es

-- λ> quickCheck prop_ocurrenciasElementos

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> last (ocurrenciasElementos1 (show (product [1..10^5])))

-- ('5',42935)

-- (7.93 secs, 11,325,169,512 bytes)

-- λ> last (ocurrenciasElementos2 (show (product [1..10^5])))

-- ('5',42935)

-- (8.46 secs, 11,750,911,592 bytes)

-- λ> last (ocurrenciasElementos3 (show (product [1..10^5])))

-- ('5',42935)

-- (8.29 secs, 11,447,015,896 bytes)

-- λ> last (ocurrenciasElementos4 (show (product [1..10^5])))

-- ('5',42935)

-- (9.97 secs, 12,129,527,912 bytes)

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.

Producto de los elementos de la diagonal principal

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

Las matrices se pueden representar como lista de listas de la misma longitud, donde cada uno de sus elementos representa una fila de la matriz.

Definir la función

   productoDiagonalPrincipal :: Num a => [[a]] -> a

1	productoDiagonalPrincipal :: Num a => [[a]] -> a

tal que (productoDiagonalPrincipal xss) es el producto de los elementos de la diagonal principal de la matriz cuadrada xss. Por ejemplo,

   productoDiagonal1 [[3,5,2],[4,7,1],[6,9,8]]  ==  168
   productoDiagonal1 (replicate 5 [1..5])       ==  120
   length (show (productoDiagonal3 (replicate 30000 [1..30000])))  ==  121288

productoDiagonal1 [[3,5,2],[4,7,1],[6,9,8]] == 168

productoDiagonal1 (replicate 5 [1..5]) == 120

length (show (productoDiagonal3 (replicate 30000 [1..30000]))) == 121288

Soluciones

import Data.List (genericReplicate)

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

productoDiagonal1 :: Num a => [[a]] -> a
productoDiagonal1 xss = product (diagonal1 xss)

-- (diagonal1 xss) es la diagonal de la matriz xss. Por ejemplo,
--    diagonal1 [[3,5,2],[4,7,1],[6,9,0]]  ==  [3,7,0]
--    diagonal1 [[3,5],[4,7],[6,9]]        ==  [3,7]
--    diagonal1 [[3,5,2],[4,7,1]]          ==  [3,7]
diagonal1 :: [[a]] -> [a]
diagonal1 ((x:_):xss) = x : diagonal1 (map tail xss)
diagonal1 _           = []

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

productoDiagonal2 :: Num a => [[a]] -> a
productoDiagonal2 = product . diagonal1

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

productoDiagonal3 :: Num a => [[a]] -> a
productoDiagonal3 = product . diagonal3

diagonal3 :: [[a]] -> [a]
diagonal3 xss = [xs !! k | (xs,k) <- zip xss [0..n]]
  where n = length (head xss) - 1

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

productoDiagonal4 :: Num a => [[a]] -> a
productoDiagonal4 []          = 1
productoDiagonal4 [[]]        = 1
productoDiagonal4 ((x:_):xss) = x * productoDiagonal4 (map tail xss)

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

productoDiagonal5 :: Num a => [[a]] -> a
productoDiagonal5 xss = product (zipWith (!!) xss [0..k])
  where m = length xss
        n = length (head xss)
        k = min m n - 1

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

ejemplo :: Integer -> [[Integer]]
ejemplo n = genericReplicate n [1..n]

-- La comparación es
--    λ> length (show (productoDiagonal1 (ejemplo 7000)))
--    23878
--    (1.23 secs, 3,396,129,424 bytes)
--    λ> length (show (productoDiagonal2 (ejemplo 7000)))
--    23878
--    (0.94 secs, 3,396,127,680 bytes)
--    λ> length (show (productoDiagonal3 (ejemplo 7000)))
--    23878
--    (0.09 secs, 44,841,864 bytes)
--    λ> length (show (productoDiagonal4 (ejemplo 7000)))
--    23878
--    (0.96 secs, 3,614,137,840 bytes)
--    λ> length (show (productoDiagonal5 (ejemplo 7000)))
--    23878
--    (0.07 secs, 44,168,984 bytes)
--
--    λ> length (show (productoDiagonal3 (ejemplo 70000)))
--    308760
--    (8.26 secs, 5,359,752,408 bytes)
--    λ> length (show (productoDiagonal5 (ejemplo 70000)))
--    308760
--    (9.34 secs, 5,353,035,656 bytes)

import Data.List (genericReplicate)

-- 1ª solución

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

productoDiagonal1 :: Num a => [[a]] -> a

productoDiagonal1 xss = product (diagonal1 xss)

-- (diagonal1 xss) es la diagonal de la matriz xss. Por ejemplo,

-- diagonal1 [[3,5,2],[4,7,1],[6,9,0]] == [3,7,0]

-- diagonal1 [[3,5],[4,7],[6,9]] == [3,7]

-- diagonal1 [[3,5,2],[4,7,1]] == [3,7]

diagonal1 :: [[a]] -> [a]

diagonal1 ((x:_):xss) = x : diagonal1 (map tail xss)

diagonal1 _ = []

-- 2ª solución

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

productoDiagonal2 :: Num a => [[a]] -> a

productoDiagonal2 = product . diagonal1

-- 3ª solución

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

productoDiagonal3 :: Num a => [[a]] -> a

productoDiagonal3 = product . diagonal3

diagonal3 :: [[a]] -> [a]

diagonal3 xss = [xs !! k | (xs,k) <- zip xss [0..n]]

where n = length (head xss) - 1

-- 4ª solución

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

productoDiagonal4 :: Num a => [[a]] -> a

productoDiagonal4 [] = 1

productoDiagonal4 [[]] = 1

productoDiagonal4 ((x:_):xss) = x * productoDiagonal4 (map tail xss)

-- 5ª solución

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

productoDiagonal5 :: Num a => [[a]] -> a

productoDiagonal5 xss = product (zipWith (!!) xss [0..k])

where m = length xss

n = length (head xss)

k = min m n - 1

-- Comparación de eficiencia

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

ejemplo :: Integer -> [[Integer]]

ejemplo n = genericReplicate n [1..n]

-- La comparación es

-- λ> length (show (productoDiagonal1 (ejemplo 7000)))

-- 23878

-- (1.23 secs, 3,396,129,424 bytes)

-- λ> length (show (productoDiagonal2 (ejemplo 7000)))

-- 23878

-- (0.94 secs, 3,396,127,680 bytes)

-- λ> length (show (productoDiagonal3 (ejemplo 7000)))

-- 23878

-- (0.09 secs, 44,841,864 bytes)

-- λ> length (show (productoDiagonal4 (ejemplo 7000)))

-- 23878

-- (0.96 secs, 3,614,137,840 bytes)

-- λ> length (show (productoDiagonal5 (ejemplo 7000)))

-- 23878

-- (0.07 secs, 44,168,984 bytes)

-- λ> length (show (productoDiagonal3 (ejemplo 70000)))

-- 308760

-- (8.26 secs, 5,359,752,408 bytes)

-- λ> length (show (productoDiagonal5 (ejemplo 70000)))

-- 308760

-- (9.34 secs, 5,353,035,656 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.

Suma de una fila del triángulo de los impares

PorJosé A. Alonso 1-febrero-202223-febrero-2022

Se condidera el siguiente triángulo de números impares

                1
             3     5
          7     9    11
      13    15    17    19
   21    23    25    27    29
................................

3 5

7 9 11

13 15 17 19

21 23 25 27 29

................................

Definir la función

   sumaFilaTrianguloImpares :: Integer -> Integer

1	sumaFilaTrianguloImpares :: Integer -> Integer

tal que (sumaFilaTrianguloImpares n) es la suma de la n-ésima fila del triángulo de los números impares. Por ejemplo,

   sumaFilaTrianguloImpares 1  ==  1
   sumaFilaTrianguloImpares 2  ==  8
   length (show (sumaFilaTrianguloImpares (10^500)))    ==  1501
   length (show (sumaFilaTrianguloImpares (10^5000)))   ==  15001
   length (show (sumaFilaTrianguloImpares (10^50000)))  ==  150001

sumaFilaTrianguloImpares 1 == 1

sumaFilaTrianguloImpares 2 == 8

length (show (sumaFilaTrianguloImpares (10^500))) == 1501

length (show (sumaFilaTrianguloImpares (10^5000))) == 15001

length (show (sumaFilaTrianguloImpares (10^50000))) == 150001

Soluciones

import Test.QuickCheck

-- 1ª solución
sumaFilaTrianguloImpares1 :: Integer -> Integer
sumaFilaTrianguloImpares1 n =
  sum [n^2-n+1, n^2-n+3 .. n^2+n-1]

-- 2ª solución
sumaFilaTrianguloImpares2 :: Integer -> Integer
sumaFilaTrianguloImpares2 = (^3)

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

-- La propiedad es
prop_sumaFilaTrianguloImpares :: Integer -> Property
prop_sumaFilaTrianguloImpares n =
  n > 0 ==> sumaFilaTrianguloImpares1 n == sumaFilaTrianguloImpares2 n

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

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

-- La comparación es
--    λ> length (show (sumaFilaTrianguloImpares1 (10^7)))
--    22
--    (2.91 secs, 2,167,239,232 bytes)
--    λ> length (show (sumaFilaTrianguloImpares2 (10^7)))
--    22
--    (0.01 secs, 102,584 bytes)

import Test.QuickCheck

-- 1ª solución

sumaFilaTrianguloImpares1 :: Integer -> Integer

sumaFilaTrianguloImpares1 n =

sum [n^2-n+1, n^2-n+3 .. n^2+n-1]

-- 2ª solución

sumaFilaTrianguloImpares2 :: Integer -> Integer

sumaFilaTrianguloImpares2 = (^3)

-- Equivalencia

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

-- La propiedad es

prop_sumaFilaTrianguloImpares :: Integer -> Property

prop_sumaFilaTrianguloImpares n =

n > 0 ==> sumaFilaTrianguloImpares1 n == sumaFilaTrianguloImpares2 n

-- La comprobación es

-- λ> quickCheck prop_sumaFilaTrianguloImpares

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (show (sumaFilaTrianguloImpares1 (10^7)))

-- 22

-- (2.91 secs, 2,167,239,232 bytes)

-- λ> length (show (sumaFilaTrianguloImpares2 (10^7)))

-- 22

-- (0.01 secs, 102,584 bytes)

El código se encuentra en GitHub.

Duplicación de cada elemento

PorJosé A. Alonso 31-enero-202223-febrero-2022

Definir la función

   duplicaElementos :: [a] -> [a]

1	duplicaElementos :: [a] -> [a]

tal que (duplicaElementos xs) es la lista obtenida duplicando cada elemento de xs. Por ejemplo,

   duplicaElementos1 [3,2,5]    ==  [3,3,2,2,5,5]
   duplicaElementos1 "Haskell"  ==  "HHaasskkeellll"

1 2	duplicaElementos1 [3,2,5] == [3,3,2,2,5,5] duplicaElementos1 "Haskell" == "HHaasskkeellll"

Soluciones

import Test.QuickCheck

--  1ª solución
duplicaElementos1 :: [a] -> [a]
duplicaElementos1 [] = []
duplicaElementos1 (x:xs) = x : x : duplicaElementos1 xs

-- 2 solución
duplicaElementos2 :: [a] -> [a]
duplicaElementos2 = foldr (\x ys -> x:x:ys) []

-- 3ª solución
duplicaElementos3 :: [a] -> [a]
duplicaElementos3 xs = concat [[x,x] | x <- xs]

-- 4ª solución
duplicaElementos4 :: [a] -> [a]
duplicaElementos4 xs = concat (map (replicate 2) xs)

-- 5ª solución
duplicaElementos5 :: [a] -> [a]
duplicaElementos5 = concatMap (replicate 2)

-- 6ª solución
duplicaElementos6 :: [a] -> [a]
duplicaElementos6 = (>>= replicate 2)

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

-- La propiedad es
prop_duplicaElementos :: [Int] -> Bool
prop_duplicaElementos xs =
  all (== (duplicaElementos1 xs))
      [f xs | f <- [duplicaElementos2,
                    duplicaElementos3,
                    duplicaElementos4,
                    duplicaElementos5,
                    duplicaElementos6]]

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

import Test.QuickCheck

-- 1ª solución

duplicaElementos1 :: [a] -> [a]

duplicaElementos1 [] = []

duplicaElementos1 (x:xs) = x : x : duplicaElementos1 xs

-- 2 solución

duplicaElementos2 :: [a] -> [a]

duplicaElementos2 = foldr (\x ys -> x:x:ys) []

-- 3ª solución

duplicaElementos3 :: [a] -> [a]

duplicaElementos3 xs = concat [[x,x] | x <- xs]

-- 4ª solución

duplicaElementos4 :: [a] -> [a]

duplicaElementos4 xs = concat (map (replicate 2) xs)

-- 5ª solución

duplicaElementos5 :: [a] -> [a]

duplicaElementos5 = concatMap (replicate 2)

-- 6ª solución

duplicaElementos6 :: [a] -> [a]

duplicaElementos6 = (>>= replicate 2)

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_duplicaElementos :: [Int] -> Bool

prop_duplicaElementos xs =

all (== (duplicaElementos1 xs))

[f xs | f <- [duplicaElementos2,

duplicaElementos3,

duplicaElementos4,

duplicaElementos5,

duplicaElementos6]]

-- La comprobación es

-- λ> quickCheck prop_duplicaElementos

-- +++ OK, passed 100 tests.

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.

Suma de cadenas

PorJosé A. Alonso 27-enero-202223-febrero-2022

Definir la función

   sumaCadenas :: String -> String -> String

1	sumaCadenas :: String -> String -> String

tal que (sumaCadenas xs ys) es la cadena formada por el número entero que es la suma de los números enteros cuyas cadenas que lo representan son xs e ys; además, se supone que la cadena vacía representa al cero. Por ejemplo,

   sumaCadenas "2"   "6"  == "8"
   sumaCadenas "14"  "2"  == "16"
   sumaCadenas "14"  "-5" == "9"
   sumaCadenas "-14" "-5" == "-19"
   sumaCadenas "5"   "-5" == "0"
   sumaCadenas ""    "5"  == "5"
   sumaCadenas "6"   ""   == "6"
   sumaCadenas ""    ""   == "0"

sumaCadenas "2" "6" == "8"

sumaCadenas "14" "2" == "16"

sumaCadenas "14" "-5" == "9"

sumaCadenas "-14" "-5" == "-19"

sumaCadenas "5" "-5" == "0"

sumaCadenas "" "5" == "5"

sumaCadenas "6" "" == "6"

sumaCadenas "" "" == "0"

Soluciones

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

sumaCadenas1 :: String -> String -> String
sumaCadenas1 xs ys =
  show (sum (map read (filter (not . null) [xs, ys])))

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

sumaCadenas2 :: String -> String -> String
sumaCadenas2 =
  ((show . sum . map read . filter (not . null)) .) . (. return) . (:)

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

sumaCadenas3 :: String -> String -> String
sumaCadenas3 "" "" = "0"
sumaCadenas3 "" ys = ys
sumaCadenas3 xs "" = xs
sumaCadenas3 xs ys = show (read xs + read ys)

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

sumaCadenas4 :: String -> String -> String
sumaCadenas4 xs ys = show (numero xs + numero ys)

-- (numero xs) es el número entero representado por la cadena xs
-- suponiendo que la cadena vacía representa al cero.. Por ejemplo,
--    numero "12"   ==  12
--    numero "-12"  ==  -12
--    numero "0"    ==  0
--    numero ""     ==  0
numero :: String -> Int
numero "" = 0
numero xs = read xs

-- 1ª solución

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

sumaCadenas1 :: String -> String -> String

sumaCadenas1 xs ys =

show (sum (map read (filter (not . null) [xs, ys])))

-- 2ª solución

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

sumaCadenas2 :: String -> String -> String

sumaCadenas2 =

((show . sum . map read . filter (not . null)) .) . (. return) . (:)

-- 3ª solución

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

sumaCadenas3 :: String -> String -> String

sumaCadenas3 "" "" = "0"

sumaCadenas3 "" ys = ys

sumaCadenas3 xs "" = xs

sumaCadenas3 xs ys = show (read xs + read ys)

-- 4ª solución

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

sumaCadenas4 :: String -> String -> String

sumaCadenas4 xs ys = show (numero xs + numero ys)

-- (numero xs) es el número entero representado por la cadena xs

-- suponiendo que la cadena vacía representa al cero.. Por ejemplo,

-- numero "12" == 12

-- numero "-12" == -12

-- numero "0" == 0

-- numero "" == 0

numero :: String -> Int

numero "" = 0

numero xs = read xs

El código se encuentra en GitHub.

Cuadrado más cercano

PorJosé A. Alonso 26-enero-202216-marzo-2022

Definir la función

   cuadradoCercano :: Integer -> Integer

1	cuadradoCercano :: Integer -> Integer

tal que (cuadradoCercano n) es el número cuadrado más cercano a n, donde n es un entero positivo. Por ejemplo,

   cuadradoCercano 2       == 1
   cuadradoCercano 6       == 4
   cuadradoCercano 8       == 9
   cuadradoCercano (10^46) == 10000000000000000000000000000000000000000000000

cuadradoCercano 2 == 1

cuadradoCercano 6 == 4

cuadradoCercano 8 == 9

cuadradoCercano (10^46) == 10000000000000000000000000000000000000000000000

Soluciones

import Test.QuickCheck

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

cuadradoCercano1 :: Integer -> Integer
cuadradoCercano1 n
  | n - b < c - n = b
  | otherwise     = c
  where a = raizEntera1 n
        b = a^2
        c = (a+1)^2

-- (raizEntera x) es el mayor entero cuyo cuadrado no es mayor que
-- x. Por ejemplo,
--    raizEntera 8   ==  2
--    raizEntera 9   ==  3
--    raizEntera 10  ==  3
raizEntera1 :: Integer -> Integer
raizEntera1 x =
  last (takeWhile (\n -> n^2 <= x) [1..])

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

cuadradoCercano2 :: Integer -> Integer
cuadradoCercano2 n
  | n - b < c - n = b
  | otherwise     = c
  where a = raizEntera2 n
        b = a^2
        c = (a+1)^2

raizEntera2 :: Integer -> Integer
raizEntera2 x = aux (1,x)
    where aux (a,b) | d == x    = c
                    | c == a    = c
                    | x <= d    = aux (a,c)
                    | otherwise = aux (c,b)
            where c = (a+b) `div` 2
                  d = c^2

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

cuadradoCercano3 :: Integer -> Integer
cuadradoCercano3 n
  | n - b < c - n = b
  | otherwise     = c
  where a = raizEntera3 n
        b = a^2
        c = (a+1)^2

raizEntera3 :: Integer -> Integer
raizEntera3 0 = 0
raizEntera3 1 = 1
raizEntera3 n = until aceptable mejora n
  where mejora x    = (x + n `div` x) `div` 2
        aceptable x = x^2 <= n

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

cuadradoCercano4 :: Integer -> Integer
cuadradoCercano4 = (^ 2) . round . sqrt . fromIntegral

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

-- La propiedad es
prop_cuadradoCercano :: Positive Integer -> Bool
prop_cuadradoCercano (Positive x) =
  all (== cuadradoCercano1 x)
      [cuadradoCercano2 x,
       cuadradoCercano3 x,
       cuadradoCercano4 x]

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

-- Aunque ha pasado los 100 tests, las definiciones no son
-- equivalentes. Por ejemplo,
--    λ> cuadradoCercano3 (10^46) == cuadradoCercano (10^46)
--    False
--    λ> cuadradoCercano3 (10^46)
--    9999999999999998322278400000000070368744177664
--    λ> cuadradoCercano (10^46)
--    10000000000000000000000000000000000000000000000

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

-- La comparación es
--    λ> cuadradoCercano1 (10^14)
--    100000000000000
--    (4.59 secs, 5,920,475,784 bytes)
--    λ> cuadradoCercano2 (10^14)
--    100000000000000
--    (0.01 secs, 512,472 bytes)
--    λ> cuadradoCercano3 (10^14)
--    100000000000000
--    (0.01 secs, 494,248 bytes)
--    λ> cuadradoCercano4 (10^14)
--    100000000000000
--    (0.01 secs, 475,152 bytes)
--
--    λ> length (show (cuadradoCercano2 (10^20000)))
--    20001
--    (3.94 secs, 1,446,675,504 bytes)
--    λ> length (show (cuadradoCercano3 (10^20000)))
--    20001
--    (4.50 secs, 926,647,904 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

import Test.QuickCheck

-- 1ª solución

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

cuadradoCercano1 :: Integer -> Integer

cuadradoCercano1 n

| n - b < c - n = b

| otherwise = c

where a = raizEntera1 n

b = a^2

c = (a+1)^2

-- (raizEntera x) es el mayor entero cuyo cuadrado no es mayor que

-- x. Por ejemplo,

-- raizEntera 8 == 2

-- raizEntera 9 == 3

-- raizEntera 10 == 3

raizEntera1 :: Integer -> Integer

raizEntera1 x =

last (takeWhile (\n -> n^2 <= x) [1..])

-- 2ª solución

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

cuadradoCercano2 :: Integer -> Integer

cuadradoCercano2 n

| n - b < c - n = b

| otherwise = c

where a = raizEntera2 n

b = a^2

c = (a+1)^2

raizEntera2 :: Integer -> Integer

raizEntera2 x = aux (1,x)

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

| c == a = c

| x <= d = aux (a,c)

| otherwise = aux (c,b)

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

d = c^2

-- 3ª solución

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

cuadradoCercano3 :: Integer -> Integer

cuadradoCercano3 n

| n - b < c - n = b

| otherwise = c

where a = raizEntera3 n

b = a^2

c = (a+1)^2

raizEntera3 :: Integer -> Integer

raizEntera3 0 = 0

raizEntera3 1 = 1

raizEntera3 n = until aceptable mejora n

where mejora x = (x + n `div` x) `div` 2

aceptable x = x^2 <= n

-- 4ª solución

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

cuadradoCercano4 :: Integer -> Integer

cuadradoCercano4 = (^ 2) . round . sqrt . fromIntegral

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_cuadradoCercano :: Positive Integer -> Bool

prop_cuadradoCercano (Positive x) =

all (== cuadradoCercano1 x)

[cuadradoCercano2 x,

cuadradoCercano3 x,

cuadradoCercano4 x]

-- La comprobación es

-- λ> quickCheck prop_cuadradoCercano

-- +++ OK, passed 100 tests.

-- Aunque ha pasado los 100 tests, las definiciones no son

-- equivalentes. Por ejemplo,

-- λ> cuadradoCercano3 (10^46) == cuadradoCercano (10^46)

-- False

-- λ> cuadradoCercano3 (10^46)

-- 9999999999999998322278400000000070368744177664

-- λ> cuadradoCercano (10^46)

-- 10000000000000000000000000000000000000000000000

-- Comparación de eficiencia

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

-- La comparación es

-- λ> cuadradoCercano1 (10^14)

-- 100000000000000

-- (4.59 secs, 5,920,475,784 bytes)

-- λ> cuadradoCercano2 (10^14)

-- 100000000000000

-- (0.01 secs, 512,472 bytes)

-- λ> cuadradoCercano3 (10^14)

-- 100000000000000

-- (0.01 secs, 494,248 bytes)

-- λ> cuadradoCercano4 (10^14)

-- 100000000000000

-- (0.01 secs, 475,152 bytes)

-- λ> length (show (cuadradoCercano2 (10^20000)))

-- 20001

-- (3.94 secs, 1,446,675,504 bytes)

-- λ> length (show (cuadradoCercano3 (10^20000)))

-- 20001

-- (4.50 secs, 926,647,904 bytes)

El código se encuentra en GitHub

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

9º curso de Exercitium (2021-22)

PorJosé A. Alonso 26-enero-202226-enero-2022

Hoy (26 de enero de 2022) comienza el noveno curso de Exercitium con los mismos objetivos

complementar el aprendizaje del curso de programación funcional con Haskell,
mantener el hábito de resolver problemas usando programación funcional con Haskell.

También el procedimiento es el mismo que en los cursos anteriores:

diariamente se propone un nuevo ejercicio,
en los comentarios se pueden escribir distintas soluciones
a los siete días de la propuesta, se publican las soluciones seleccionadas.

Tanto la publicación del enunciado como la solución se anuncian en Twitter.

En cada curso, los contenidos de los ejercicios avanzan conforme se iban introduciendo en el curso.

En la siguiente tabla se resume los cursos anteriores, donde

en la 1ª columna hay un enlace al diario de clase del curso de (las entradas están en orden cronológico inverso),
en la 2ª un enlace al primer ejercicio del curso,
en la 3ª un enlace al último ejercicio del curso y
en la 4ª el número de ejercicios propuesto en el curso.

La tabla es

Curso	Desde	Hasta	Ejercicios
2013-14	21-abril-2014	25-julio-2014	70
2014-15	30-octubre-2014	26-junio-2015	171
2015-16	21-octubre-2015	02-junio-2016	176
2016-17	03-noviembre-2016	09-junio-2017	149
2017-18	03-noviembre-2017	12-junio-2018	151
2018-19	09-noviembre-2018	10-junio-2019	143
2019-20	11-noviembre-2019	05-junio-2020	176
2020-21	12-enero-2021	24-junio-2021	110

En la tabla anterior el último enlace a los diarios de los cursos es el de 2019-10 ya que es el último curso que impartí antes de jubilarme. Por ello, aunque mantenga la misma dinámica, el número de soluciones de los alumnos de la asignatura sea menor.

Sucesiones conteniendo al producto de consecutivos

PorJosé A. Alonso 24-junio-202126-enero-2022

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1984 es

Sea c un entero positivo. La sucesión f(n) está definida por

f(1) = 1, f(2) = c, f(n+1) = 2f(n) – f(n-1) + 2 (n ≥ 2).

Demostrar que para cada k ∈ N exist un r ∈ N tal que f(k)f(k+1) = f(r).

Definir la función

   sucesion :: Integer -> [Integer]

1	sucesion :: Integer -> [Integer]

tal que los elementos de (sucesion c) son los términos de la suceción f(n) definida en el enunciado del problema. Por ejemplo,

   take 7 (sucesion 2)   ==  [1,2,5,10,17,26,37]
   take 7 (sucesion 3)   ==  [1,3,7,13,21,31,43]
   take 7 (sucesion 4)   ==  [1,4,9,16,25,36,49]
   sucesion 2 !! 30      ==  901
   sucesion 3 !! 30      ==  931
   sucesion 4 !! 30      ==  961
   sucesion 2 !! (10^2)  ==  10001
   sucesion 2 !! (10^3)  ==  1000001
   sucesion 2 !! (10^4)  ==  100000001
   sucesion 2 !! (10^5)  ==  10000000001
   sucesion 2 !! (10^6)  ==  1000000000001
   sucesion 2 !! (10^7)  ==  100000000000001
   sucesion 3 !! (10^7)  ==  100000010000001
   sucesion 4 !! (10^7)  ==  100000020000001
   sucesion 2 !! (10^8)  ==  10000000000000001
   sucesion 3 !! (10^8)  ==  10000000100000001
   sucesion 4 !! (10^8)  ==  10000000200000001
   sucesion 2 !! (10^9)  ==  1000000000000000001

take 7 (sucesion 2) == [1,2,5,10,17,26,37]

take 7 (sucesion 3) == [1,3,7,13,21,31,43]

take 7 (sucesion 4) == [1,4,9,16,25,36,49]

sucesion 2 !! 30 == 901

sucesion 3 !! 30 == 931

sucesion 4 !! 30 == 961

sucesion 2 !! (10^2) == 10001

sucesion 2 !! (10^3) == 1000001

sucesion 2 !! (10^4) == 100000001

sucesion 2 !! (10^5) == 10000000001

sucesion 2 !! (10^6) == 1000000000001

sucesion 2 !! (10^7) == 100000000000001

sucesion 3 !! (10^7) == 100000010000001

sucesion 4 !! (10^7) == 100000020000001

sucesion 2 !! (10^8) == 10000000000000001

sucesion 3 !! (10^8) == 10000000100000001

sucesion 4 !! (10^8) == 10000000200000001

sucesion 2 !! (10^9) == 1000000000000000001

Comprobar con QuickCheck que para cada k ∈ N existe un r ∈ N tal que f(k)f(k+1) = f(r).

Soluciones

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

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

sucesion :: Integer -> [Integer]
sucesion c =
  map (termino c) [1..]

termino :: Integer -> Integer -> Integer
termino c 1 = 1
termino c 2 = c
termino c n = 2 * termino c (n-1) - termino c (n-2) + 2

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

sucesion2 :: Integer -> [Integer]
sucesion2 c =
  1 : c : [2*y-x+2 | (x,y) <- zip (sucesion3 c) (tail (sucesion3 c))]

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

sucesion3 :: Integer -> [Integer]
sucesion3 c =
  map (termino3 c) [1..]

termino3 :: Integer -> Integer -> Integer
termino3 c 1 = 1
termino3 c 2 = c
termino3 c n = n^2 + b*n - b
  where b = c - 4

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

-- La comparación es
--    λ> sucesion 2 !! 32
--    1025
--    (3.95 secs, 1,991,299,256 bytes)
--    λ> sucesion2 2 !! 32
--    1025
--    (0.01 secs, 119,856 bytes)
--    λ> sucesion3 2 !! 32
--    1025
--    (0.01 secs, 111,176 bytes)
--
--    λ> sucesion2 2 !! (10^7)
--    100000000000001
--    (2.26 secs, 5,200,111,128 bytes)
--    λ> sucesion3 2 !! (10^7)
--    100000000000001
--    (0.27 secs, 1,600,111,568 bytes)

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

-- La propiedad es
prop_equivalencia :: Integer -> Int -> Property
prop_equivalencia c k =
  c > 0 && k >= 0 ==>
  take 20 (sucesion c) == take 20 (sucesion2 c) &&
  sucesion2 c !! k == sucesion3 c !! k

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

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

-- La propiedad es
prop_sucesion :: Integer -> Int -> Property
prop_sucesion c k =
  c > 0 && k >= 0 ==>
  (ys !! k) `elem` xs
  where xs = sucesion2 c
        ys = zipWith (*) xs (tail xs)

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

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

-- 1ª solución

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

sucesion :: Integer -> [Integer]

sucesion c =

map (termino c) [1..]

termino :: Integer -> Integer -> Integer

termino c 1 = 1

termino c 2 = c

termino c n = 2 * termino c (n-1) - termino c (n-2) + 2

-- 2ª solución

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

sucesion2 :: Integer -> [Integer]

sucesion2 c =

1 : c : [2*y-x+2 | (x,y) <- zip (sucesion3 c) (tail (sucesion3 c))]

-- 2ª solución

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

sucesion3 :: Integer -> [Integer]

sucesion3 c =

map (termino3 c) [1..]

termino3 :: Integer -> Integer -> Integer

termino3 c 1 = 1

termino3 c 2 = c

termino3 c n = n^2 + b*n - b

where b = c - 4

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sucesion 2 !! 32

-- 1025

-- (3.95 secs, 1,991,299,256 bytes)

-- λ> sucesion2 2 !! 32

-- 1025

-- (0.01 secs, 119,856 bytes)

-- λ> sucesion3 2 !! 32

-- 1025

-- (0.01 secs, 111,176 bytes)

-- λ> sucesion2 2 !! (10^7)

-- 100000000000001

-- (2.26 secs, 5,200,111,128 bytes)

-- λ> sucesion3 2 !! (10^7)

-- 100000000000001

-- (0.27 secs, 1,600,111,568 bytes)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia :: Integer -> Int -> Property

prop_equivalencia c k =

c > 0 && k >= 0 ==>

take 20 (sucesion c) == take 20 (sucesion2 c) &&

sucesion2 c !! k == sucesion3 c !! k

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Propiedad

-- =========

-- La propiedad es

prop_sucesion :: Integer -> Int -> Property

prop_sucesion c k =

c > 0 && k >= 0 ==>

(ys !! k) `elem` xs

where xs = sucesion2 c

ys = zipWith (*) xs (tail xs)

-- La comprobación es

-- λ> quickCheck prop_sucesion

-- +++ OK, passed 100 tests.

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="haskell"> y otra con </pre>

Números superabundantes

PorJosé A. Alonso 22-junio-202126-enero-2022

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1983 es

Sea n un número entero positivo. Sea σ(n) la suma de los divisores positivos de n (incluyendo al 1 y al n). Se dice que un entero m ≥ 1 es superabundante (P. Erdös, 1944) si ∀k ∈ {1, 2, …, m-1}, σ(m)/m > σ(k)/k. Demostrar que esisten infinitos números superabundantes.

Definir la lista

   superabundantes :: [Integer]

1	superabundantes :: [Integer]

cuyos elementos son los números superabundantes. Por ejemplo,

   take 7 superabundantes == [1,2,4,6,12,24,36]
   superabundantes !! 25  ==  166320

1 2	take 7 superabundantes == [1,2,4,6,12,24,36] superabundantes !! 25 == 166320

Soluciones

import Data.Numbers.Primes (primeFactors)
import Data.List (genericLength, group)
import Data.Ratio ((%))

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

superabundantes :: [Integer]
superabundantes =
  filter esSuperabundante [1..]

-- (esSuperabundante n) se verifica si n es superabundante. Por ejemplo,
--    esSuperabundante 4  ==  True
--    esSuperabundante 5  ==  False
--    esSuperabundante 6  ==  True
esSuperabundante :: Integer -> Bool
esSuperabundante n =
  and [k * n' > n * sumaDivisores k | k <- [1..n-1]]
  where n' = sumaDivisores n

-- (sumaDivisores n) es la suma de los divisores de n. Por ejemplo.
--      sumaDivisores 35  ==  48
sumaDivisores :: Integer -> Integer
sumaDivisores x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion 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)
primeroYlongitud _      = error "No tiene elementos"

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

superabundantes2 :: [Integer]
superabundantes2 =
  [n | (n,a,b) <- zip3 [1..] cocientes maximosCocientes,
        a == b]
-- cocientes es la lista de los cocientes σ(k)/k. Por ejemplo,
--    λ> take 7 cocientes
--    [1 % 1,3 % 2,4 % 3,7 % 4,6 % 5,2 % 1,8 % 7]
cocientes :: [Rational]
cocientes =
  [sumaDivisores n % n | n <- [1..]]

-- maximosCocientes es la lista de los máximos de los cocientes
-- σ(k)/k. Por ejemplo,
--    λ> take 7 maximosCocientes
--    [1 % 1,3 % 2,3 % 2,7 % 4,7 % 4,2 % 1,2 % 1]
maximosCocientes :: [Rational]
maximosCocientes = scanl1 max cocientes

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

-- La comparación es
--    λ> superabundantes !! 22
--    27720
--    (6.72 secs, 11,453,705,704 bytes)
--    λ> superabundantes2 !! 22
--    27720
--    (0.54 secs, 902,054,096 bytes)

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group)

import Data.Ratio ((%))

-- 1ª solución

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

superabundantes :: [Integer]

superabundantes =

filter esSuperabundante [1..]

-- (esSuperabundante n) se verifica si n es superabundante. Por ejemplo,

-- esSuperabundante 4 == True

-- esSuperabundante 5 == False

-- esSuperabundante 6 == True

esSuperabundante :: Integer -> Bool

esSuperabundante n =

and [k * n' > n * sumaDivisores k | k <- [1..n-1]]

where n' = sumaDivisores n

-- (sumaDivisores n) es la suma de los divisores de n. Por ejemplo.

-- sumaDivisores 35 == 48

sumaDivisores :: Integer -> Integer

sumaDivisores x =

product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion 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)

primeroYlongitud _ = error "No tiene elementos"

-- 2ª solución

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

superabundantes2 :: [Integer]

superabundantes2 =

[n | (n,a,b) <- zip3 [1..] cocientes maximosCocientes,

a == b]

-- cocientes es la lista de los cocientes σ(k)/k. Por ejemplo,

-- λ> take 7 cocientes

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

cocientes :: [Rational]

cocientes =

[sumaDivisores n % n | n <- [1..]]

-- maximosCocientes es la lista de los máximos de los cocientes

-- σ(k)/k. Por ejemplo,

-- λ> take 7 maximosCocientes

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

maximosCocientes :: [Rational]

maximosCocientes = scanl1 max cocientes

-- Comparación de eficiencia

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

-- La comparación es

-- λ> superabundantes !! 22

-- 27720

-- (6.72 secs, 11,453,705,704 bytes)

-- λ> superabundantes2 !! 22

-- 27720

-- (0.54 secs, 902,054,096 bytes)

Nuevas soluciones

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

Máximo valor de permutaciones

PorJosé A. Alonso 17-junio-202126-enero-2022

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1982 es

Calcular una permutación (a(1),…,a(n)) de {1,2,…,n} que maximice el valor de

a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

Definir la función

   maximoValorPermutaciones :: Integer -> Integer

1	maximoValorPermutaciones :: Integer -> Integer

tal que (maximoValorPermutaciones n) es el máximo valor de

   a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

1	a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

para todas las permutaciones (a(1),…,a(n)) de {1,2,…,n}. Por ejemplo,

   maximoValorPermutaciones 4       ==  25
   maximoValorPermutaciones (10^7)  ==  333333383333315000003
   maximoValorPermutaciones (10^8)  ==  333333338333333150000003
   maximoValorPermutaciones (10^9)  ==  333333333833333331500000003
   length (show (maximoValorPermutaciones (10^1000)))  ==  3000
   length (show (maximoValorPermutaciones (10^2000)))  ==  6000
   length (show (maximoValorPermutaciones (10^3000)))  ==  9000

maximoValorPermutaciones 4 == 25

maximoValorPermutaciones (10^7) == 333333383333315000003

maximoValorPermutaciones (10^8) == 333333338333333150000003

maximoValorPermutaciones (10^9) == 333333333833333331500000003

length (show (maximoValorPermutaciones (10^1000))) == 3000

length (show (maximoValorPermutaciones (10^2000))) == 6000

length (show (maximoValorPermutaciones (10^3000))) == 9000

Comprobar con QuickCheck que, para todo entero positivo n y toda permutación (a(1),…,a(n)) de {1,2,…,n},

   maximoValorPermutaciones n >= a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

1	maximoValorPermutaciones n >= a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

Soluciones

import Data.List (permutations)
import Test.QuickCheck

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

maximoValorPermutaciones :: Integer -> Integer
maximoValorPermutaciones n =
  maximum (map valor (permutations [1..n]))

valor :: [Integer] -> Integer
valor xs = sum [a * b | (a,b) <- zip xs (tail xs ++ take 1 xs)]

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

maximoValorPermutaciones2 :: Integer -> Integer
maximoValorPermutaciones2 n =
  valor (head (permutacionesMaximizadoras n))

-- (permutacionesMaximizadoras n) es la lista de las permutaciones
-- (a(1),...,a(n)) de {1,2,...,n} para las que el valor de
--       a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)
-- es máximo. Por ejemplo,
--    λ> permutacionesMaximizadoras 5
--    [[3,1,2,4,5],[4,2,1,3,5],[3,5,4,2,1],[2,4,5,3,1],[2,1,3,5,4],
--     [5,3,1,2,4],[4,5,3,1,2],[1,3,5,4,2],[5,4,2,1,3],[1,2,4,5,3]]
permutacionesMaximizadoras :: Integer -> [[Integer]]
permutacionesMaximizadoras n =
  [xs | xs <- xss, valor xs == m]
  where xss = permutations [1..n]
        m   = maximum (map valor xss)

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

maximoValorPermutaciones3 :: Integer -> Integer
maximoValorPermutaciones3 =
  valor . menorPermutacionMaximizadora

-- (menorPermutacionMaximizadora n) es la menor de las permutaciones
-- (a(1),...,a(n)) de {1,2,...,n} para las que el valor de
--       a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)
-- es máximo. Por ejemplo,
--    menorPermutacionMaximizadora 5  ==  [1,2,4,5,3]
menorPermutacionMaximizadora :: Integer -> [Integer]
menorPermutacionMaximizadora n =
  minimum [xs | xs <- xss, valor xs == m]
  where xss = permutations [1..n]
        m   = maximum (map valor xss)

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

maximoValorPermutaciones4 :: Integer -> Integer
maximoValorPermutaciones4 =
  valor . menorPermutacionMaximizadora2

-- Redefinición de menorPermutacionMaximizadora observando que
--    menorPermutacionMaximizadora 2  ==  [1,2]
--    menorPermutacionMaximizadora 3  ==  [1,2,3]
--    menorPermutacionMaximizadora 4  ==  [1,2,4,3]
--    menorPermutacionMaximizadora 5  ==  [1,2,4,5,3]
--    menorPermutacionMaximizadora 6  ==  [1,2,4,6,5,3]
--    menorPermutacionMaximizadora 7  ==  [1,2,4,6,7,5,3]
--    menorPermutacionMaximizadora 8  ==  [1,2,4,6,8,7,5,3]
--    menorPermutacionMaximizadora 9  ==  [1,2,4,6,8,9,7,5,3]
menorPermutacionMaximizadora2 :: Integer -> [Integer]
menorPermutacionMaximizadora2 n
  | even n    = 1 : [2,4..n] ++ [n-1,n-3..3]
  | otherwise = 1 : [2,4..n] ++ [n,n-2..3]

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

maximoValorPermutaciones5 :: Integer -> Integer
maximoValorPermutaciones5 n
  | even n    = valor (1 : [2,4..n] ++ [n-1,n-3..3])
  | otherwise = valor (1 : [2,4..n] ++ [n,n-2..3])

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

maximoValorPermutaciones6 :: Integer -> Integer
maximoValorPermutaciones6 1 = 1
maximoValorPermutaciones6 n = (2*n^3+3*n^2-11*n+18) `div` 6

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

-- La propiedad, para pequeños valores, es
prop_equivalencia1 :: Integer -> Bool
prop_equivalencia1 n =
  and [maximoValorPermutaciones k == f k | k <- [2..n],
                                           f <- [maximoValorPermutaciones2,
                                                 maximoValorPermutaciones3,
                                                 maximoValorPermutaciones4,
                                                 maximoValorPermutaciones5,
                                                 maximoValorPermutaciones6]]

-- La comprobación es
--    λ> prop_equivalencia1 9
--    True

-- La propiedad, para grandes valores, es
prop_equivalencia2 :: Integer -> Property
prop_equivalencia2 n =
  n > 0 ==>
  maximoValorPermutaciones5 n == maximoValorPermutaciones6 n

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

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

-- La comparación es
--    λ> maximoValorPermutaciones 10
--    368
--    (15.33 secs, 15,147,056,648 bytes)
--    λ> maximoValorPermutaciones2 10
--    368
--    (15.00 secs, 15,193,414,656 bytes)
--    λ> maximoValorPermutaciones3 10
--    368
--    (31.86 secs, 28,297,837,624 bytes)
--    λ> maximoValorPermutaciones4 10
--    368
--    (0.01 secs, 104,120 bytes)
--    λ> maximoValorPermutaciones5 10
--    368
--    (0.01 secs, 104,264 bytes)
--    λ> maximoValorPermutaciones6 10
--    368
--    (0.01 secs, 102,712 bytes)
--
--    λ> maximoValorPermutaciones4 (4*10^6)
--    21333341333326000003
--    (2.77 secs, 1,972,797,144 bytes)
--    λ> maximoValorPermutaciones5 (4*10^6)
--    21333341333326000003
--    (2.66 secs, 1,972,797,440 bytes)
--    λ> maximoValorPermutaciones6 (4*10^6)
--    21333341333326000003
--    (0.03 secs, 119,592 bytes)

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

-- La propiedad es
prop_maximizadora :: Integer -> Property
prop_maximizadora n =
  n > 0 ==>
  do xs <- shuffle [1..n]
     return (maximoValorPermutaciones6 n >= valor xs)

-- La comprobación es
--    λ> quickCheck prop_maximizadora
--    +++ 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

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

import Data.List (permutations)

import Test.QuickCheck

-- 1ª solución

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

maximoValorPermutaciones :: Integer -> Integer

maximoValorPermutaciones n =

maximum (map valor (permutations [1..n]))

valor :: [Integer] -> Integer

valor xs = sum [a * b | (a,b) <- zip xs (tail xs ++ take 1 xs)]

-- 2ª solución

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

maximoValorPermutaciones2 :: Integer -> Integer

maximoValorPermutaciones2 n =

valor (head (permutacionesMaximizadoras n))

-- (permutacionesMaximizadoras n) es la lista de las permutaciones

-- (a(1),...,a(n)) de {1,2,...,n} para las que el valor de

-- a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

-- es máximo. Por ejemplo,

-- λ> permutacionesMaximizadoras 5

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

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

permutacionesMaximizadoras :: Integer -> [[Integer]]

permutacionesMaximizadoras n =

[xs | xs <- xss, valor xs == m]

where xss = permutations [1..n]

m = maximum (map valor xss)

-- 3ª solución

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

maximoValorPermutaciones3 :: Integer -> Integer

maximoValorPermutaciones3 =

valor . menorPermutacionMaximizadora

-- (menorPermutacionMaximizadora n) es la menor de las permutaciones

-- (a(1),...,a(n)) de {1,2,...,n} para las que el valor de

-- a(1)a(2) + a(2)a(3) + ··· + a(n)a(1)

-- es máximo. Por ejemplo,

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

menorPermutacionMaximizadora :: Integer -> [Integer]

menorPermutacionMaximizadora n =

minimum [xs | xs <- xss, valor xs == m]

where xss = permutations [1..n]

m = maximum (map valor xss)

-- 4ª solución

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

maximoValorPermutaciones4 :: Integer -> Integer

maximoValorPermutaciones4 =

valor . menorPermutacionMaximizadora2

-- Redefinición de menorPermutacionMaximizadora observando que

-- menorPermutacionMaximizadora 2 == [1,2]

-- menorPermutacionMaximizadora 3 == [1,2,3]

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

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

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

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

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

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

menorPermutacionMaximizadora2 :: Integer -> [Integer]

menorPermutacionMaximizadora2 n

| even n = 1 : [2,4..n] ++ [n-1,n-3..3]

| otherwise = 1 : [2,4..n] ++ [n,n-2..3]

-- 5ª solución

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

maximoValorPermutaciones5 :: Integer -> Integer

maximoValorPermutaciones5 n

| even n = valor (1 : [2,4..n] ++ [n-1,n-3..3])

| otherwise = valor (1 : [2,4..n] ++ [n,n-2..3])

-- 6ª solución

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

maximoValorPermutaciones6 :: Integer -> Integer

maximoValorPermutaciones6 1 = 1

maximoValorPermutaciones6 n = (2*n^3+3*n^2-11*n+18) `div` 6

-- Comprobación de la equivalencia

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

-- La propiedad, para pequeños valores, es

prop_equivalencia1 :: Integer -> Bool

prop_equivalencia1 n =

and [maximoValorPermutaciones k == f k | k <- [2..n],

f <- [maximoValorPermutaciones2,

maximoValorPermutaciones3,

maximoValorPermutaciones4,

maximoValorPermutaciones5,

maximoValorPermutaciones6]]

-- La comprobación es

-- λ> prop_equivalencia1 9

-- True

-- La propiedad, para grandes valores, es

prop_equivalencia2 :: Integer -> Property

prop_equivalencia2 n =

n > 0 ==>

maximoValorPermutaciones5 n == maximoValorPermutaciones6 n

-- La comprobación es

-- λ> quickCheck prop_equivalencia2

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximoValorPermutaciones 10

-- 368

-- (15.33 secs, 15,147,056,648 bytes)

-- λ> maximoValorPermutaciones2 10

-- 368

-- (15.00 secs, 15,193,414,656 bytes)

-- λ> maximoValorPermutaciones3 10

-- 368

-- (31.86 secs, 28,297,837,624 bytes)

-- λ> maximoValorPermutaciones4 10

-- 368

-- (0.01 secs, 104,120 bytes)

-- λ> maximoValorPermutaciones5 10

-- 368

-- (0.01 secs, 104,264 bytes)

-- λ> maximoValorPermutaciones6 10

-- 368

-- (0.01 secs, 102,712 bytes)

-- λ> maximoValorPermutaciones4 (4*10^6)

-- 21333341333326000003

-- (2.77 secs, 1,972,797,144 bytes)

-- λ> maximoValorPermutaciones5 (4*10^6)

-- 21333341333326000003

-- (2.66 secs, 1,972,797,440 bytes)

-- λ> maximoValorPermutaciones6 (4*10^6)

-- 21333341333326000003

-- (0.03 secs, 119,592 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_maximizadora :: Integer -> Property

prop_maximizadora n =

n > 0 ==>

do xs <- shuffle [1..n]

return (maximoValorPermutaciones6 n >= valor xs)

-- La comprobación es

-- λ> quickCheck prop_maximizadora

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Máxima suma de dos cuadrados condicionados

PorJosé A. Alonso 15-junio-202126-enero-2022

El enunciado del problema 3 de la IMO (Olimpiada Internacional de Matemáticas) de 1981 es

Calcular el máximo valor de m² + n² donde m y n son números enteros tales que m, n ∈ {1, 2, …, 1981} y (n² – mn – m²)² = 1.

Definir la función

   maximoValor :: Integer -> Integer

1	maximoValor :: Integer -> Integer

tal que (maximoValor k) es el máximo valor de m² + n² donde m y n son números enteros tales que m, n ∈ {1, 2, …, k} y (n² – mn – m²)² = 1. Por ejemplo,

   maximoValor 10       ==  89
   maximoValor (10^20)  ==  9663391306290450775010025392525829059713
   length (show (maximoValor5 (10^(4*10^4))))  ==  80000

maximoValor 10 == 89

maximoValor (10^20) == 9663391306290450775010025392525829059713

length (show (maximoValor5 (10^(4*10^4)))) == 80000

Usando la función maximoValor, calcular la respuesta del problema.

Soluciones

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

maximoValor :: Integer -> Integer
maximoValor k =
  maximum [m^2 + n^2 | m <- [1..k],
                       n <- [m..k],
                       (n^2 - m*n - m^2)^2 == 1]

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

maximoValor2 :: Integer -> Integer
maximoValor2 k =
  maximum [m^2 + n^2 | (m, n) <- soluciones k]

-- (soluciones k) es la lista de los pares (m,n) tales que
-- m, n ∈ {1, 2,..., k}, m <= n y (n² - mn - m²)² = 1.
-- Por ejemplo,
--    λ> soluciones 50
--    [(1,1),(1,2),(2,3),(3,5),(5,8),(8,13),(13,21),(21,34)]
soluciones :: Integer -> [(Integer,Integer)]
soluciones k =
  [(m, n) | m <- [1..k],
            n <- [m..k],
            (n^2 - m*n - m^2)^2 == 1]

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

maximoValor3 :: Integer -> Integer
maximoValor3 k = m^2 + n^2
  where (m, n) = last (soluciones k)

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

maximoValor4 :: Integer -> Integer
maximoValor4 k = m^2 + n^2
  where (m, n) = head [(m, n) | m <- [k,k-1..1],
                                n <- [k,k-1..m],
                                (n^2 - m*n - m^2)^2 == 1]

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

-- Con el siguiente cálculo
--    λ> soluciones 50
--    [(1,1),(1,2),(2,3),(3,5),(5,8),(8,13),(13,21),(21,34)]
-- se observa que las soluciones son pares de términos consecutivos de
-- la sucessión de Fibonacci.

maximoValor5 :: Integer -> Integer
maximoValor5 k = m^2 + n^2
  where [m,n] = take 2 (reverse (takeWhile (<= k) fibs))

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

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

-- La comparación es
--    λ> maximoValor 1500
--    1346269
--    (1.94 secs, 2,188,819,744 bytes)
--    λ> maximoValor2 1500
--    1346269
--    (1.93 secs, 2,188,821,752 bytes)
--    λ> maximoValor3 1500
--    1346269
--    (1.95 secs, 2,188,803,312 bytes)
--    λ> maximoValor4 1500
--    1346269
--    (0.71 secs, 775,331,376 bytes)
--    λ> maximoValor5 1500
--    1346269
--    (0.01 secs, 106,952 bytes)
--
--    λ> maximoValor4 4000
--    9227465
--    (5.00 secs, 5,641,750,992 bytes)
--    λ> maximoValor5 4000
--    9227465
--    (0.01 secs, 107,104 bytes)

-- Cálculo de la respuesta
-- =======================

-- El cálculo es
--    λ> maximoValor5 1981
--    3524578

-- 1ª solución

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

maximoValor :: Integer -> Integer

maximoValor k =

maximum [m^2 + n^2 | m <- [1..k],

n <- [m..k],

(n^2 - m*n - m^2)^2 == 1]

-- 2ª solución

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

maximoValor2 :: Integer -> Integer

maximoValor2 k =

maximum [m^2 + n^2 | (m, n) <- soluciones k]

-- (soluciones k) es la lista de los pares (m,n) tales que

-- m, n ∈ {1, 2,..., k}, m <= n y (n² - mn - m²)² = 1.

-- Por ejemplo,

-- λ> soluciones 50

-- [(1,1),(1,2),(2,3),(3,5),(5,8),(8,13),(13,21),(21,34)]

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

soluciones k =

[(m, n) | m <- [1..k],

n <- [m..k],

(n^2 - m*n - m^2)^2 == 1]

-- 3ª solución

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

maximoValor3 :: Integer -> Integer

maximoValor3 k = m^2 + n^2

where (m, n) = last (soluciones k)

-- 4ª solución

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

maximoValor4 :: Integer -> Integer

maximoValor4 k = m^2 + n^2

where (m, n) = head [(m, n) | m <- [k,k-1..1],

n <- [k,k-1..m],

(n^2 - m*n - m^2)^2 == 1]

-- 5ª solución

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

-- Con el siguiente cálculo

-- λ> soluciones 50

-- [(1,1),(1,2),(2,3),(3,5),(5,8),(8,13),(13,21),(21,34)]

-- se observa que las soluciones son pares de términos consecutivos de

-- la sucessión de Fibonacci.

maximoValor5 :: Integer -> Integer

maximoValor5 k = m^2 + n^2

where [m,n] = take 2 (reverse (takeWhile (<= k) fibs))

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

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximoValor 1500

-- 1346269

-- (1.94 secs, 2,188,819,744 bytes)

-- λ> maximoValor2 1500

-- 1346269

-- (1.93 secs, 2,188,821,752 bytes)

-- λ> maximoValor3 1500

-- 1346269

-- (1.95 secs, 2,188,803,312 bytes)

-- λ> maximoValor4 1500

-- 1346269

-- (0.71 secs, 775,331,376 bytes)

-- λ> maximoValor5 1500

-- 1346269

-- (0.01 secs, 106,952 bytes)

-- λ> maximoValor4 4000

-- 9227465

-- (5.00 secs, 5,641,750,992 bytes)

-- λ> maximoValor5 4000

-- 9227465

-- (0.01 secs, 107,104 bytes)

-- Cálculo de la respuesta

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

-- El cálculo es

-- λ> maximoValor5 1981

-- 3524578

Nuevas soluciones

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

Productos de sumas de progresiones aritméticas

PorJosé A. Alonso 10-junio-202126-enero-2022

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1978 es

Para cada número entero d ≥ 1, sea M(d) el conjunto de todos enteros positivos que no se pueden escribir como una suma de una progresión aritmética de diferencia d, teniendo al menos dos sumandos y formadas por enteros positivos. Sean A = M(1), B = M(2)-{2} y C = M(3). Demostrar que todo c ∈ C se puede escribir de una única manera como c = ab con a ∈ A, b ∈ B.

Definir las funciones

   conjuntoA   :: [Integer]
   conjuntoB   :: [Integer]
   conjuntoC   :: [Integer]
   productosAB :: Integer -> [(Integer,Integer)]

conjuntoA :: [Integer]

conjuntoB :: [Integer]

conjuntoC :: [Integer]

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

tales que

conjuntoA es la lista de los elementos del conjunto A; es decir, de los números que no se pueden escribir como sumas de progresiones aritméticas de diferencia uno, con al menos dos términos, de números enteros positivos. Por ejemplo,

     conjuntoA !! 2                      ==  4
     length (show (conjuntoA !! (10^7))) == 3010300

1 2	conjuntoA !! 2 == 4 length (show (conjuntoA !! (10^7))) == 3010300

conjuntoB es la lista de los elementos del conjunto B; es decir, los números (distintos de dos) que no se pueden escribir como sumas de progresiones aritméticas de diferencia dos, con al menos dos términos, de números enteros positivos. Por ejemplo,

     conjuntoB !! 3       ==  5
     conjuntoB !! (10^6)  ==  15485863

1 2	conjuntoB !! 3 == 5 conjuntoB !! (10^6) == 15485863

conjuntoC es la lista de los elementos del conjunto C; es decir, los números que no se pueden escribir como sumas de progresiones aritméticas de diferencia tres, con al menos dos términos, de números enteros positivos. Por ejemplo,

     conjuntoC !! 4  ==  6

1	conjuntoC !! 4 == 6

(productosAB x) es la lista de los pares (a,b) tales que a es un elementos del conjunto A, b es un elemento del conjunto B y su producto es x. Por ejemplo,

     productosAB 10  ==  [(2,5)]
     productosAB 15  ==  []

1 2	productosAB 10 == [(2,5)] productosAB 15 == []

Comprobar con QuickCheck la propiedad del problema de la Olimpiada; es decir, para todo c ∈ C la lista (productosAB c) tiene exactamente un elemento.

Soluciones

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

-- Nota: Se usarán las funciones definidas en los ejercicios
-- anteriores.

conjuntoA :: [Integer]
conjuntoA = [2^k | k <- [0..]]

conjuntoB :: [Integer]
conjuntoB = 1 : tail primes

conjuntoC :: [Integer]
conjuntoC = noSonSumasDePADeDiferencia 3

noSonSumasDePADeDiferencia :: Integer -> [Integer]
noSonSumasDePADeDiferencia d =
  diferencia [1..] (sonSumasDePADeDiferencia d)

sonSumasDePADeDiferencia :: Integer -> [Integer]
sonSumasDePADeDiferencia d =
  mezclaTodas [sumasDePADeDiferencia d a | a <- [1..]]

sumasDePADeDiferencia :: Integer -> Integer -> [Integer]
sumasDePADeDiferencia d a =
  tail (scanl1 (+) [a,a+d..])

mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys

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

diferencia :: [Integer] -> [Integer] -> [Integer]
diferencia (x:xs) (y:ys)
  | x == y    = diferencia xs ys
  | otherwise = x : diferencia xs (y:ys)

productosAB :: Integer -> [(Integer,Integer)]
productosAB c =
  [(a,b) | a <- takeWhile (<= c) conjuntoA,
           c `mod` a == 0,
           let b = c `div` a,
           b `pertenece` conjuntoB]

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

-- La propiedad es
prop_productosAB :: Int -> Property
prop_productosAB k =
  k >= 0 ==>
  length (productosAB (conjuntoC !! k)) == 1

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

import Data.List (foldr1)

import Data.Numbers.Primes (primes,primeFactors)

import Test.QuickCheck

-- Nota: Se usarán las funciones definidas en los ejercicios

-- anteriores.

conjuntoA :: [Integer]

conjuntoA = [2^k | k <- [0..]]

conjuntoB :: [Integer]

conjuntoB = 1 : tail primes

conjuntoC :: [Integer]

conjuntoC = noSonSumasDePADeDiferencia 3

noSonSumasDePADeDiferencia :: Integer -> [Integer]

noSonSumasDePADeDiferencia d =

diferencia [1..] (sonSumasDePADeDiferencia d)

sonSumasDePADeDiferencia :: Integer -> [Integer]

sonSumasDePADeDiferencia d =

mezclaTodas [sumasDePADeDiferencia d a | a <- [1..]]

sumasDePADeDiferencia :: Integer -> Integer -> [Integer]

sumasDePADeDiferencia d a =

tail (scanl1 (+) [a,a+d..])

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

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

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

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

diferencia (x:xs) (y:ys)

| x == y = diferencia xs ys

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

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

productosAB c =

[(a,b) | a <- takeWhile (<= c) conjuntoA,

c `mod` a == 0,

let b = c `div` a,

b `pertenece` conjuntoB]

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

pertenece x ys =

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

-- La propiedad es

prop_productosAB :: Int -> Property

prop_productosAB k =

k >= 0 ==>

length (productosAB (conjuntoC !! k)) == 1

-- La comprobación es

-- λ> quickCheck prop_productosAB

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Números que no son sumas de progresiones aritméticas de diferencia dada

PorJosé A. Alonso 8-junio-202126-enero-2022

El número 5 es la suma de números enteros positivos en progresión aritmética de diferencia tres (ya que es 1+4) y también lo es el 7 (ya que es 2+5) y el 12 (ya que es (1+4+7), pero el 6 no lo es.

Definir la función

   noSonSumasDePADeDiferencia :: Integer -> [Integer]

1	noSonSumasDePADeDiferencia :: Integer -> [Integer]

tal que (noSonSumasDePADeDiferencia d) es la lista de los números no se pueden escribir como sumas de progresiones aritméticas de diferencia d, con al menos términos, de números enteros positivos. Por ejemplo,

   (noSonSumasDePADeDiferencia 3) !! 4    ==  6
   (noSonSumasDePADeDiferencia 3) !! 100  ==  6848
   (noSonSumasDePADeDiferencia 9) !! 200  ==  6752

(noSonSumasDePADeDiferencia 3) !! 4 == 6

(noSonSumasDePADeDiferencia 3) !! 100 == 6848

(noSonSumasDePADeDiferencia 9) !! 200 == 6752

Soluciones

import Data.List (foldr1)

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

noSonSumasDePADeDiferencia :: Integer -> [Integer]
noSonSumasDePADeDiferencia d =
  diferencia [1..] (sonSumasDePADeDiferencia d)

-- (sonSumasDePADeDiferencia d) es la lista de los números que se pueden
-- escribir como sumas de progresiones aritméticas de diferencia d,
-- con al menos dos términos, de números enteros positivos. Por ejemplo,
--    λ> take 15 (sonSumasDePADeDiferencia 3)
--    [5,7,9,11,12,13,15,17,18,19,21,22,23,24,25]
sonSumasDePADeDiferencia :: Integer -> [Integer]
sonSumasDePADeDiferencia d =
  mezclaTodas [sumasDePADeDiferencia d a | a <- [1..]]

-- (sumasDePADeDiferencia a) es la lista de las sumas de la
-- progresión aritmética de término inicial a y diferencia . Por
-- ejemplo,
--    take 7 (sumasDePADeDiferencia 3 1)  ==  [5,12,22,35,51,70,92]
--    take 7 (sumasDePADeDiferencia 3 2)  ==  [7,15,26,40,57,77,100]
--    take 7 (sumasDePADeDiferencia 3 3)  ==  [9,18,30,45,63,84,108]
sumasDePADeDiferencia :: Integer -> Integer -> [Integer]
sumasDePADeDiferencia d a =
  tail (scanl1 (+) [a,a+d..])

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como
-- sus elementos son listas infinitas ordenadas. Por ejemplo,
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])
--    [2,3,4,5,6,7,8,9,10,11]
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])
--    [2,4,6,8,9,10,12,14,16,18]
mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la lista obtenida mezclando las  lista infinitas
-- ordenadas crecientes xs e ys. Por ejemplo,
--    λ> take 20 (mezcla [1,3..] [2,5..])
--    [1,2,3,5,7,8,9,11,13,14,15,17,19,20,21,23,25,26,27,29]
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

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

import Data.List (foldr1)

-- 1ª solución

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

noSonSumasDePADeDiferencia :: Integer -> [Integer]

noSonSumasDePADeDiferencia d =

diferencia [1..] (sonSumasDePADeDiferencia d)

-- (sonSumasDePADeDiferencia d) es la lista de los números que se pueden

-- escribir como sumas de progresiones aritméticas de diferencia d,

-- con al menos dos términos, de números enteros positivos. Por ejemplo,

-- λ> take 15 (sonSumasDePADeDiferencia 3)

-- [5,7,9,11,12,13,15,17,18,19,21,22,23,24,25]

sonSumasDePADeDiferencia :: Integer -> [Integer]

sonSumasDePADeDiferencia d =

mezclaTodas [sumasDePADeDiferencia d a | a <- [1..]]

-- (sumasDePADeDiferencia a) es la lista de las sumas de la

-- progresión aritmética de término inicial a y diferencia . Por

-- ejemplo,

-- take 7 (sumasDePADeDiferencia 3 1) == [5,12,22,35,51,70,92]

-- take 7 (sumasDePADeDiferencia 3 2) == [7,15,26,40,57,77,100]

-- take 7 (sumasDePADeDiferencia 3 3) == [9,18,30,45,63,84,108]

sumasDePADeDiferencia :: Integer -> Integer -> [Integer]

sumasDePADeDiferencia d a =

tail (scanl1 (+) [a,a+d..])

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como

-- sus elementos son listas infinitas ordenadas. Por ejemplo,

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])

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

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])

-- [2,4,6,8,9,10,12,14,16,18]

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

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la lista obtenida mezclando las lista infinitas

-- ordenadas crecientes xs e ys. Por ejemplo,

-- λ> take 20 (mezcla [1,3..] [2,5..])

-- [1,2,3,5,7,8,9,11,13,14,15,17,19,20,21,23,25,26,27,29]

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

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

-- crecientes xs e ys. Por ejemplo,

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

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

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

diferencia (x:xs) (y:ys)

| x == y = diferencia xs ys

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

Nuevas soluciones

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

Números que no son sumas de progresiones aritméticas de diferencia dos

PorJosé A. Alonso 4-junio-202126-enero-2022

El número 4 es la suma de números enteros positivos en progresión aritmética de diferencia dos (ya que es 1+3) y también lo es el 6 (ya que es 2+4) y el 9 (ya que es (1+3+5), pero el 5 no lo es.

Definir la función

   noSonSumasDePADeDiferenciaDos :: [Integer]

1	noSonSumasDePADeDiferenciaDos :: [Integer]

cuyos elementos son los números que no se pueden escribir como sumas de progresiones aritméticas de diferencia dos, con al menos dos términos, de números enteros positivos. Por ejemplo,

   noSonSumasDePADeDiferenciaDos !! 3  ==  5
   noSonSumasDePADeDiferenciaDos !! (10^6)  ==  15485863

1 2	noSonSumasDePADeDiferenciaDos !! 3 == 5 noSonSumasDePADeDiferenciaDos !! (10^6) == 15485863

Soluciones

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

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

noSonSumasDePADeDiferenciaDos :: [Integer]
noSonSumasDePADeDiferenciaDos =
  diferencia [1..] sonSumasDePADeDiferenciaDos

-- sonSumasDePADeDiferenciaDos es la lista de los números que se pueden
-- escribir como sumas de progresiones aritméticas de diferencia dos,
-- con al menos dos términos, de números enteros positivos. Por ejemplo,
--    λ> take 10 sonSumasDePADeDiferenciaDos
--    [4,6,8,9,10,12,14,15,16,18]
sonSumasDePADeDiferenciaDos :: [Integer]
sonSumasDePADeDiferenciaDos =
  mezclaTodas [sumasDePADeDiferenciaDos a | a <- [1..]]

-- (sumasDePADeDiferenciaDos a) es la lista de las sumas de la
-- progresión aritmética de término inicial a y diferencia dos. Por
-- ejemplo,
--    take 7 (sumasDePADeDiferenciaDos 1)  ==  [4,9,16,25,36,49,64]
--    take 7 (sumasDePADeDiferenciaDos 2)  ==  [6,12,20,30,42,56,72]
--    take 7 (sumasDePADeDiferenciaDos 3)  ==  [8,15,24,35,48,63,80]
sumasDePADeDiferenciaDos :: Integer -> [Integer]
sumasDePADeDiferenciaDos a =
  tail (scanl1 (+) [a,a+2..])

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como
-- sus elementos son listas infinitas ordenadas. Por ejemplo,
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])
--    [2,3,4,5,6,7,8,9,10,11]
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])
--    [2,4,6,8,9,10,12,14,16,18]
mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la lista obtenida mezclando las dos lista infinitas
-- ordenadas crecientes xs e ys. Por ejemplo,
--    λ> take 20 (mezcla [1,3..] [2,5..])
--    [1,2,3,5,7,8,9,11,13,14,15,17,19,20,21,23,25,26,27,29]
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

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

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

-- Observando el siguiente cálculo
--    λ> take 15 noSonSumasDePADeDiferenciaDos
--    [1,2,3,5,7,11,13,17,19,23,29,31,37,41,43]
noSonSumasDePADeDiferenciaDos2 :: [Integer]
noSonSumasDePADeDiferenciaDos2 = 1 : primes

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

-- La comparación es
--    λ> noSonSumasDePADeDiferenciaDos !! 1000
--    7919
--    (3.58 secs, 3,304,841,840 bytes)
--    λ> noSonSumasDePADeDiferenciaDos2 !! 1000
--    7919
--    (0.01 secs, 2,316,896 bytes)

import Data.List (foldr1)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

noSonSumasDePADeDiferenciaDos :: [Integer]

noSonSumasDePADeDiferenciaDos =

diferencia [1..] sonSumasDePADeDiferenciaDos

-- sonSumasDePADeDiferenciaDos es la lista de los números que se pueden

-- escribir como sumas de progresiones aritméticas de diferencia dos,

-- con al menos dos términos, de números enteros positivos. Por ejemplo,

-- λ> take 10 sonSumasDePADeDiferenciaDos

-- [4,6,8,9,10,12,14,15,16,18]

sonSumasDePADeDiferenciaDos :: [Integer]

sonSumasDePADeDiferenciaDos =

mezclaTodas [sumasDePADeDiferenciaDos a | a <- [1..]]

-- (sumasDePADeDiferenciaDos a) es la lista de las sumas de la

-- progresión aritmética de término inicial a y diferencia dos. Por

-- ejemplo,

-- take 7 (sumasDePADeDiferenciaDos 1) == [4,9,16,25,36,49,64]

-- take 7 (sumasDePADeDiferenciaDos 2) == [6,12,20,30,42,56,72]

-- take 7 (sumasDePADeDiferenciaDos 3) == [8,15,24,35,48,63,80]

sumasDePADeDiferenciaDos :: Integer -> [Integer]

sumasDePADeDiferenciaDos a =

tail (scanl1 (+) [a,a+2..])

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como

-- sus elementos son listas infinitas ordenadas. Por ejemplo,

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])

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

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])

-- [2,4,6,8,9,10,12,14,16,18]

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

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la lista obtenida mezclando las dos lista infinitas

-- ordenadas crecientes xs e ys. Por ejemplo,

-- λ> take 20 (mezcla [1,3..] [2,5..])

-- [1,2,3,5,7,8,9,11,13,14,15,17,19,20,21,23,25,26,27,29]

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

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

-- crecientes xs e ys. Por ejemplo,

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

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

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

diferencia (x:xs) (y:ys)

| x == y = diferencia xs ys

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

-- 2ª solución

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

-- Observando el siguiente cálculo

-- λ> take 15 noSonSumasDePADeDiferenciaDos

-- [1,2,3,5,7,11,13,17,19,23,29,31,37,41,43]

noSonSumasDePADeDiferenciaDos2 :: [Integer]

noSonSumasDePADeDiferenciaDos2 = 1 : primes

-- Comparación de eficiencia

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

-- La comparación es

-- λ> noSonSumasDePADeDiferenciaDos !! 1000

-- 7919

-- (3.58 secs, 3,304,841,840 bytes)

-- λ> noSonSumasDePADeDiferenciaDos2 !! 1000

-- 7919

-- (0.01 secs, 2,316,896 bytes)

Nuevas soluciones

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

Números que no son sumas de progresiones aritméticas de diferencia uno

PorJosé A. Alonso 3-junio-202126-enero-2022

El número 3 es la suma de números enteros positivos en progresión aritmética de diferencia uno (ya que es 1+2) y también lo es el 5 (ya que es 2+3) y el 6 (ya que es (1+2+3), pero el 4 no lo es.

Definir la función

   noSonSumasDePADeDiferenciaUno :: [Integer]

1	noSonSumasDePADeDiferenciaUno :: [Integer]

cuyos elementos son los números que no se pueden escribir como de progresiones aritméticas de diferencia uno, con al menos dos términos, de números enteros positivos. Por ejemplo,

   noSonSumasDePADeDiferenciaUno !! 2  ==  4
   length (show (noSonSumasDePADeDiferenciaUno !! (10^7))) == 3010300

1 2	noSonSumasDePADeDiferenciaUno !! 2 == 4 length (show (noSonSumasDePADeDiferenciaUno !! (10^7))) == 3010300

Soluciones

import Data.List (foldr1)

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

noSonSumasDePADeDiferenciaUno :: [Integer]
noSonSumasDePADeDiferenciaUno =
  diferencia [1..] sonSumasDePADeDiferenciaUno

-- sonSumasDePADeDiferenciaUno es la lista de los números que se pueden
-- escribir como sumas de progresiones aritméticas de diferencia uno,
-- con al menos dos términos, de números enteros positivos. Por ejemplo,
--    λ> take 10 sonSumasDePADeDiferenciaUno
--    [3,5,6,7,9,10,11,12,13,14]
sonSumasDePADeDiferenciaUno :: [Integer]
sonSumasDePADeDiferenciaUno =
  mezclaTodas [sumasDePADeDiferenciaUno a | a <- [1..]]

-- (sumasDePADeDiferenciaUno a) es la lista de las sumas de la
-- progresión aritmética de término inicial a y diferencia uno. Por
-- ejemplo,
--    take 7 (sumasDePADeDiferenciaUno 1)  ==  [3,6,10,15,21,28,36]
--    take 7 (sumasDePADeDiferenciaUno 2)  ==  [5,9,14,20,27,35,44]
--    take 7 (sumasDePADeDiferenciaUno 3)  ==  [7,12,18,25,33,42,52]
sumasDePADeDiferenciaUno :: Integer -> [Integer]
sumasDePADeDiferenciaUno a =
  tail (scanl1 (+) [a,a+1..])

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como
-- sus elementos son listas infinitas ordenadas. Por ejemplo,
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])
--    [2,3,4,5,6,7,8,9,10,11]
--    λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])
--    [2,4,6,8,9,10,12,14,16,18]
mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la lista obtenida mezclando las dos lista infinitas
-- ordenadas crecientes xs e ys. Por ejemplo,
--    λ> take 20 (mezcla [1,3..] [2,5..])
--    [1,2,3,5,7,8,9,11,13,14,15,17,19,20,21,23,25,26,27,29]
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

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

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

-- Observando el siguiente cálculo
--    λ> take 10 noSonSumasDePADeDiferenciaUno
--    [1,2,4,8,16,32,64,128,256,512]
noSonSumasDePADeDiferenciaUno2 :: [Integer]
noSonSumasDePADeDiferenciaUno2 = [2^k | k <- [0..]]

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

noSonSumasDePADeDiferenciaUno3 :: [Integer]
noSonSumasDePADeDiferenciaUno3 =
  iterate (*2) 1

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

-- La comparación es
--    λ> noSonSumasDePADeDiferenciaUno !! 14
--    16384
--    (36.00 secs, 28,609,441,984 bytes)
--    λ> noSonSumasDePADeDiferenciaUno2 !! 14
--    16384
--    (0.01 secs, 102,712 bytes)
--    λ> noSonSumasDePADeDiferenciaUno3 !! 14
--    16384
--    (0.00 secs, 102,432 bytes)
--
--    λ> length (show (noSonSumasDePADeDiferenciaUno3 !! (3*10^5)))
--    90309
--    (2.78 secs, 5,770,583,328 bytes)
--    λ> length (show (noSonSumasDePADeDiferenciaUno2 !! (3*10^5)))
--    90309
--    (0.09 secs, 60,840,304 bytes)
--
--    λ> length (show (noSonSumasDePADeDiferenciaUno2 !! (10^7)))
--    3010300
--    (3.55 secs, 2,030,646,392 bytes)

import Data.List (foldr1)

-- 1ª solución

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

noSonSumasDePADeDiferenciaUno :: [Integer]

noSonSumasDePADeDiferenciaUno =

diferencia [1..] sonSumasDePADeDiferenciaUno

-- sonSumasDePADeDiferenciaUno es la lista de los números que se pueden

-- escribir como sumas de progresiones aritméticas de diferencia uno,

-- con al menos dos términos, de números enteros positivos. Por ejemplo,

-- λ> take 10 sonSumasDePADeDiferenciaUno

-- [3,5,6,7,9,10,11,12,13,14]

sonSumasDePADeDiferenciaUno :: [Integer]

sonSumasDePADeDiferenciaUno =

mezclaTodas [sumasDePADeDiferenciaUno a | a <- [1..]]

-- (sumasDePADeDiferenciaUno a) es la lista de las sumas de la

-- progresión aritmética de término inicial a y diferencia uno. Por

-- ejemplo,

-- take 7 (sumasDePADeDiferenciaUno 1) == [3,6,10,15,21,28,36]

-- take 7 (sumasDePADeDiferenciaUno 2) == [5,9,14,20,27,35,44]

-- take 7 (sumasDePADeDiferenciaUno 3) == [7,12,18,25,33,42,52]

sumasDePADeDiferenciaUno :: Integer -> [Integer]

sumasDePADeDiferenciaUno a =

tail (scanl1 (+) [a,a+1..])

-- (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como

-- sus elementos son listas infinitas ordenadas. Por ejemplo,

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2..]])

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

-- λ> take 10 (mezclaTodas [[n,2*n..] | n <- [2,9..]])

-- [2,4,6,8,9,10,12,14,16,18]

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

mezclaTodas = foldr1 xmezcla

where xmezcla (x:xs) ys = x : mezcla xs ys

-- (mezcla xs ys) es la lista obtenida mezclando las dos lista infinitas

-- ordenadas crecientes xs e ys. Por ejemplo,

-- λ> take 20 (mezcla [1,3..] [2,5..])

-- [1,2,3,5,7,8,9,11,13,14,15,17,19,20,21,23,25,26,27,29]

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

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

-- crecientes xs e ys. Por ejemplo,

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

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

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

diferencia (x:xs) (y:ys)

| x == y = diferencia xs ys

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

-- 2ª solución

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

-- Observando el siguiente cálculo

-- λ> take 10 noSonSumasDePADeDiferenciaUno

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

noSonSumasDePADeDiferenciaUno2 :: [Integer]

noSonSumasDePADeDiferenciaUno2 = [2^k | k <- [0..]]

-- 3ª solución

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

noSonSumasDePADeDiferenciaUno3 :: [Integer]

noSonSumasDePADeDiferenciaUno3 =

iterate (*2) 1

-- Comparación de eficiencia

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

-- La comparación es

-- λ> noSonSumasDePADeDiferenciaUno !! 14

-- 16384

-- (36.00 secs, 28,609,441,984 bytes)

-- λ> noSonSumasDePADeDiferenciaUno2 !! 14

-- 16384

-- (0.01 secs, 102,712 bytes)

-- λ> noSonSumasDePADeDiferenciaUno3 !! 14

-- 16384

-- (0.00 secs, 102,432 bytes)

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

-- 90309

-- (2.78 secs, 5,770,583,328 bytes)

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

-- 90309

-- (0.09 secs, 60,840,304 bytes)

-- λ> length (show (noSonSumasDePADeDiferenciaUno2 !! (10^7)))

-- 3010300

-- (3.55 secs, 2,030,646,392 bytes)

Nuevas soluciones

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

Productos de elementos de dos conjuntos

PorJosé A. Alonso 2-junio-202126-enero-2022

Definir la función

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

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

tal que (productos as bs c) es la lista de pares (a,b) tales que a un elementos de as, b es un elemento de bs y su producto es x, donde as y bs son listas (posiblemente infinitas) ordenadas crecientes. Por ejemplo,

   productos [3,5..] [2,4..] 2000  ==  [(5,400),(25,80),(125,16)]
   productos [3,5..] [2,4..] 2001  ==  []
   length (productos [3,5..] [2,4..] (product [1..11]))  ==  59

productos [3,5..] [2,4..] 2000 == [(5,400),(25,80),(125,16)]

productos [3,5..] [2,4..] 2001 == []

length (productos [3,5..] [2,4..] (product [1..11])) == 59

Soluciones

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

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

productos :: [Integer] -> [Integer] -> Integer -> [(Integer,Integer)]
productos as bs c =
  [(a,b) | a <- takeWhile (<= c) as,
           c `mod` a == 0,
           let b = c `div` a,
           b `pertenece` bs]

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

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

productos2 :: [Integer] -> [Integer] -> Integer -> [(Integer,Integer)]
productos2 as bs c =
  [(a,b) | a <- as',
           let b = c `div` a,
           b `pertenece` bs']
  where cs  = divisores c
        as' = interseccion cs (takeWhile (<=c) as)
        bs' = interseccion cs (takeWhile (<=c) bs)

-- (divisores x) es el conjunto de divisores de los x. Por ejemplo,
--   divisores 30  ==  [1,2,3,5,6,10,15,30]
divisores :: Integer -> [Integer]
divisores = sort
          . map (product . concat)
          . sequence
          . map inits
          . group
          . primeFactors

-- (interseccion xs ys) es la intersección entre las listas ordenadas
-- crecientes xs e ys. Por ejemplo,
--    λ> take 10 (interseccion [1,3..] [2,5..])
--    [5,11,17,23,29,35,41,47,53,59]
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 _         _         = []

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

productos3 :: [Integer] -> [Integer] -> Integer -> [(Integer,Integer)]
productos3 as bs c = aux as' bs'
  where aux (x:xs) (y:ys) | x * y == c = (x,y) : aux xs ys
                          | x * y >  c = aux (x:xs) ys
                          | otherwise  = aux xs (y:ys)
        aux _ _           = []
        cs  = divisores c
        as' = interseccion cs (takeWhile (<=c) as)
        bs' = reverse (interseccion cs (takeWhile (<=c) bs))

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

-- La compactación es
--    λ> length (productos [3,5..] [2,4..] (product [1..11]))
--    59
--    (9.83 secs, 5,588,474,408 bytes)
--    λ> length (productos2 [3,5..] [2,4..] (product [1..11]))
--    59
--    (10.48 secs, 8,942,746,480 bytes)
--    λ> length (productos3 [3,5..] [2,4..] (product [1..11]))
--    59
--    (17.39 secs, 13,413,570,800 bytes)

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

import Data.Numbers.Primes (primeFactors)

-- 1ª solución

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

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

productos as bs c =

[(a,b) | a <- takeWhile (<= c) as,

c `mod` a == 0,

let b = c `div` a,

b `pertenece` bs]

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

-- creciente ys. Por ejemplo,

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

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

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

pertenece x ys =

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

-- 2ª solución

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

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

productos2 as bs c =

[(a,b) | a <- as',

let b = c `div` a,

b `pertenece` bs']

where cs = divisores c

as' = interseccion cs (takeWhile (<=c) as)

bs' = interseccion cs (takeWhile (<=c) bs)

-- (divisores x) es el conjunto de divisores de los x. Por ejemplo,

-- divisores 30 == [1,2,3,5,6,10,15,30]

divisores :: Integer -> [Integer]

divisores = sort

. map (product . concat)

. sequence

. map inits

. group

. primeFactors

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

-- crecientes xs e ys. Por ejemplo,

-- λ> take 10 (interseccion [1,3..] [2,5..])

-- [5,11,17,23,29,35,41,47,53,59]

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 _ _ = []

-- 2ª solución

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

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

productos3 as bs c = aux as' bs'

where aux (x:xs) (y:ys) | x * y == c = (x,y) : aux xs ys

| x * y > c = aux (x:xs) ys

| otherwise = aux xs (y:ys)

aux _ _ = []

cs = divisores c

as' = interseccion cs (takeWhile (<=c) as)

bs' = reverse (interseccion cs (takeWhile (<=c) bs))

-- Comparación de eficiencia

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

-- La compactación es

-- λ> length (productos [3,5..] [2,4..] (product [1..11]))

-- 59

-- (9.83 secs, 5,588,474,408 bytes)

-- λ> length (productos2 [3,5..] [2,4..] (product [1..11]))

-- 59

-- (10.48 secs, 8,942,746,480 bytes)

-- λ> length (productos3 [3,5..] [2,4..] (product [1..11]))

-- 59

-- (17.39 secs, 13,413,570,800 bytes)

Nuevas soluciones

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

Potencias con mismos finales

PorJosé A. Alonso 1-junio-202126-enero-2022

El enunciado del primer problema de la IMO (Olimpiada Internacional de Matemáticas) de 1978 es

Sean n > m ≥ 1 números naturales tales que los 3 últimos dígitos de 1978^m y 1978^n coinciden. Calcular el par (m,n) de dichos pares para el que m+n es mínimo.

Definir la función

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

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

tal que (potenciasMismoFinales x) es la lista de los pares de naturales (m,n) tales que n > m ≥ 1 y los 3 últimos dígitos de x^m y x^n coinciden (además, la lista está ordenada por la suma de las componentes de sus elementos). Por ejemplo,

   take 3 (potenciasMismoFinales 1001) == [(1,2),(1,3),(1,4)]
   take 3 (potenciasMismoFinales 1002) == [(3,103),(4,104),(5,105)]
   take 3 (potenciasMismoFinales 1003) == [(1,101),(2,102),(3,103)]
   take 3 (potenciasMismoFinales 1004) == [(2,52),(3,53),(4,54)]
   take 3 (potenciasMismoFinales 1005) == [(3,5),(3,7),(4,6)]
   take 3 (potenciasMismoFinales 1006) == [(3,28),(4,29),(5,30)]
   take 3 (potenciasMismoFinales 1007) == [(1,21),(2,22),(3,23)]
   take 3 (potenciasMismoFinales 1008) == [(1,101),(2,102),(3,103)]
   take 3 (potenciasMismoFinales 1009) == [(1,51),(2,52),(3,53)]

take 3 (potenciasMismoFinales 1001) == [(1,2),(1,3),(1,4)]

take 3 (potenciasMismoFinales 1002) == [(3,103),(4,104),(5,105)]

take 3 (potenciasMismoFinales 1003) == [(1,101),(2,102),(3,103)]

take 3 (potenciasMismoFinales 1004) == [(2,52),(3,53),(4,54)]

take 3 (potenciasMismoFinales 1005) == [(3,5),(3,7),(4,6)]

take 3 (potenciasMismoFinales 1006) == [(3,28),(4,29),(5,30)]

take 3 (potenciasMismoFinales 1007) == [(1,21),(2,22),(3,23)]

take 3 (potenciasMismoFinales 1008) == [(1,101),(2,102),(3,103)]

take 3 (potenciasMismoFinales 1009) == [(1,51),(2,52),(3,53)]

Usando la función potenciasMismoFinales, calcular la respuesta al problema de la Olimpiada.

Soluciones

potenciasMismoFinales :: Integer -> [(Integer,Integer)]
potenciasMismoFinales x =
   [(m,n) | (m,n) <- pares,
            x^m `mod` 1000 == x^n `mod` 1000]

-- pares el lista de pares de enteros positivos, con el primero menor que
-- el segundo, ordenados por su suma y primer elemento. Por ejemplo,
--    λ> take 10 pares
--    [(1,2),(1,3),(1,4),(2,3),(1,5),(2,4),(1,6),(2,5),(3,4),(1,7)]
pares :: [(Integer,Integer)]
pares = [(m,n) | x <- [1..],
                 m <- [1..x],
                 let n = x-m,
                 n > m]

-- Cálculo de la respuesta
-- =======================

-- El cálculo es
--    λ> head (potenciasMismoFinales 1978)
--    (3,103)

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

potenciasMismoFinales x =

[(m,n) | (m,n) <- pares,

x^m `mod` 1000 == x^n `mod` 1000]

-- pares el lista de pares de enteros positivos, con el primero menor que

-- el segundo, ordenados por su suma y primer elemento. Por ejemplo,

-- λ> take 10 pares

-- [(1,2),(1,3),(1,4),(2,3),(1,5),(2,4),(1,6),(2,5),(3,4),(1,7)]

pares :: [(Integer,Integer)]

pares = [(m,n) | x <- [1..],

m <- [1..x],

let n = x-m,

n > m]

-- Cálculo de la respuesta

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

-- El cálculo es

-- λ> head (potenciasMismoFinales 1978)

-- (3,103)

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>

Mayor producto con sumandos de la descomposición

PorJosé A. Alonso 31-mayo-202126-enero-2022

El enunciado del 4º problema para la IMO (Olimpiada Internacional de Matemáticas) de 1976 es

Calcular el mayor número que se puede obtener multiplicando los enteros positivos cuya suma es 1976.

Definir la función

   mayorProductoSumandos :: Integer -> Integer

1	mayorProductoSumandos :: Integer -> Integer

tal que (mayorProductoSumandos n) el mayor número que se puede obtener multiplicando los enteros positivos cuya suma es n. Por ejemplo,

   mayorProductoSumandos 5 == 6

1	mayorProductoSumandos 5 == 6

ya que los posibles listas de sumandos con suma 5 son

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

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

sus productos son

   5,   6,     4,     4,       3,       2,         1

1	5, 6, 4, 4, 3, 2, 1

y el mayor de dichos productos es 6.

Otros ejemplos son

   mayorProductoSumandos 10   ==  36
   mayorProductoSumandos 100  ==  7412080755407364
   length (show (mayorProductoSumandos (10^8)))  ==  15904042

mayorProductoSumandos 10 == 36

mayorProductoSumandos 100 == 7412080755407364

length (show (mayorProductoSumandos (10^8))) == 15904042

Usando la función mayorProductoSumandos, calcular la respuesta al problema de la Olimpiada.

Soluciones

import Data.Numbers.Primes (primeFactors)
import Data.List (genericLength, group)
import Test.QuickCheck (Property, (==>), quickCheck)

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

mayorProductoSumandos :: Integer -> Integer
mayorProductoSumandos n =
  maximum [product xs | xs <- sumandos n]

-- (sumandos n) es la lista de las descomposiciones de n
-- como suma de números naturales. Por ejemplo,
--    sumandos 3  ==  [[3],[1,2],[1,1,1],[2,1]]
sumandos :: Integer -> [[Integer]]
sumandos 1 = [[1]]
sumandos n =
  [n]: [n-x:ys | x <- [1..n-1], ys <- sumandos x, n-x <= head ys]

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

mayorProductoSumandos2 :: Integer -> Integer
mayorProductoSumandos2 n
  | n < 5     = n
  | otherwise = maximum [(n-i) * mayorProductoSumandos2 i
                        | i <- [1..n-1]]

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

-- Observando los siguientes cálculos
--    λ> [mayorProductoSumandos n | n <- [0..20]]
--    [0,1,2,3,4,6,9,12,18,27,36,54,81,108,162,243,324,486,729,972,1458]
--    λ> [mayorProductoSumandos n | n <- [0,3..20]]
--    [0,3,9,27,81,243,729]
--    λ> [mayorProductoSumandos n | n <- [1,4..20]]
--    [1,4,12,36,108,324,972]
--    λ> [mayorProductoSumandos n | n <- [2,5..20]]
--    [2,6,18,54,162,486,1458]

mayorProductoSumandos3 :: Integer -> Integer
mayorProductoSumandos3 n
  | n < 5     = n
  | otherwise = 3 * mayorProductoSumandos3 (n-3)

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

-- (factorizacion n) es la descomposición de n en factores primos como
-- una lista de pares donde los primeros elementos son la base y los
-- segundo son los exponentes. Por ejemplo,
--    factorizacion 3000  ==  [(2,3),(3,1),(5,3)]
-- ya que 3000 = 2^3*3*5^3
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
  [(head xs,genericLength xs) | xs <- group (primeFactors n)]

-- Observando los siguientes cálculos
--    λ> [factorizacion (mayorProductoSumandos3 n) | n <- [3,6..20]]
--    [[(3,1)],[(3,2)],[(3,3)],[(3,4)],[(3,5)],[(3,6)]]
--    λ> [factorizacion (mayorProductoSumandos3 n) | n <- [4,7..20]]
--    [[(2,2)],[(2,2),(3,1)],[(2,2),(3,2)],[(2,2),(3,3)],[(2,2),(3,4)],[(2,2),(3,5)]]
--    λ> [factorizacion (mayorProductoSumandos3 n) | n <- [5,8..20]]
--    [[(2,1),(3,1)],[(2,1),(3,2)],[(2,1),(3,3)],[(2,1),(3,4)],[(2,1),(3,5)],[(2,1),(3,6)]]

mayorProductoSumandos4 :: Integer -> Integer
mayorProductoSumandos4 n
    | n < 5     = n
    | otherwise = case r of
                    0 -> 3^q
                    1 -> 4*3^(q-1)
                    2 -> 2*3^q
  where (q,r) = quotRem n 3

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

-- Para los primeros valores la propiedad es
prop_equivalencia1 :: Integer -> Bool
prop_equivalencia1 n =
  and [f k == mayorProductoSumandos4 k
      | k <- [0..n],
        f <- [mayorProductoSumandos,
              mayorProductoSumandos2,
              mayorProductoSumandos3]]

-- La comprobación es
--    λ> prop_equivalencia1 20
--    True

-- Para los grandes valores la propiedad es
prop_equivalencia2 :: Integer -> Property
prop_equivalencia2 n =
  n >= 0 ==>
  mayorProductoSumandos3 n == mayorProductoSumandos4 n

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

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

-- La comparación es
--    λ> mayorProductoSumandos 22
--    2916
--    (2.99 secs, 2,319,928,184 bytes)
--    λ> mayorProductoSumandos2 22
--    2916
--    (0.47 secs, 313,625,800 bytes)
--    λ> mayorProductoSumandos3 22
--    2916
--    (0.01 secs, 103,864 bytes)
--    λ> mayorProductoSumandos4 22
--    2916
--    (0.01 secs, 102,712 bytes)
--
--    λ> mayorProductoSumandos2 25
--    8748
--    (3.26 secs, 2,508,295,368 bytes)
--    λ> mayorProductoSumandos3 25
--    8748
--    (0.00 secs, 103,960 bytes)
--    λ> mayorProductoSumandos4 25
--    8748
--    (0.00 secs, 102,856 bytes)
--
--    λ> length (show (mayorProductoSumandos3 (10^6)))
--    159041
--    (9.83 secs, 11,400,807,392 bytes)
--    λ> length (show (mayorProductoSumandos4 (10^6)))
--    159041
--    (0.03 secs, 10,082,080 bytes)
--
--    λ> length (show (mayorProductoSumandos4 (10^8)))
--    15904042
--    (3.53 secs, 1,022,783,472 bytes)

-- Cálculo de la respuesta al problema
-- ===================================

-- El cálculo es
--    λ> mayorProductoSumandos4 1976
--    176528813092650631321824697527678863603414507360733532172646534742
--    374472004561447647833551576599071841268147340684692909561979543969
--    046876247215728742219795875277856143555895806750102055076974383708
--    360617266962123284615873951950033196388833843896325045289546019012
--    398784375461116652095995292235273337590912307103378
--    λ> factorizacion (mayorProductoSumandos4 1976)
--    [(2,1),(3,658)]
--    λ> mayorProductoSumandos3 1976 == 2*3^658
--    True

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

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group)

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

-- 1ª solución

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

mayorProductoSumandos :: Integer -> Integer

mayorProductoSumandos n =

maximum [product xs | xs <- sumandos n]

-- (sumandos n) es la lista de las descomposiciones de n

-- como suma de números naturales. Por ejemplo,

-- sumandos 3 == [[3],[1,2],[1,1,1],[2,1]]

sumandos :: Integer -> [[Integer]]

sumandos 1 = [[1]]

sumandos n =

[n]: [n-x:ys | x <- [1..n-1], ys <- sumandos x, n-x <= head ys]

-- 2ª solución

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

mayorProductoSumandos2 :: Integer -> Integer

mayorProductoSumandos2 n

| n < 5 = n

| otherwise = maximum [(n-i) * mayorProductoSumandos2 i

| i <- [1..n-1]]

-- 3ª solución

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

-- Observando los siguientes cálculos

-- λ> [mayorProductoSumandos n | n <- [0..20]]

-- [0,1,2,3,4,6,9,12,18,27,36,54,81,108,162,243,324,486,729,972,1458]

-- λ> [mayorProductoSumandos n | n <- [0,3..20]]

-- [0,3,9,27,81,243,729]

-- λ> [mayorProductoSumandos n | n <- [1,4..20]]

-- [1,4,12,36,108,324,972]

-- λ> [mayorProductoSumandos n | n <- [2,5..20]]

-- [2,6,18,54,162,486,1458]

mayorProductoSumandos3 :: Integer -> Integer

mayorProductoSumandos3 n

| n < 5 = n

| otherwise = 3 * mayorProductoSumandos3 (n-3)

-- 4ª solución

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

-- (factorizacion n) es la descomposición de n en factores primos como

-- una lista de pares donde los primeros elementos son la base y los

-- segundo son los exponentes. Por ejemplo,

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

-- ya que 3000 = 2^3*3*5^3

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

factorizacion n =

[(head xs,genericLength xs) | xs <- group (primeFactors n)]

-- Observando los siguientes cálculos

-- λ> [factorizacion (mayorProductoSumandos3 n) | n <- [3,6..20]]

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

-- λ> [factorizacion (mayorProductoSumandos3 n) | n <- [4,7..20]]

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

-- λ> [factorizacion (mayorProductoSumandos3 n) | n <- [5,8..20]]

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

mayorProductoSumandos4 :: Integer -> Integer

mayorProductoSumandos4 n

| n < 5 = n

| otherwise = case r of

0 -> 3^q

1 -> 4*3^(q-1)

2 -> 2*3^q

where (q,r) = quotRem n 3

-- Comprobación de equivalencia

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

-- Para los primeros valores la propiedad es

prop_equivalencia1 :: Integer -> Bool

prop_equivalencia1 n =

and [f k == mayorProductoSumandos4 k

| k <- [0..n],

f <- [mayorProductoSumandos,

mayorProductoSumandos2,

mayorProductoSumandos3]]

-- La comprobación es

-- λ> prop_equivalencia1 20

-- True

-- Para los grandes valores la propiedad es

prop_equivalencia2 :: Integer -> Property

prop_equivalencia2 n =

n >= 0 ==>

mayorProductoSumandos3 n == mayorProductoSumandos4 n

-- La comprobación es

-- λ> quickCheck prop_equivalencia2

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> mayorProductoSumandos 22

-- 2916

-- (2.99 secs, 2,319,928,184 bytes)

-- λ> mayorProductoSumandos2 22

-- 2916

-- (0.47 secs, 313,625,800 bytes)

-- λ> mayorProductoSumandos3 22

-- 2916

-- (0.01 secs, 103,864 bytes)

-- λ> mayorProductoSumandos4 22

-- 2916

-- (0.01 secs, 102,712 bytes)

-- λ> mayorProductoSumandos2 25

-- 8748

-- (3.26 secs, 2,508,295,368 bytes)

-- λ> mayorProductoSumandos3 25

-- 8748

-- (0.00 secs, 103,960 bytes)

-- λ> mayorProductoSumandos4 25

-- 8748

-- (0.00 secs, 102,856 bytes)

-- λ> length (show (mayorProductoSumandos3 (10^6)))

-- 159041

-- (9.83 secs, 11,400,807,392 bytes)

-- λ> length (show (mayorProductoSumandos4 (10^6)))

-- 159041

-- (0.03 secs, 10,082,080 bytes)

-- λ> length (show (mayorProductoSumandos4 (10^8)))

-- 15904042

-- (3.53 secs, 1,022,783,472 bytes)

-- Cálculo de la respuesta al problema

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

-- El cálculo es

-- λ> mayorProductoSumandos4 1976

-- 176528813092650631321824697527678863603414507360733532172646534742

-- 374472004561447647833551576599071841268147340684692909561979543969

-- 046876247215728742219795875277856143555895806750102055076974383708

-- 360617266962123284615873951950033196388833843896325045289546019012

-- 398784375461116652095995292235273337590912307103378

-- λ> factorizacion (mayorProductoSumandos4 1976)

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

-- λ> mayorProductoSumandos3 1976 == 2*3^658

-- True

Nuevas soluciones

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

Múltiplos sin ceros

PorJosé A. Alonso 28-mayo-20214-junio-2021

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1972 es

Demostrar que cada n ≢ 0 (mod 10) posee algún múltiplo sin el dígito 0.

Definir la función

   multiplosSinCeros :: Integer -> [Integer]

1	multiplosSinCeros :: Integer -> [Integer]

tal que (multiplosSinCeros n) es la lista de los múltiplos de n sin el dígito 0. Por ejemplo,

   λ> take 10 (multiplosSinCeros 101)
   [1111,1212,1313,1414,1515,1616,1717,1818,1919,2121]

1 2	λ> take 10 (multiplosSinCeros 101) [1111,1212,1313,1414,1515,1616,1717,1818,1919,2121]

Comprobar con QuickCheck que si n es un número entero positivo no divisible por 10, entonces n posee algún múltiplo sin el dígito 0.

Soluciones

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

multiplosSinCeros :: Integer -> [Integer]
multiplosSinCeros n =
  filter sinCeros [n,2*n..]

sinCeros :: Integer -> Bool
sinCeros n =
  '0' `notElem` show n

-- La propiedad es
prop_multiplosSinCeros :: Integer -> Property
prop_multiplosSinCeros n =
  n > 0 && n `mod` 10 /= 0 ==>
  not (null (multiplosSinCeros n))

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

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

multiplosSinCeros :: Integer -> [Integer]

multiplosSinCeros n =

filter sinCeros [n,2*n..]

sinCeros :: Integer -> Bool

sinCeros n =

'0' `notElem` show n

-- La propiedad es

prop_multiplosSinCeros :: Integer -> Property

prop_multiplosSinCeros n =

n > 0 && n `mod` 10 /= 0 ==>

not (null (multiplosSinCeros n))

-- La comprobación es

-- λ> quickCheck prop_multiplosSinCeros

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Sumas con signos

PorJosé A. Alonso 27-mayo-20213-junio-2021

El enunciado de un problema para la Olimpiada Internacional de Matemáticas (IMO) de 1970 es

Sean x1, x2, x3, x4, x5, x6 enteros no divisibles por 7. Demostrar que alguna de las sumas

±x1 ± x2 ± x3 ± x4 ± x5 ± x6

es divisible por 7, donde los signos se seleccionan de todas las manera posibles. (Generalizar la propiedad para todos los primos).

Definir la función

   sumas :: [Integer] -> [Integer]

1	sumas :: [Integer] -> [Integer]

tal que (sumas xs) es la lista de los valores de las sumas

   ±x(1) ± x(2) ± ··· ± x(n)

1	±x(1) ± x(2) ± ··· ± x(n)

donde [x(1),x(2),…,x(n)] = xs y los signos se seleccionan de todas las manera posibles. Por ejemplo,

   sort (sumas [3])      ==  [-3,3]
   sort (sumas [2,3])    ==  [-5,-1,1,5]
   sort (sumas [1,2,3])  ==  [-6,-4,-2,0,2,4,6]

sort (sumas [3]) == [-3,3]

sort (sumas [2,3]) == [-5,-1,1,5]

sort (sumas [1,2,3]) == [-6,-4,-2,0,2,4,6]

Comprobar con QuickCheck que para todo número primo impar p y toda lista xs de longitud (p-1) de elementos no divisibles por p se verifica que la lista (sumas xs) tiene algún elemento divisible por p.

Soluciones

import Data.List (sort)
import Test.QuickCheck (Positive(..), Property, Gen,
                        arbitrary, forAll, sample, suchThat)
import Data.Numbers.Primes (primes)

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

sumas :: [Integer] -> [Integer]
sumas ns = map sum (expresiones ns)

-- (expresiones xs) es la lista de las expresiones de la forma
--    ±x(1) ± x(2) ± ··· ± x(n)
-- donde [x(1),x(2),...,x(n)] = xs y los signos se seleccionan de todas
-- las manera posibles. Por ejemplo,
--    λ> expresiones [3]
--    [[3],[-3]]
--    λ> expresiones [2,3]
--    [[2,3],[2,-3],[-2,3],[-2,-3]]
--    λ> expresiones [1,2,3]
--    [[1, 2,3],[1, 2,-3],[1, -2,3],[1, -2,-3],
--     [-1,2,3],[-1,2,-3],[-1,-2,3],[-1,-2,-3]]
expresiones :: [Integer] -> [[Integer]]
expresiones []     = [[]]
expresiones (n:ns) = [x:xs | x <- [n,-n], xs <- expresiones ns]

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

sumas2 :: [Integer] -> [Integer]
sumas2 ns = map snd (expresiones2 ns)

-- (expresiones2 xs) es la lista de las expresiones, junto con sus
-- sumas, de la forma
--    ±x(1) ± x(2) ± ··· ± x(n)
-- donde [x(1),x(2),...,x(n)] = xs y los signos se seleccionan de todas
-- las manera posibles. Por ejemplo,
--    λ> expresiones2 [3]
--    [([3],3),([-3],-3)]
--    λ> expresiones2 [2,3]
--    [([2,3],5),([2,-3],-1),([-2,3],1),([-2,-3],-5)]
--    λ> expresiones2 [1,2,3]
--    [([1,2,3],6),([1,2,-3],0),([1,-2,3],2),([1,-2,-3],-4),
--     ([-1,2,3],4),([-1,2,-3],-2),([-1,-2,3],0),([-1,-2,-3],-6)]
expresiones2 :: [Integer] -> [([Integer],Integer)]
expresiones2 []     = [([],0)]
expresiones2 (n:ns) = [(x:xs,x+m) | x <- [n,-n], (xs,m) <- expresiones2 ns]

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

-- La propiedad es
prop_equiv :: [Integer] -> Bool
prop_equiv xs =
  sumas ys == sumas2 ys
  where ys = take 10 xs

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

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

-- La comparación es
--    λ> length (sumas [1..20])
--    1048576
--    (2.18 secs, 3,095,500,560 bytes)
--    λ> length (sumas2 [1..20])
--    1048576
--    (3.17 secs, 4,647,393,392 bytes)

-- Comprobación de la propiedad
-- ============================

-- La propiedad es
prop_sumas :: (Positive Int) -> Property
prop_sumas (Positive n) =
  forAll (listaNoDivisibles p (p-1)) (tieneSumaMultiplo p)
  where p = primes !! n

-- (listaNoDivisibles p n) es un generador de listas de longitud n cuyos
-- elementos son son divisibles por p. Por ejemplo,
--    λ> sample (listaNoDivisibles 5 4)
--    [1,-1,1,-1]
--    [2,-2,-2,-2]
--    [3,-3,-2,2]
--    [4,4,-4,-4]
--    [1,8,8,1]
--    [-4,-3,3,2]
--    [8,-7,8,-13]
--    [-4,-12,-13,11]
--    [1,2,-12,-8]
--    [-4,-16,7,7]
--    [16,-17,16,-7]
listaNoDivisibles :: Integer -> Integer -> Gen [Integer]
listaNoDivisibles _ 0 = return []
listaNoDivisibles p n = do
  x <- suchThat arbitrary (\i -> i `mod` p /= 0)
  xs <- listaNoDivisibles p (n-1)
  return (x:xs)

-- (tieneSumaMultiplo n xs) se verifica si algún elemento de (sumas xs)
-- es un múltiplo de n. Por ejemplo,
--    tieneSumaMultiplo 5 [2,3]  ==  True
--    tieneSumaMultiplo 4 [2,3]  ==  False
tieneSumaMultiplo n xs =
  or [s `mod` n == 0 | s <- sumas xs]

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

100

101

102

103

104

105

106

107

108

109

110

111

112

import Data.List (sort)

import Test.QuickCheck (Positive(..), Property, Gen,

arbitrary, forAll, sample, suchThat)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

sumas :: [Integer] -> [Integer]

sumas ns = map sum (expresiones ns)

-- (expresiones xs) es la lista de las expresiones de la forma

-- ±x(1) ± x(2) ± ··· ± x(n)

-- donde [x(1),x(2),...,x(n)] = xs y los signos se seleccionan de todas

-- las manera posibles. Por ejemplo,

-- λ> expresiones [3]

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

-- λ> expresiones [2,3]

-- [[2,3],[2,-3],[-2,3],[-2,-3]]

-- λ> expresiones [1,2,3]

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

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

expresiones :: [Integer] -> [[Integer]]

expresiones [] = [[]]

expresiones (n:ns) = [x:xs | x <- [n,-n], xs <- expresiones ns]

-- 2ª solución

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

sumas2 :: [Integer] -> [Integer]

sumas2 ns = map snd (expresiones2 ns)

-- (expresiones2 xs) es la lista de las expresiones, junto con sus

-- sumas, de la forma

-- ±x(1) ± x(2) ± ··· ± x(n)

-- donde [x(1),x(2),...,x(n)] = xs y los signos se seleccionan de todas

-- las manera posibles. Por ejemplo,

-- λ> expresiones2 [3]

-- [([3],3),([-3],-3)]

-- λ> expresiones2 [2,3]

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

-- λ> expresiones2 [1,2,3]

-- [([1,2,3],6),([1,2,-3],0),([1,-2,3],2),([1,-2,-3],-4),

-- ([-1,2,3],4),([-1,2,-3],-2),([-1,-2,3],0),([-1,-2,-3],-6)]

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

expresiones2 [] = [([],0)]

expresiones2 (n:ns) = [(x:xs,x+m) | x <- [n,-n], (xs,m) <- expresiones2 ns]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equiv :: [Integer] -> Bool

prop_equiv xs =

sumas ys == sumas2 ys

where ys = take 10 xs

-- La comprobación es

-- λ> quickCheck prop_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (sumas [1..20])

-- 1048576

-- (2.18 secs, 3,095,500,560 bytes)

-- λ> length (sumas2 [1..20])

-- 1048576

-- (3.17 secs, 4,647,393,392 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_sumas :: (Positive Int) -> Property

prop_sumas (Positive n) =

forAll (listaNoDivisibles p (p-1)) (tieneSumaMultiplo p)

where p = primes !! n

-- (listaNoDivisibles p n) es un generador de listas de longitud n cuyos

-- elementos son son divisibles por p. Por ejemplo,

-- λ> sample (listaNoDivisibles 5 4)

-- [1,-1,1,-1]

-- [2,-2,-2,-2]

-- [3,-3,-2,2]

-- [4,4,-4,-4]

-- [1,8,8,1]

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

-- [8,-7,8,-13]

-- [-4,-12,-13,11]

-- [1,2,-12,-8]

-- [-4,-16,7,7]

-- [16,-17,16,-7]

listaNoDivisibles :: Integer -> Integer -> Gen [Integer]

listaNoDivisibles _ 0 = return []

listaNoDivisibles p n = do

x <- suchThat arbitrary (\i -> i `mod` p /= 0)

xs <- listaNoDivisibles p (n-1)

return (x:xs)

-- (tieneSumaMultiplo n xs) se verifica si algún elemento de (sumas xs)

-- es un múltiplo de n. Por ejemplo,

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

-- tieneSumaMultiplo 4 [2,3] == False

tieneSumaMultiplo n xs =

or [s `mod` n == 0 | s <- sumas xs]

-- La comprobación es

-- λ> quickCheck prop_sumas

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Números divisibles respecto de una sucesión

PorJosé A. Alonso 26-mayo-20212-junio-2021

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1968 es

Sean a(0), a(1), …, a(n) (con n ≥ 1) números enteros positivos. Encontrar todos los números enteros y tales que

a(0) | y; (a(0)+a(1)) | (y+a(1)); … ; (a(0)+a(n)) | (y+a(n)).

donde «x | y» significa que «y es divisible por x».

Se dice que un número y es divisible respecto de la sucesión a(0), a(1), …, a(n) si verifica la propiedad anterior; es decir,

      a(0) | y; (a(0)+a(1)) | (y+a(1)); ... ; (a(0)+a(n)) | (y+a(n)).

1	a(0) \| y; (a(0)+a(1)) \| (y+a(1)); ... ; (a(0)+a(n)) \| (y+a(n)).

Definir la función

   divisiblesSucesion :: [Integer] -> [Integer]

1	divisiblesSucesion :: [Integer] -> [Integer]

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

   take 6 (divisiblesSucesion [2,5,3])     ==  [2,72,142,212,282,352]
   divisiblesSucesion [3,5..30] !! (10^5)  ==  144144000003
   divisiblesSucesion [3,5..30] !! (10^6)  ==  1441440000003
   divisiblesSucesion [3,5..30] !! (10^7)  ==  14414400000003

take 6 (divisiblesSucesion [2,5,3]) == [2,72,142,212,282,352]

divisiblesSucesion [3,5..30] !! (10^5) == 144144000003

divisiblesSucesion [3,5..30] !! (10^6) == 1441440000003

divisiblesSucesion [3,5..30] !! (10^7) == 14414400000003

Soluciones

import Test.QuickCheck (quickCheck)

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

divisiblesSucesion :: [Integer] -> [Integer]
divisiblesSucesion xs =
  filter (esDivisibleSucesion xs) [1..]

-- (esDivisibleSucesion xs y) se verifica si y es divisible respecto de
-- la sucesión xs. Por ejemplo,
--    esDivisibleSucesion [2,5,3] 72  ==  True
--    esDivisibleSucesion [2,5,3] 12  ==  False
esDivisibleSucesion :: [Integer] -> Integer -> Bool
esDivisibleSucesion [] _      = True
esDivisibleSucesion (a0:as) y =
  y `mod` a0 == 0 &&
  and [(y+a) `mod` (a0+a) == 0 | a <- as]

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

-- En los siguientes cálculos
--    λ> take 5 (divisiblesSucesion [2,3,5])
--    [2,72,142,212,282]
--    λ> foldl1 lcm [2, 2+3, 2+5]
--    70
--    λ> take 5 (divisiblesSucesion [2,3,5,6])
--    [2,282,562,842,1122]
--    λ> foldl1 lcm [2, 2+3, 2+5, 2+6]
--    280
--    λ> take 5 (divisiblesSucesion [1,3,5,6])
--    [1,85,169,253,337]
--    λ> foldl1 lcm [1, 1+3, 1+5, 1+6]
--    84
-- se observa que los resultados son progresiones aritméticas cuyo
-- primer elemento es a(0) y la diferencia es el mínimo común múltiplo
-- de [a(0), a(0)+a(1), a(0)+a(2), ..., a(0)+a(n)]

divisiblesSucesion2 :: [Integer] -> [Integer]
divisiblesSucesion2 []      = [1..]
divisiblesSucesion2 (a0:as) = [a0,a0+m..]
  where m = mcm (a0 : [a0+a | a <- as])

-- (mcm xs) es el mínimo común múltiplo de xs. Por ejemplo,
--    mcm [2,5,3]  ==  30
--    mcm [2,2+5,2+3]  ==  70
mcm :: [Integer] -> Integer
mcm = foldl1 lcm

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

-- La propiedad es
prop_equivalencia :: [Integer] -> Bool
prop_equivalencia  xs =
  take 3 (divisiblesSucesion ys) == take 3 (divisiblesSucesion2 ys)
  where ys = take 5 [1 + (x `mod` 10) | x <- xs]

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

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

-- La comparación es
--    λ> divisiblesSucesion [3,5..30] !! 20
--    28828803
--    (16.86 secs, 15,933,990,784 bytes)
--    λ> divisiblesSucesion2 [3,5..30] !! 20
--    28828803
--    (0.01 secs, 112,496 bytes)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

divisiblesSucesion :: [Integer] -> [Integer]

divisiblesSucesion xs =

filter (esDivisibleSucesion xs) [1..]

-- (esDivisibleSucesion xs y) se verifica si y es divisible respecto de

-- la sucesión xs. Por ejemplo,

-- esDivisibleSucesion [2,5,3] 72 == True

-- esDivisibleSucesion [2,5,3] 12 == False

esDivisibleSucesion :: [Integer] -> Integer -> Bool

esDivisibleSucesion [] _ = True

esDivisibleSucesion (a0:as) y =

y `mod` a0 == 0 &&

and [(y+a) `mod` (a0+a) == 0 | a <- as]

-- 2ª solución

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

-- En los siguientes cálculos

-- λ> take 5 (divisiblesSucesion [2,3,5])

-- [2,72,142,212,282]

-- λ> foldl1 lcm [2, 2+3, 2+5]

-- 70

-- λ> take 5 (divisiblesSucesion [2,3,5,6])

-- [2,282,562,842,1122]

-- λ> foldl1 lcm [2, 2+3, 2+5, 2+6]

-- 280

-- λ> take 5 (divisiblesSucesion [1,3,5,6])

-- [1,85,169,253,337]

-- λ> foldl1 lcm [1, 1+3, 1+5, 1+6]

-- 84

-- se observa que los resultados son progresiones aritméticas cuyo

-- primer elemento es a(0) y la diferencia es el mínimo común múltiplo

-- de [a(0), a(0)+a(1), a(0)+a(2), ..., a(0)+a(n)]

divisiblesSucesion2 :: [Integer] -> [Integer]

divisiblesSucesion2 [] = [1..]

divisiblesSucesion2 (a0:as) = [a0,a0+m..]

where m = mcm (a0 : [a0+a | a <- as])

-- (mcm xs) es el mínimo común múltiplo de xs. Por ejemplo,

-- mcm [2,5,3] == 30

-- mcm [2,2+5,2+3] == 70

mcm :: [Integer] -> Integer

mcm = foldl1 lcm

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia :: [Integer] -> Bool

prop_equivalencia xs =

take 3 (divisiblesSucesion ys) == take 3 (divisiblesSucesion2 ys)

where ys = take 5 [1 + (x `mod` 10) | x <- xs]

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> divisiblesSucesion [3,5..30] !! 20

-- 28828803

-- (16.86 secs, 15,933,990,784 bytes)

-- λ> divisiblesSucesion2 [3,5..30] !! 20

-- 28828803

-- (0.01 secs, 112,496 bytes)

Nuevas soluciones

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

Descomposiciones como sumas de consecutivos

PorJosé A. Alonso 25-mayo-20211-junio-2021

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1966 es

(a) Calcular el número de maneras de expresar 500 como suma de números naturales consecutivos.

(b) Calcular el número de tales representaciones para n = 2^x·3^y·5^z, con x, y, z ∈ ℕ. ¿Cuántas de ellas están formadas por un único elemento?

(c) Calcular el número de tales representaciones para un número natural n.

Definir las funciones

   consecutivosConSuma    :: Integer -> [(Integer,Integer)]
   nDeConsecutivosConSuma :: Integer -> Integer

1 2	consecutivosConSuma :: Integer -> [(Integer,Integer)] nDeConsecutivosConSuma :: Integer -> Integer

tales que

(consecutivosConSuma n) es la lista de los extremos de las sucesiones de números naturales consecutivos cuya suma es n. Por ejemplo,

     consecutivosConSuma 3  ==  [(0,2),(1,2),(3,3)]
     consecutivosConSuma 4  ==  [(4,4)]
     consecutivosConSuma 5  ==  [(2,3),(5,5)]
     consecutivosConSuma 6  ==  [(0,3),(1,3),(6,6)]
     consecutivosConSuma 15 ==  [(0,5),(1,5),(4,6),(7,8),(15,15)]
     maximum [length (consecutivosConSuma n) | n <- [1..1000]] == 16

consecutivosConSuma 3 == [(0,2),(1,2),(3,3)]

consecutivosConSuma 4 == [(4,4)]

consecutivosConSuma 5 == [(2,3),(5,5)]

consecutivosConSuma 6 == [(0,3),(1,3),(6,6)]

consecutivosConSuma 15 == [(0,5),(1,5),(4,6),(7,8),(15,15)]

maximum [length (consecutivosConSuma n) | n <- [1..1000]] == 16

(nDeConsecutivosConSuma n) es la cantidad de sucesiones de números naturales consecutivos cuya suma es n. Por ejemplo,

     nDeConsecutivosConSuma 3  ==  3
     nDeConsecutivosConSuma 4  ==  1
     nDeConsecutivosConSuma 5  ==  2
     nDeConsecutivosConSuma 6  ==  3
     nDeConsecutivosConSuma 15 ==  5
     maximum [nDeConsecutivosConSuma n | n <- [1..10^5]] == 49
     nDeConsecutivosConSuma (product [1..17])            == 672

nDeConsecutivosConSuma 3 == 3

nDeConsecutivosConSuma 4 == 1

nDeConsecutivosConSuma 5 == 2

nDeConsecutivosConSuma 6 == 3

nDeConsecutivosConSuma 15 == 5

maximum [nDeConsecutivosConSuma n | n <- [1..10^5]] == 49

nDeConsecutivosConSuma (product [1..17]) == 672

Usando las funciones anteriores, calcular las respuestas del problema de la Olimpiada.

Soluciones

import Data.List (genericLength, genericTake, group)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck (Positive(..), quickCheck)

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

consecutivosConSuma :: Integer -> [(Integer,Integer)]
consecutivosConSuma n =
  [(x,y) | y <- [0..n],
           x <- [0..y],
           sum [x..y] == n]

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

consecutivosConSuma2 :: Integer -> [(Integer,Integer)]
consecutivosConSuma2 n =
  [(x,y) | y <- [0..n],
           x <- [0..y],
           (x+y)*(y-x+1) == 2*n]

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

consecutivosConSuma3 :: Integer -> [(Integer,Integer)]
consecutivosConSuma3 n
  | esTriangular n = (0, p n - 1) : [(p x, p y - 1) | (x,y) <- aux n]
  | otherwise      = [(p x, p y - 1) | (x,y) <- aux n]
  where p x = posicion x triangulares
        aux n = [(x,y) | y <- zs,
                         let x = y-n,
                         x `elem` zs]
          where zs = genericTake (n+1) triangulares

-- (esTriangular n) se verifica si n es un número triangular (es decir,
-- existe un m tal que n es 1+2+···+m). Por ejemplo,
--    esTriangular 6  ==  True
--    esTriangular 8  ==  False
esTriangular :: Integer -> Bool
esTriangular n =
  n `pertenece` triangulares

-- triangulares es la sucesión de los números triangulares. Por ejemplo,
--    take 10 triangulares  ==  [0,1,3,6,10,15,21,28,36,45]
triangulares :: [Integer]
triangulares = scanl1 (+) [0..]

-- (pertenece x ys) se verifica si x pertenece a la lista infinita
-- creciente ys. Por ejemplo,
--    pertenece 11 [1,3..]  ==  True
--    pertenece 12 [1,3..]  ==  False
pertenece :: Ord a => a -> [a] -> Bool
pertenece x ys =
  x == head (dropWhile (< x) ys)

-- (posicion x ys) es la posición de x en la lista ys. Por ejemplo,
--    posicion 7 [1,3..]  ==  4
posicion :: Eq a => a -> [a] -> Integer
posicion x (y:ys) | x == y    = 1
                  | otherwise = 1 + posicion x ys

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

-- La comparación es
--    λ> maximum [length (consecutivosConSuma2 n) | n <- [1..200]]
--    9
--    (0.96 secs, 651,218,112 bytes)
--    λ> maximum [length (consecutivosConSuma3 n) | n <- [1..200]]
--    9
--    (0.04 secs, 6,664,544 bytes)
--
--    λ> maximum [length (consecutivosConSuma2 n) | n <- [1..300]]
--    9
--    (3.14 secs, 2,172,860,536 bytes)
--    λ> maximum [length (consecutivosConSuma3 n) | n <- [1..300]]
--    9
--    (0.16 secs, 14,523,880 bytes)

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

nDeConsecutivosConSuma :: Integer -> Integer
nDeConsecutivosConSuma = genericLength . consecutivosConSuma

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

nDeConsecutivosConSuma2 :: Integer -> Integer
nDeConsecutivosConSuma2 = genericLength . consecutivosConSuma2

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

nDeConsecutivosConSuma3 :: Integer -> Integer
nDeConsecutivosConSuma3 = genericLength . consecutivosConSuma3

-- Cálculo de las respuestas
-- =========================

-- El número de maneras de expresar 500 como suma de números naturales
-- consecutivos se calcula con
--    λ> nDeConsecutivosConSuma 500
--    4
-- Por tanto, se puede expresar de 4 formas distintas. Dichas
-- expresiones se pueden calcular consecutivos
--    λ> consecutivosConSuma 500
--    [(8,32),(59,66),(98,102),(500,500)]
-- Es decir,
--    500 = sum [8..32]
--    500 = sum [59..66]
--    500 = sum [98..102]
--    500 = sum [500..500]

-- Para la segunda pregunta realizamos los siguientes cálculos
--    λ> ts = [(x,y,z) | x <- [0..3], y <- [0..3], z <- [0..3]]
--    λ> as = [nDeConsecutivosConSuma3 (2^x*3^y*5^z) | (x,y,z) <- ts]
--    λ> as
--    [2,2,3,4,3,5,6,8,3,7,9,12,4,8,12,16,
--     1,3,3,4,3,4,6,8,3,6,9,12,4,8,12,16,
--     1,2,3,4,2,4,7,8,4,6,9,12,4,8,12,16,
--     1,2,3,4,2,5,6,8,3,6,9,12,4,8,12,16]
--    λ> bs = [(y+1)*(z+1) | (x,y,z) <- ts]
--    λ> bs
--    [1,2,3,4,2,4,6,8,3,6,9,12,4,8,12,16,
--     1,2,3,4,2,4,6,8,3,6,9,12,4,8,12,16,
--     1,2,3,4,2,4,6,8,3,6,9,12,4,8,12,16,
--     1,2,3,4,2,4,6,8,3,6,9,12,4,8,12,16]
-- Casi todos elementos de as son iguales que los de bs y los que no lo
-- son se diferencian en 1 como se observa en el siguiente cálculo
--    λ> zipWith (-) as bs
--    [1,0,0,0,1,1,0,0,0,1,0,0,0,0,0,0,
--     0,1,0,0,1,0,0,0,0,0,0,0,0,0,0,0,
--     0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,
--     0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0]
-- Los que no son iguales se calcula con
--    λ> [n | (x,y,z) <- ts, let n = 2^x*3^y*5^z, nDeConsecutivosConSuma3 n /= (y+1)*(z+1)]
--    [1,3,15,45,10,6,300,36,120]
-- Dichos elementos son los números triangulares (es decir, los son
-- sumas de los primeros números naturales) como se comprueba con
--    λ> [n | (x,y,z) <- ts, let n = 2^x*3^y*5^z, esTriangular n]
--    [1,3,15,45,10,6,300,36,120]
--
-- En definitiva, el número de representaciones de n = 2^x·3^y·5^z es
-- + (y+1)*(z+1), si n no es triangular,
-- + 1 + (y+1)*(z+1), si n es triangular,

-- En el número n = 2^x·3^y·5^z, la parte 3^y·5^z es la parte impar de
-- n y (y+1)*(z+1) es el número de divisores de la parte impar de n. Por
-- tanto, el número de representaciones de n = 2^x·3^y·5^z es
-- + el número de divisores de la parte impar de n, si n no es triangular,
-- + uno más el número de divisores de la parte impar de n, si n es triangular,

-- El cálculo de la segunda parte del apartado (b) es
--    λ> [n | n <- [0..100], nDeConsecutivosConSuma3 n == 1]
--    [2,4,8,16,32,64]
--  que son las potencias de 2 con exponentes positivos.

-- Finalmente, para el apartado (c), se puede generalizar el resultado
-- anterior y el número de representaciones de n = 2^x·3^y·5^z es
-- + el número de divisores de la parte impar de n, si n no es triangular,
-- + uno más el número de divisores de la parte impar de n, si n es triangular,
-- donde la parte impar de n es el número impar y tal que existe un
-- número natural k tal que n = 2^k·y.

-- Vamas a comprobar la conjetura haciendo la siguente definición y
-- comprobando que es equivalente a la anterior.

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

nDeConsecutivosConSuma4 :: Integer -> Integer
nDeConsecutivosConSuma4 n
  | esTriangular n = 1 + (numeroDivisores (parteImpar n))
  | otherwise      = numeroDivisores (parteImpar n)

-- (parteImpar n) es la parte impar de n. Por ejemplo,
--    parteImpar 60  ==  15
parteImpar :: Integer -> Integer
parteImpar n | odd n     = n
             | otherwise = parteImpar (n `div` 2)

-- (numeroDivisores n) es el número de divisores de n. Por ejemplo,
--    numeroDivisores 12  ==  6
--    numeroDivisores 14  ==  4
numeroDivisores :: Integer -> Integer
numeroDivisores =
  product . map ((+1) . genericLength) . group . primeFactors

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

-- La propiedad es
prop_equivalencia :: Positive Integer -> Bool
prop_equivalencia (Positive n) =
  nDeConsecutivosConSuma3 n == nDeConsecutivosConSuma4 n

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

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

-- La comparación es
--    λ> nDeConsecutivosConSuma (product [1..6])
--    6
--    (2.34 secs, 8,110,570,304 bytes)
--    λ> nDeConsecutivosConSuma2 (product [1..6])
--    6
--    (0.24 secs, 123,044,288 bytes)
--    λ> nDeConsecutivosConSuma3 (product [1..6])
--    6
--    (0.04 secs, 443,408 bytes)
--    λ> nDeConsecutivosConSuma4 (product [1..6])
--    6
--    (0.01 secs, 103,424 bytes)
--
--    λ> nDeConsecutivosConSuma2 (product [1..7])
--    12
--    (10.27 secs, 5,999,094,088 bytes)
--    λ> nDeConsecutivosConSuma3 (product [1..7])
--    12
--    (0.44 secs, 2,465,936 bytes)
--    λ> nDeConsecutivosConSuma4 (product [1..7])
--    12
--    (0.01 secs, 107,424 bytes)
--
--    λ> nDeConsecutivosConSuma3 (product [1..8])
--    12
--    (53.51 secs, 19,137,984 bytes)
--    λ> nDeConsecutivosConSuma4 (product [1..8])
--    12
--    (0.01 secs, 107,808 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

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

import Data.List (genericLength, genericTake, group)

import Data.Numbers.Primes (primeFactors)

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

-- 1ª definición de consecutivosConSuma

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

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

consecutivosConSuma n =

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

x <- [0..y],

sum [x..y] == n]

-- 2ª definición de consecutivosConSuma

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

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

consecutivosConSuma2 n =

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

x <- [0..y],

(x+y)*(y-x+1) == 2*n]

-- 3ª definición de consecutivosConSuma

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

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

consecutivosConSuma3 n

| esTriangular n = (0, p n - 1) : [(p x, p y - 1) | (x,y) <- aux n]

| otherwise = [(p x, p y - 1) | (x,y) <- aux n]

where p x = posicion x triangulares

aux n = [(x,y) | y <- zs,

let x = y-n,

x `elem` zs]

where zs = genericTake (n+1) triangulares

-- (esTriangular n) se verifica si n es un número triangular (es decir,

-- existe un m tal que n es 1+2+···+m). Por ejemplo,

-- esTriangular 6 == True

-- esTriangular 8 == False

esTriangular :: Integer -> Bool

esTriangular n =

n `pertenece` triangulares

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

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

triangulares :: [Integer]

triangulares = scanl1 (+) [0..]

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

-- creciente ys. Por ejemplo,

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

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

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

pertenece x ys =

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

-- (posicion x ys) es la posición de x en la lista ys. Por ejemplo,

-- posicion 7 [1,3..] == 4

posicion :: Eq a => a -> [a] -> Integer

posicion x (y:ys) | x == y = 1

| otherwise = 1 + posicion x ys

-- Comparación de eficiencia

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

-- La comparación es

-- λ> maximum [length (consecutivosConSuma2 n) | n <- [1..200]]

-- 9

-- (0.96 secs, 651,218,112 bytes)

-- λ> maximum [length (consecutivosConSuma3 n) | n <- [1..200]]

-- 9

-- (0.04 secs, 6,664,544 bytes)

-- λ> maximum [length (consecutivosConSuma2 n) | n <- [1..300]]

-- 9

-- (3.14 secs, 2,172,860,536 bytes)

-- λ> maximum [length (consecutivosConSuma3 n) | n <- [1..300]]

-- 9

-- (0.16 secs, 14,523,880 bytes)

-- 1ª definición de nDeConsecutivosConSuma

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

nDeConsecutivosConSuma :: Integer -> Integer

nDeConsecutivosConSuma = genericLength . consecutivosConSuma

-- 2ª definición de nDeConsecutivosConSuma

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

nDeConsecutivosConSuma2 :: Integer -> Integer

nDeConsecutivosConSuma2 = genericLength . consecutivosConSuma2

-- 3ª definición de nDeConsecutivosConSuma

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

nDeConsecutivosConSuma3 :: Integer -> Integer

nDeConsecutivosConSuma3 = genericLength . consecutivosConSuma3

-- Cálculo de las respuestas

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

-- El número de maneras de expresar 500 como suma de números naturales

-- consecutivos se calcula con

-- λ> nDeConsecutivosConSuma 500

-- 4

-- Por tanto, se puede expresar de 4 formas distintas. Dichas

-- expresiones se pueden calcular consecutivos

-- λ> consecutivosConSuma 500

-- [(8,32),(59,66),(98,102),(500,500)]

-- Es decir,

-- 500 = sum [8..32]

-- 500 = sum [59..66]

-- 500 = sum [98..102]

-- 500 = sum [500..500]

-- Para la segunda pregunta realizamos los siguientes cálculos

-- λ> ts = [(x,y,z) | x <- [0..3], y <- [0..3], z <- [0..3]]

-- λ> as = [nDeConsecutivosConSuma3 (2^x*3^y*5^z) | (x,y,z) <- ts]

-- λ> as

-- [2,2,3,4,3,5,6,8,3,7,9,12,4,8,12,16,

-- 1,3,3,4,3,4,6,8,3,6,9,12,4,8,12,16,

-- 1,2,3,4,2,4,7,8,4,6,9,12,4,8,12,16,

-- 1,2,3,4,2,5,6,8,3,6,9,12,4,8,12,16]

-- λ> bs = [(y+1)*(z+1) | (x,y,z) <- ts]

-- λ> bs

-- [1,2,3,4,2,4,6,8,3,6,9,12,4,8,12,16,

-- 1,2,3,4,2,4,6,8,3,6,9,12,4,8,12,16,

-- 1,2,3,4,2,4,6,8,3,6,9,12,4,8,12,16]

-- Casi todos elementos de as son iguales que los de bs y los que no lo

-- son se diferencian en 1 como se observa en el siguiente cálculo

-- λ> zipWith (-) as bs

-- [1,0,0,0,1,1,0,0,0,1,0,0,0,0,0,0,

-- 0,1,0,0,1,0,0,0,0,0,0,0,0,0,0,0,

-- 0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,

-- 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0]

-- Los que no son iguales se calcula con

-- λ> [n | (x,y,z) <- ts, let n = 2^x*3^y*5^z, nDeConsecutivosConSuma3 n /= (y+1)*(z+1)]

-- [1,3,15,45,10,6,300,36,120]

-- Dichos elementos son los números triangulares (es decir, los son

-- sumas de los primeros números naturales) como se comprueba con

-- λ> [n | (x,y,z) <- ts, let n = 2^x*3^y*5^z, esTriangular n]

-- [1,3,15,45,10,6,300,36,120]

-- En definitiva, el número de representaciones de n = 2^x·3^y·5^z es

-- + (y+1)*(z+1), si n no es triangular,

-- + 1 + (y+1)*(z+1), si n es triangular,

-- En el número n = 2^x·3^y·5^z, la parte 3^y·5^z es la parte impar de

-- n y (y+1)*(z+1) es el número de divisores de la parte impar de n. Por

-- tanto, el número de representaciones de n = 2^x·3^y·5^z es

-- + el número de divisores de la parte impar de n, si n no es triangular,

-- + uno más el número de divisores de la parte impar de n, si n es triangular,

-- El cálculo de la segunda parte del apartado (b) es

-- λ> [n | n <- [0..100], nDeConsecutivosConSuma3 n == 1]

-- [2,4,8,16,32,64]

-- que son las potencias de 2 con exponentes positivos.

-- Finalmente, para el apartado (c), se puede generalizar el resultado

-- anterior y el número de representaciones de n = 2^x·3^y·5^z es

-- + el número de divisores de la parte impar de n, si n no es triangular,

-- + uno más el número de divisores de la parte impar de n, si n es triangular,

-- donde la parte impar de n es el número impar y tal que existe un

-- número natural k tal que n = 2^k·y.

-- Vamas a comprobar la conjetura haciendo la siguente definición y

-- comprobando que es equivalente a la anterior.

-- 4ª definición de nDeConsecutivosConSuma

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

nDeConsecutivosConSuma4 :: Integer -> Integer

nDeConsecutivosConSuma4 n

| esTriangular n = 1 + (numeroDivisores (parteImpar n))

| otherwise = numeroDivisores (parteImpar n)

-- (parteImpar n) es la parte impar de n. Por ejemplo,

-- parteImpar 60 == 15

parteImpar :: Integer -> Integer

parteImpar n | odd n = n

| otherwise = parteImpar (n `div` 2)

-- (numeroDivisores n) es el número de divisores de n. Por ejemplo,

-- numeroDivisores 12 == 6

-- numeroDivisores 14 == 4

numeroDivisores :: Integer -> Integer

numeroDivisores =

product . map ((+1) . genericLength) . group . primeFactors

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia :: Positive Integer -> Bool

prop_equivalencia (Positive n) =

nDeConsecutivosConSuma3 n == nDeConsecutivosConSuma4 n

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> nDeConsecutivosConSuma (product [1..6])

-- 6

-- (2.34 secs, 8,110,570,304 bytes)

-- λ> nDeConsecutivosConSuma2 (product [1..6])

-- 6

-- (0.24 secs, 123,044,288 bytes)

-- λ> nDeConsecutivosConSuma3 (product [1..6])

-- 6

-- (0.04 secs, 443,408 bytes)

-- λ> nDeConsecutivosConSuma4 (product [1..6])

-- 6

-- (0.01 secs, 103,424 bytes)

-- λ> nDeConsecutivosConSuma2 (product [1..7])

-- 12

-- (10.27 secs, 5,999,094,088 bytes)

-- λ> nDeConsecutivosConSuma3 (product [1..7])

-- 12

-- (0.44 secs, 2,465,936 bytes)

-- λ> nDeConsecutivosConSuma4 (product [1..7])

-- 12

-- (0.01 secs, 107,424 bytes)

-- λ> nDeConsecutivosConSuma3 (product [1..8])

-- 12

-- (53.51 secs, 19,137,984 bytes)

-- λ> nDeConsecutivosConSuma4 (product [1..8])

-- 12

-- (0.01 secs, 107,808 bytes)

Nuevas soluciones

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

El cociente por 11 es igual a la suma de los cuadrados de sus cifras

PorJosé A. Alonso 24-mayo-202131-mayo-2021

El enunciado del problema 1 de la Olimpiada Internacional de Matemáticas de 1960 es el siguiente

Encontrar todos los números de tres cifras para los que al dividir el número entre 11 se obtiene la suma de los cuadrados de las cifras del número inicial.

Diremos que un número x es especial si al dividir x entre 11 se obtiene la suma de los cuadrados de las cifras de x.

Definir la función

   esEspecial :: Integer -> Bool

1	esEspecial :: Integer -> Bool

tal que (esEspecial x) se verifica si x es especial. Por ejemplo,

   esEspecial 550          ==  True
   esEspecial 22           ==  False
   esEspecial 241          ==  False
   esEspecial (11^(10^8))  ==  False

esEspecial 550 == True

esEspecial 22 == False

esEspecial 241 == False

esEspecial (11^(10^8)) == False

Usando la función esEspecial, calcular la respuesta al problema de la Olimpiada.

Calculando los números especiales menores que 10⁶, conjeturar que el conjunto de los números especiales es finito y comprobar la conjetura con QuickCheck.

Soluciones

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

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

esEspecial :: Integer -> Bool
esEspecial x =
  x `mod` 11 == 0 &&
  x `div` 11 == sum (map (^2) (digitos x))

-- head especiales  ==  550
especiales :: [Integer]
especiales = filter esEspecial [11,22..]

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

-- Cálculo de la respuesta
-- =======================

-- El cálculo es
--    λ> filter esEspecial [100..999]
--    [550,803]
-- Por tanto, los números buscados son 550 y 803.

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

-- Observando el siguiente cálculo
--    λ> filter esEspecial [11,22..10^6]
--    [550,803]
-- se puede conjeturar que los únicos números especiales son 550 y
-- 803. Lo vamos a comprobar con QuickCheck.

-- La propiedad es
prop_especiales :: Positive Integer -> Bool
prop_especiales (Positive x) =
  x `elem` [550,803] || not (esEspecial x)

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

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

esEspecial2 :: Integer -> Bool
esEspecial2 x = x `elem` [550,803]

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

-- La comparación es
--    λ> esEspecial (11^(10^6))
--    False
--    (2.22 secs, 4,675,669,056 bytes)
--    λ> esEspecial2 (11^(10^6))
--    False
--    (0.08 secs, 1,334,408 bytes)

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

-- 1ª solución

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

esEspecial :: Integer -> Bool

esEspecial x =

x `mod` 11 == 0 &&

x `div` 11 == sum (map (^2) (digitos x))

-- head especiales == 550

especiales :: [Integer]

especiales = filter esEspecial [11,22..]

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

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

digitos :: Integer -> [Integer]

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

-- Cálculo de la respuesta

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

-- El cálculo es

-- λ> filter esEspecial [100..999]

-- [550,803]

-- Por tanto, los números buscados son 550 y 803.

-- Propiedad

-- =========

-- Observando el siguiente cálculo

-- λ> filter esEspecial [11,22..10^6]

-- [550,803]

-- se puede conjeturar que los únicos números especiales son 550 y

-- 803. Lo vamos a comprobar con QuickCheck.

-- La propiedad es

prop_especiales :: Positive Integer -> Bool

prop_especiales (Positive x) =

x `elem` [550,803] || not (esEspecial x)

-- La comprobación es

-- λ> quickCheck prop_especiales

-- +++ OK, passed 100 tests.

-- 2ª solución

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

esEspecial2 :: Integer -> Bool

esEspecial2 x = x `elem` [550,803]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> esEspecial (11^(10^6))

-- False

-- (2.22 secs, 4,675,669,056 bytes)

-- λ> esEspecial2 (11^(10^6))

-- False

-- (0.08 secs, 1,334,408 bytes)

Nuevas soluciones

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

Últimos dígitos de una sucesión

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

El enunciado del problema 1 de la Fase Local de la Olimpiada Matemática Española del 2000 es

Considérese la sucesión definida como a(1) = 3, y a(n+1) = a(n) + a(n)². Determínense las dos últimas cifras de a(2000).

Definir las sucesiones

   sucesionA :: [Integer]
   sucesionB :: [Integer]

1 2	sucesionA :: [Integer] sucesionB :: [Integer]

tales que

sucesionA es la lista de los términos de la sucesión a(n). Por ejemplo,

     take 4 sucesionA  ==  [3,12,156,24492]

1	take 4 sucesionA == [3,12,156,24492]

sucesionB es la lista de los dos últimos dígitos de los término de la sucesión a(n). Por ejemplo,

     take 4 sucesionB     ==  [3,12,56,92]
     sucesionB !! (10^6)  ==  56

1 2	take 4 sucesionB == [3,12,56,92] sucesionB !! (10^6) == 56

Usando la sucesionB, calcular la respuesta a la pregunta del problema de la Olimpiada.

Soluciones

[schedule on=’2021-05-28′ at=»06:00″]

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

sucesionA :: [Integer]
sucesionA = map a [1..]
  where a 1 = 3
        a n = b + b^2
          where b = a (n-1)

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

sucesionA2 :: [Integer]
sucesionA2 = iterate (\x -> x + x^2) 3

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

-- La comparación es
--    λ> length (show (maximum (take 26 sucesionA)))
--    18408940
--    (3.90 secs, 1,213,573,208 bytes)
--    λ> length (show (maximum (take 26 sucesionA2)))
--    18408940
--    (3.91 secs, 1,182,719,984 bytes)

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

sucesionB :: [Integer]
sucesionB = map (`mod` 100) sucesionA

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

-- Observando el siguiente cálculo
--    λ> take 20 sucesionB
--    [3,12,56,92,56,92,56,92,56,92,56,92,56,92,56,92,56,92,56,92]

sucesionB2 :: [Integer]
sucesionB2 =
  3 : 12 : cycle [56,92]

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

-- La comprobación es
--    λ> take 25 sucesionB == take 25 sucesionB2
--    True

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

-- La comparación es
--    λ> sucesionB !! 30
--    56
--    (10.09 secs, 978,586,056 bytes)
--    λ> sucesionB2 !! 30
--    56
--    (0.01 secs, 98,568 bytes)

-- Cálculo de la respuesta
-- =======================

-- El cálculo dela respuesta es
--    λ> sucesionB2 !! 1999
--    92
-- Por tanto a(2000) termina en 92.

-- 1ª definición de sucesionA

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

sucesionA :: [Integer]

sucesionA = map a [1..]

where a 1 = 3

a n = b + b^2

where b = a (n-1)

-- 2ª definición de sucesionA

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

sucesionA2 :: [Integer]

sucesionA2 = iterate (\x -> x + x^2) 3

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (show (maximum (take 26 sucesionA)))

-- 18408940

-- (3.90 secs, 1,213,573,208 bytes)

-- λ> length (show (maximum (take 26 sucesionA2)))

-- 18408940

-- (3.91 secs, 1,182,719,984 bytes)

-- 1ª definición de sucesionB

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

sucesionB :: [Integer]

sucesionB = map (`mod` 100) sucesionA

-- 2ª definición de sucesionB

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

-- Observando el siguiente cálculo

-- λ> take 20 sucesionB

-- [3,12,56,92,56,92,56,92,56,92,56,92,56,92,56,92,56,92,56,92]

sucesionB2 :: [Integer]

sucesionB2 =

3 : 12 : cycle [56,92]

-- Comprobación de equivalencia

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

-- La comprobación es

-- λ> take 25 sucesionB == take 25 sucesionB2

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sucesionB !! 30

-- 56

-- (10.09 secs, 978,586,056 bytes)

-- λ> sucesionB2 !! 30

-- 56

-- (0.01 secs, 98,568 bytes)

-- Cálculo de la respuesta

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

-- El cálculo dela respuesta es

-- λ> sucesionB2 !! 1999

-- 92

-- Por tanto a(2000) termina en 92.

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>

Sumas y productos de dígitos

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

El enunciado de un problema 3 de la Fase Local de la Olimpiada Matemática Española del
2000 es

¿Cuántos números, comprendidos entre 1.000 y 9.999, verifican que la suma de sus cuatro dígitos es mayor o igual que el producto de los mismos? ¿Para cuántos de ellos se verifica la igualdad?

Definir las funciones

   conMayorSumaQueProducto :: Int -> Int -> [Int]
   conIgualSumaQueProducto :: Int -> Int -> [Int]

1 2	conMayorSumaQueProducto :: Int -> Int -> [Int] conIgualSumaQueProducto :: Int -> Int -> [Int]

tales que

(conMayorSumaQueProducto a b) es la lista de los números del intervalo [a,b] tales que la suma de sus dígitos es mayor que el producto de los mismos. Por ejemplo,

     λ> conMayorSumaQueProducto 20 99
     [20,21,30,31,40,41,50,51,60,61,70,71,80,81,90,91]
     λ> conMayorSumaQueProducto 120 199
     [120,121,122,130,131,140,141,150,151,160,161,170,171,180,181,190,191]
     λ> conMayorSumaQueProducto 220 299
     [220,221,230,240,250,260,270,280,290]

λ> conMayorSumaQueProducto 20 99

[20,21,30,31,40,41,50,51,60,61,70,71,80,81,90,91]

λ> conMayorSumaQueProducto 120 199

[120,121,122,130,131,140,141,150,151,160,161,170,171,180,181,190,191]

λ> conMayorSumaQueProducto 220 299

[220,221,230,240,250,260,270,280,290]

(conIgualSumaQueProducto a b) es la lista de los números del intervalo [a,b] tales que la suma de sus dígitos es igual que el producto de los mismos. Por ejemplo,

     λ> conIgualSumaQueProducto 10 99
     [22]
     λ> conIgualSumaQueProducto 100 999
     [123,132,213,231,312,321]

λ> conIgualSumaQueProducto 10 99

[22]

λ> conIgualSumaQueProducto 100 999

[123,132,213,231,312,321]

Usando las funciones anteriores, calcular las respuestas a las preguntas del problema de la Olimpiada.

Soluciones

[schedule on=’2021-05-27′ at=»06:00″]

conMayorSumaQueProducto :: Int -> Int -> [Int]
conMayorSumaQueProducto a b =
  [x | x <- [a..b],
       let xs = digitos x,
       sum xs > product xs]

conIgualSumaQueProducto :: Int -> Int -> [Int]
conIgualSumaQueProducto a b =
  [x | x <- [a..b],
       let xs = digitos x,
       sum xs == product xs]

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

-- Cálculo de las respuestas
-- =========================

-- La cantidad de números, comprendidos entre 1.000 y 9.999, tales
-- que la suma de sus cuatro dígitos es mayor o igual que el producto de
-- los mismos se calcula con
--    λ> length (conMayorSumaQueProducto 1000 9999 ++ conIgualSumaQueProducto 1000 9999)
--    2502
-- Por tanto, hay 2502 números que cumplen la primera condición.

-- La cantidad de números, comprendidos entre 1.000 y 9.999, tales
-- que la suma de sus cuatro dígitos es igual que el producto de los
-- mismos se calcula con
--    λ> length (conIgualSumaQueProducto 1000 9999)
--    12
-- Por tanto, hay 12 números que cumplen la segunda condición. La lista
-- de dichos números se puede calcular con
--    λ> conIgualSumaQueProducto 1000 9999
--    [1124,1142,1214,1241,1412,1421,2114,2141,2411,4112,4121,4211]

conMayorSumaQueProducto :: Int -> Int -> [Int]

conMayorSumaQueProducto a b =

[x | x <- [a..b],

let xs = digitos x,

sum xs > product xs]

conIgualSumaQueProducto :: Int -> Int -> [Int]

conIgualSumaQueProducto a b =

[x | x <- [a..b],

let xs = digitos x,

sum xs == product xs]

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

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

digitos :: Int -> [Int]

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

-- Cálculo de las respuestas

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

-- La cantidad de números, comprendidos entre 1.000 y 9.999, tales

-- que la suma de sus cuatro dígitos es mayor o igual que el producto de

-- los mismos se calcula con

-- λ> length (conMayorSumaQueProducto 1000 9999 ++ conIgualSumaQueProducto 1000 9999)

-- 2502

-- Por tanto, hay 2502 números que cumplen la primera condición.

-- La cantidad de números, comprendidos entre 1.000 y 9.999, tales

-- que la suma de sus cuatro dígitos es igual que el producto de los

-- mismos se calcula con

-- λ> length (conIgualSumaQueProducto 1000 9999)

-- 12

-- Por tanto, hay 12 números que cumplen la segunda condición. La lista

-- de dichos números se puede calcular con

-- λ> conIgualSumaQueProducto 1000 9999

-- [1124,1142,1214,1241,1412,1421,2114,2141,2411,4112,4121,4211]

Nuevas soluciones

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

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico