mayo 2021 – Exercitium

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>

Números suma de dos cuadrados

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

El enunciado del problema 3.3 de la Fase Local de la Olimpiada Matemática Española del 2004 es

Hallad todas las posibles formas de escribir 2003 como suma de dos cuadrados de números enteros positivos.

Definir la sucesión

   sonSumaDosCuadrados :: [Integer]

1	sonSumaDosCuadrados :: [Integer]

cuyos elementos son los números que se pueden expresar como suma de los cuadrados de dos números naturales. Por ejemplo,

   take 6 sonSumaDosCuadrados      ==  [0,1,2,4,5,8]
   sonSumaDosCuadrados !! (10^4)   ==  39593

1 2	take 6 sonSumaDosCuadrados == [0,1,2,4,5,8] sonSumaDosCuadrados !! (10^4) == 39593

Comprobar con QuickCheck las siguientes propiedades:

La sucesión sonSumaDosCuadrados es infinita.
Los elementos de sonSumaDosCuadrados no son congruentes con 3 módulo 4 (es decir, sus restos al dividirlo por 4 son distintos de 3).

Usando sonSumaDosCuadrados, resolver el problema propuesto; es decir, calcular todas las posibles formas de escribir 2003 como suma de dos cuadrados de números enteros positivos.

Soluciones

pre lang=»haskell»>
import Test.QuickCheck (Property, (==>), quickCheck)

— 1ª solución
— ===========

sonSumaDosCuadrados :: [Integer]
sonSumaDosCuadrados =
filter esSumaDeDosCuadrados [0..]

— (esSumaDeDosCuadrados) se verifica si n se puede escribir como la
— suma de los cuadrados de dos números naturales. Por ejemplo,
— esSumaDeDosCuadrados 5 == True
— esSumaDeDosCuadrados 3 == False
esSumaDeDosCuadrados :: Integer -> Bool
esSumaDeDosCuadrados = not . null . descomposicionesSumaDosCuadrados

— (descomposicionesSumaDosCuadrados n) es la lista de pares de
— cuadrados de números naturales (con la primera componente menor o
— igual que la segunda) cuya suma es n. Por ejmplo,
— descomposicionesSumaDosCuadrados 3 == []
— descomposicionesSumaDosCuadrados 4 == [(0,4)]
— descomposicionesSumaDosCuadrados 5 == [(1,4)]
— descomposicionesSumaDosCuadrados 25 == [(0,25),(9,16)]
— descomposicionesSumaDosCuadrados 325 == [(1,324),(36,289),(100,225)]
— descomposicionesSumaDosCuadrados 1105 == [(16,1089),(81,1024),(144,961),(529,576)]
descomposicionesSumaDosCuadrados :: Integer -> [(Integer,Integer)]
descomposicionesSumaDosCuadrados n =
[(a,b) | a <- xs,
let b = n – a,
b elem xs,
a <= b]
where xs = takeWhile (<= n) cuadrados

— cuadrados es la lista de los cuadrados. Por ejemplo,
— take 10 cuadrados == [0,1,4,9,16,25,36,49,64,81]
cuadrados :: [Integer]
cuadrados = map (^2) [0..]

— 2ª solución
— ===========

sonSumaDosCuadrados2 :: [Integer]
sonSumaDosCuadrados2 =
filter esSumaDeDosCuadrados2 [0..]

esSumaDeDosCuadrados2 :: Integer -> Bool
esSumaDeDosCuadrados2 = not . null . descomposicionesSumaDosCuadrados2

descomposicionesSumaDosCuadrados2 :: Integer -> [(Integer,Integer)]
descomposicionesSumaDosCuadrados2 n =
[(a,b) | a <- ys,
let b = n – a,
b elem m : zs]
where m = n div 2
xs = takeWhile (<= n) cuadrados
(ys,zs) = span (<= m) xs

— 3ª solución
— ==========

sonSumaDosCuadrados3 :: [Integer]
sonSumaDosCuadrados3 =
mezclaTodas [[n^2+k^2 | k <- [n..]] | n <- [0..]]

— (mezclaTodas xss) es la mezcla ordenada de xss, donde tanto xss como
— sus elementos son listas infinitas ordenadas. Por ejemplo,
— λ> take 10 (mezclaTodas [[n,2n..] | n <- [2..]]) -- [2,3,4,5,6,7,8,9,10,11] -- λ> take 10 (mezclaTodas [[n,2n..] | 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 mezcla de las listas infinitas ordenadas xs es
— ys. Por ejemplo,
— take 10 (mezcla [1,3..] [4,8..]) == [1,3,4,5,7,8,9,11,12,13]
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

— Comprobación de equivalencia
— ============================

— La comprobación es
— λ> take 1000 sonSumaDosCuadrados == take 1000 sonSumaDosCuadrados2
— True
— λ> take 1000 sonSumaDosCuadrados2 == take 1000 sonSumaDosCuadrados3
— True

— Comparación de eficiencia
— =========================

— La comparación es
— λ> sonSumaDosCuadrados !! (510^3)
— 18973
— (2.29 secs, 266,485,976 bytes)
— λ> sonSumaDosCuadrados2 !! (510^3)
— 18973
— (1.01 secs, 473,019,976 bytes)
— λ> sonSumaDosCuadrados3 !! (5*10^3)
— 18973

— (0.17 secs, 103,957,288 bytes)

— λ> sonSumaDosCuadrados2 !! (510^4)
— 216090
— (78.14 secs, 17,856,157,080 bytes)
— λ> sonSumaDosCuadrados3 !! (510^4)
— 216090
— (4.23 secs, 3,325,056,480 bytes)

— Propiedades
— ===========

— La primera propiedad es
prop_infinitud :: Integer -> Bool
prop_infinitud n =
(not . null) (dropWhile (<= n) sonSumaDosCuadrados3)

— Su comprobación es
— λ> quickCheck prop_infinitud
— +++ OK, passed 100 tests.

— La segunda propiedad es
prop_modulo4 :: Int -> Property
prop_modulo4 k =
k >= 0 ==>
(sonSumaDosCuadrados3 !! k) mod 4 /= 3

— Su comprobación es
— λ> quickCheck prop_modulo4
— +++ OK, passed 100 tests.

— 4ª solución
— ===========

— Basada en la 2ª propiedad.

sonSumaDosCuadrados4 :: [Integer]
sonSumaDosCuadrados4 =
filter esSumaDeDosCuadrados4 [0..]

esSumaDeDosCuadrados4 :: Integer -> Bool
esSumaDeDosCuadrados4 = not . null . descomposicionesSumaDosCuadrados4

descomposicionesSumaDosCuadrados4 :: Integer -> [(Integer,Integer)]
descomposicionesSumaDosCuadrados4 n
| n mod 4 == 3 = []
| otherwise = [(a,b) | a <- ys,
let b = n – a,
b elem m : zs]
where m = n div 2
xs = takeWhile (<= n) cuadrados
(ys,zs) = span (<= m) xs

— Comprobación de equivalencia
— ============================

— La comprobación es
— λ> take 1000 sonSumaDosCuadrados3 == take 1000 sonSumaDosCuadrados4
— True

— Comparación de eficiencia
— =========================

— La comparación es
— λ> sonSumaDosCuadrados2 !! (10^4)
— 39593
— (3.60 secs, 1,413,851,720 bytes)
— λ> sonSumaDosCuadrados3 !! (10^4)
— 39593
— (0.42 secs, 284,603,104 bytes)
— λ> sonSumaDosCuadrados4 !! (10^4)
— 39593
— (2.58 secs, 1,043,995,480 bytes)

— Cálculo para resolver el problema
— =================================

— El cálculo es
— λ> 2003 == head (dropWhile (<2003) sonSumaDosCuadrados3)
— False
— Por tanto, no es posible escribir 2003 como suma de dos cuadrados de
— números enteros positivos.

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>

Ternas aditivas

PorJosé A. Alonso 18-mayo-202125-mayo-2021

El enunciado del problema C6 de la Fase Local de la Olimpiada Matemática Española del 2006 es

Decimos que tres números naturales distintos forman una terna aditiva si la suma de los dos primeros de ellos es igual al tercero. Hallar, razonadamente, el máximo número de ternas aditivas que puede haber en un conjunto dado de 20 números naturales.

Definir las funciones

   ternasAditivas  :: Integer -> [(Integer,Integer,Integer)]
   nTernasAditivas :: Integer -> Integer

1 2	ternasAditivas :: Integer -> [(Integer,Integer,Integer)] nTernasAditivas :: Integer -> Integer

tales que

(ternasAditivas n) es la lista de las ternas aditivas crecientes que se pueden formar con los n primeros números enteros positivos. Por ejemplo,

     λ> ternasAditivas 7
     [(1,2,3),(1,3,4),(1,4,5),(1,5,6),(1,6,7),(2,3,5),(2,4,6),(2,5,7),(3,4,7)]
     λ> length (ternasAditivas (10^4))
     24995000

λ> ternasAditivas 7

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

λ> length (ternasAditivas (10^4))

24995000

(nTernasAditivas n) es el número de ternas aditivas crecientes que se pueden formar con los n primeros números enteros positivos. Por ejemplo,

     nTernasAditivas 7                            ==  9
     length (show (nTernasAditivas (10^(10^5))))  ==  200000
     length (show (nTernasAditivas (10^(10^6))))  ==  2000000
     length (show (nTernasAditivas (10^(10^7))))  ==  20000000

nTernasAditivas 7 == 9

length (show (nTernasAditivas (10^(10^5)))) == 200000

length (show (nTernasAditivas (10^(10^6)))) == 2000000

length (show (nTernasAditivas (10^(10^7)))) == 20000000

Soluciones

import Data.List (genericLength)

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

ternasAditivas :: Integer -> [(Integer,Integer,Integer)]
ternasAditivas n =
  [(a,b,c) | a <- [1..n],
             b <- [a+1..n],
             let c = a+b,
             c <= n]

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

ternasAditivas2 :: Integer -> [(Integer,Integer,Integer)]
ternasAditivas2 n =
  [(a,b,a+b) | a <- [1..n],
               b <- [a+1..n-a]]

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

-- La comprobación es
--    λ> and [ternasAditivas n == ternasAditivas2 n | n <- [1..300]]
--    True

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

-- La comparación es
--    λ> length (ternasAditivas (5*10^3))
--    6247500
--    (4.02 secs, 2,950,741,752 bytes)
--    λ> length (ternasAditivas2 (5*10^3))
--    6247500
--    (1.15 secs, 1,401,184,264 bytes)

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

nTernasAditivas :: Integer -> Integer
nTernasAditivas = genericLength . ternasAditivas

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

-- Observando los siguientes cálculos
--    λ> [nTernasAditivas n | n <- [1..20]]
--    [0,0,1,2,4,6,9,12,16,20,25,30,36,42,49,56,64,72,81,90]
--    λ> [(n-1)^2 `div` 4 | n <- [1..20]]
--    [0,0,1,2,4,6,9,12,16,20,25,30,36,42,49,56,64,72,81,90]

nTernasAditivas2 :: Integer -> Integer
nTernasAditivas2 n = (n-1)^2 `div` 4

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

nTernasAditivas3 :: Integer -> Integer
nTernasAditivas3 = (`div` 4) . (^ 2) . pred

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

-- La comprobación es
--    λ> and [nTernasAditivas n == nTernasAditivas2 n | n <- [1..200]]
--    True
--    λ> and [nTernasAditivas2 n == nTernasAditivas3 n | n <- [1..200]]
--    True

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

-- La comparación es
--    λ> nTernasAditivas (5*10^3)
--    6247500
--    (5.66 secs, 3,663,331,112 bytes)
--    λ> nTernasAditivas2 (5*10^3)
--    6247500
--    (0.02 secs, 106,752 bytes)
--    λ> nTernasAditivas3 (5*10^3)
--    6247500
--    (0.02 secs, 106,568 bytes)

import Data.List (genericLength)

-- 1ª definición de ternasAditivas

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

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

ternasAditivas n =

[(a,b,c) | a <- [1..n],

b <- [a+1..n],

let c = a+b,

c <= n]

-- 2ª definición de ternasAditivas

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

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

ternasAditivas2 n =

[(a,b,a+b) | a <- [1..n],

b <- [a+1..n-a]]

-- Comprobación de equivalencia

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

-- La comprobación es

-- λ> and [ternasAditivas n == ternasAditivas2 n | n <- [1..300]]

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (ternasAditivas (5*10^3))

-- 6247500

-- (4.02 secs, 2,950,741,752 bytes)

-- λ> length (ternasAditivas2 (5*10^3))

-- 6247500

-- (1.15 secs, 1,401,184,264 bytes)

-- 1ª definición de nTernasAditivas

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

nTernasAditivas :: Integer -> Integer

nTernasAditivas = genericLength . ternasAditivas

-- 2ª definición de nTernasAditivas

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

-- Observando los siguientes cálculos

-- λ> [nTernasAditivas n | n <- [1..20]]

-- [0,0,1,2,4,6,9,12,16,20,25,30,36,42,49,56,64,72,81,90]

-- λ> [(n-1)^2 `div` 4 | n <- [1..20]]

-- [0,0,1,2,4,6,9,12,16,20,25,30,36,42,49,56,64,72,81,90]

nTernasAditivas2 :: Integer -> Integer

nTernasAditivas2 n = (n-1)^2 `div` 4

-- 3ª definición de nTernasAditivas

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

nTernasAditivas3 :: Integer -> Integer

nTernasAditivas3 = (`div` 4) . (^ 2) . pred

-- Comprobación de equivalencia

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

-- La comprobación es

-- λ> and [nTernasAditivas n == nTernasAditivas2 n | n <- [1..200]]

-- True

-- λ> and [nTernasAditivas2 n == nTernasAditivas3 n | n <- [1..200]]

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> nTernasAditivas (5*10^3)

-- 6247500

-- (5.66 secs, 3,663,331,112 bytes)

-- λ> nTernasAditivas2 (5*10^3)

-- 6247500

-- (0.02 secs, 106,752 bytes)

-- λ> nTernasAditivas3 (5*10^3)

-- 6247500

-- (0.02 secs, 106,568 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>

Cuadrado más primo

PorJosé A. Alonso 17-mayo-202124-mayo-2021

El enunciado del problema C2 de la Fase Local de la Olimpiada Matemática Española del 2006 es

¿Existe un conjunto infinito de números naturales que NO se pueden representar en la forma n²+p, siendo n natural y p primo? Razónese la contestación.

Definir la lista

   noSonCuadradoMasPrimo :: [Integer]

1	noSonCuadradoMasPrimo :: [Integer]

cuyos elementos son los números que no se pueden escribir como un cuadrado más un primo. Por ejemplo,

   λ> take 15 noSonCuadradoMasPrimo
   [1,10,25,34,58,64,85,91,121,130,169,196,214,226,289]
   λ> noSonCuadradoMasPrimo2 !! 200
   78961

λ> take 15 noSonCuadradoMasPrimo

[1,10,25,34,58,64,85,91,121,130,169,196,214,226,289]

λ> noSonCuadradoMasPrimo2 !! 200

78961

En la lista no está el 2 (porque 2 = 0²+2), el 3 (porque 3 = 1²+2), el 4 (porque 4 = 0²+4) ni el 11 (porque 11 = 3²+2).

Comprobar con QuickCheck que noSonCuadradoMasPrimo es infinita.

Soluciones

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

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

noSonCuadradoMasPrimo :: [Integer]
noSonCuadradoMasPrimo =
  filter (not . esCuadradoMasPrimo) [1..]

-- (esCuadradoMasPrimo n) se verifica si n se puede escribir como un
-- cuadrado más un primo. Por ejemplo,
--    esCuadradoMasPrimo 11  ==  True
--    esCuadradoMasPrimo 10  ==  False
esCuadradoMasPrimo :: Integer -> Bool
esCuadradoMasPrimo n =
  or [esCuadrado (n - p) | p <- takeWhile (<= n) primes]

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

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

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

noSonCuadradoMasPrimo2 :: [Integer]
noSonCuadradoMasPrimo2 =
  filter (not . esCuadradoMasPrimo2) [1..]

-- (esCuadradoMasPrimo2 n) se verifica si n se puede escribir como un
-- cuadrado más un primo. Por ejemplo,
--    esCuadradoMasPrimo2 11  ==  True
--    esCuadradoMasPrimo2 10  ==  False
esCuadradoMasPrimo2 :: Integer -> Bool
esCuadradoMasPrimo2 n =
  or [isPrime (n - m) | m <- takeWhile (<= n) cuadrados]

-- cuadrados es la lista de los cuadrados de los números naturales. Por
-- ejemplo,
--    take 10 cuadrados  ==  [0,1,4,9,16,25,36,49,64,81]
cuadrados :: [Integer]
cuadrados = map (^2) [0..]

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

-- La comprobación es
--    λ> take 50 noSonCuadradoMasPrimo == take 50 noSonCuadradoMasPrimo2
--    True

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

--    λ> noSonCuadradoMasPrimo !! 70
--    8649
--    (12.42 secs, 13,289,896,304 bytes)
--    λ> noSonCuadradoMasPrimo2 !! 70
--    8649
--    (0.23 secs, 650,843,816 bytes)

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

-- La propiedad es
prop_infinitud :: Integer -> Bool
prop_infinitud n =
  not (null (dropWhile (<= n) noSonCuadradoMasPrimo2))

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

import Data.Numbers.Primes (primes, isPrime)

import Test.QuickCheck

-- 1ª solución

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

noSonCuadradoMasPrimo :: [Integer]

noSonCuadradoMasPrimo =

filter (not . esCuadradoMasPrimo) [1..]

-- (esCuadradoMasPrimo n) se verifica si n se puede escribir como un

-- cuadrado más un primo. Por ejemplo,

-- esCuadradoMasPrimo 11 == True

-- esCuadradoMasPrimo 10 == False

esCuadradoMasPrimo :: Integer -> Bool

esCuadradoMasPrimo n =

or [esCuadrado (n - p) | p <- takeWhile (<= n) primes]

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

-- ejemplo,

-- esCuadrado 16 == True

-- esCuadrado 27 == False

esCuadrado :: Integer -> Bool

esCuadrado x =

(raizEntera x)^2 == x

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

-- x. Por ejemplo,

-- raizEntera 16 == 4

-- raizEntera 27 == 5

raizEntera :: Integer -> Integer

raizEntera x = aux (1,x)

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

| c == a = c

| d < x = aux (c,b)

| otherwise = aux (a,c)

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

d = c^2

-- 2ª solución

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

noSonCuadradoMasPrimo2 :: [Integer]

noSonCuadradoMasPrimo2 =

filter (not . esCuadradoMasPrimo2) [1..]

-- (esCuadradoMasPrimo2 n) se verifica si n se puede escribir como un

-- cuadrado más un primo. Por ejemplo,

-- esCuadradoMasPrimo2 11 == True

-- esCuadradoMasPrimo2 10 == False

esCuadradoMasPrimo2 :: Integer -> Bool

esCuadradoMasPrimo2 n =

or [isPrime (n - m) | m <- takeWhile (<= n) cuadrados]

-- cuadrados es la lista de los cuadrados de los números naturales. Por

-- ejemplo,

-- take 10 cuadrados == [0,1,4,9,16,25,36,49,64,81]

cuadrados :: [Integer]

cuadrados = map (^2) [0..]

-- Comprobación de equivalencia

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

-- La comprobación es

-- λ> take 50 noSonCuadradoMasPrimo == take 50 noSonCuadradoMasPrimo2

-- True

-- Comparación de eficiencia

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

-- λ> noSonCuadradoMasPrimo !! 70

-- 8649

-- (12.42 secs, 13,289,896,304 bytes)

-- λ> noSonCuadradoMasPrimo2 !! 70

-- 8649

-- (0.23 secs, 650,843,816 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_infinitud :: Integer -> Bool

prop_infinitud n =

not (null (dropWhile (<= n) noSonCuadradoMasPrimo2))

-- La comprobación es

-- λ> quickCheck prop_infinitud

-- +++ 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 consecutivos con factorización con exponentes impares

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

El enunciado del problema B.5 de la Fase Local de la Olimpiada Matemática Española del 2006 es

Los números naturales 22, 23, y 24 tienen la siguiente propiedad: los exponentes de los factores primos de su descomposición son todos impares (22 = 2¹·11¹, 23 = 23¹, 24 = 2³·3¹)

¿Cuál es el mayor número de naturales consecutivos que pueden tener esa propiedad?. Razónese la contestación.

Definir la lista

   consecutivosExponentesImpares :: [[Integer]]

1	consecutivosExponentesImpares :: [[Integer]]

cuyos elementos sean las sucesiones maximales de números enteros positivos tales que los exponentes de los factores primos de su descomposición son todos impares. Por ejemplo,

   λ> take 7 consecutivosExponentesImpares
   [[1,2,3],[5,6,7,8],[10,11],[13,14,15],[17],[19],[21,22,23,24]]
   λ> consecutivosExponentesImpares !! (10^4)
   [43030,43031,43032,43033,43034,43035]

λ> take 7 consecutivosExponentesImpares

[[1,2,3],[5,6,7,8],[10,11],[13,14,15],[17],[19],[21,22,23,24]]

λ> consecutivosExponentesImpares !! (10^4)

[43030,43031,43032,43033,43034,43035]

Usando la función consecutivosExponentesImpares conjeturar la respuesta a la pregunta del problema y comprobarla con QuickCheck.

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck (Property, (==>), quickCheck)

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

consecutivosExponentesImpares :: [[Integer]]
consecutivosExponentesImpares =
  consecutivosExponentesImparesDesde 1 :
  [consecutivosExponentesImparesDesde n | n <- [1..],
                                          not (exponentesImpares (n-1)),
                                          exponentesImpares n]

-- (consecutivosExponentesImparesDesde n) es la sucesión maximal de
-- números enteros positivos a partir de n tales que los exponentes de
-- los factores primos de su descomposición son todos impares. Por
-- ejemplo,
--    consecutivosExponentesImparesDesde 1  ==  [1,2,3]
--    consecutivosExponentesImparesDesde 4  ==  []
--    consecutivosExponentesImparesDesde 5  ==  [5,6,7,8]
consecutivosExponentesImparesDesde :: Integer -> [Integer]
consecutivosExponentesImparesDesde n
  | exponentesImpares n = n : consecutivosExponentesImparesDesde (n+1)
  | otherwise           = []

-- (exponentesImpares n) se verifica si los exponentes de los factores
-- primos de su descomposición son todos impares. Por ejemplo,
--    exponentesImpares 4  ==  False
--    exponentesImpares 6  ==  True
exponentesImpares :: Integer -> Bool
exponentesImpares n = all odd (exponentes n)

-- (exponentes n) es la lista de los exponentes de la factorización
-- prima de n. Por ejemplo,
--    exponentes 4  ==  [2]
--    exponentes 6  ==  [1,1]
--    exponentes 1200  ==  [4,1,2]
exponentes :: Integer -> [Int]
exponentes n = map length (group (primeFactors n))

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

consecutivosExponentesImpares2 :: [[Integer]]
consecutivosExponentesImpares2 = aux 1
  where aux n | exponentesImpares n = xs : aux (1 + last xs)
              | otherwise           = aux (n+1)
          where xs = consecutivosExponentesImparesDesde n

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

-- La propiedad es
prop_consecutivosExponentesImpares :: Int -> Property
prop_consecutivosExponentesImpares n =
  n > 0 ==>
  consecutivosExponentesImpares !! n == consecutivosExponentesImpares2 !! n

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

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

-- La comparación es
--    λ> consecutivosExponentesImpares !! (5*10^4)
--    [214917,214918,214919,214920,214921,214922,214923]
--    (4.95 secs, 14,329,413,944 bytes)
--    λ> consecutivosExponentesImpares2 !! (5*10^4)
--    [214917,214918,214919,214920,214921,214922,214923]
--    (5.29 secs, 15,103,460,488 bytes)

-- Respuesta a la pregunta del problema
-- ====================================

-- A partir del siguiente cálculo
--    λ> maximum [length xs | xs <- take (10^4) consecutivosExponentesImpares]
--    7
-- se puede conjeturar que el mayor número de naturales consecutivos que pueden
-- tener la propiedad es 7. Por el cálculo, se sabe que es mayor o igual
-- que 7. Falta por comprobar que es menor o igual que 7; es decir,
prop_maximoConsecutivosExponentesImpares :: Int -> Property
prop_maximoConsecutivosExponentesImpares n =
  n >= 0 ==>
  length (consecutivosExponentesImpares !! n) <= 7

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

import Data.List (group)

import Data.Numbers.Primes (primeFactors)

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

-- 1ª solución

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

consecutivosExponentesImpares :: [[Integer]]

consecutivosExponentesImpares =

consecutivosExponentesImparesDesde 1 :

[consecutivosExponentesImparesDesde n | n <- [1..],

not (exponentesImpares (n-1)),

exponentesImpares n]

-- (consecutivosExponentesImparesDesde n) es la sucesión maximal de

-- números enteros positivos a partir de n tales que los exponentes de

-- los factores primos de su descomposición son todos impares. Por

-- ejemplo,

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

-- consecutivosExponentesImparesDesde 4 == []

-- consecutivosExponentesImparesDesde 5 == [5,6,7,8]

consecutivosExponentesImparesDesde :: Integer -> [Integer]

consecutivosExponentesImparesDesde n

| exponentesImpares n = n : consecutivosExponentesImparesDesde (n+1)

| otherwise = []

-- (exponentesImpares n) se verifica si los exponentes de los factores

-- primos de su descomposición son todos impares. Por ejemplo,

-- exponentesImpares 4 == False

-- exponentesImpares 6 == True

exponentesImpares :: Integer -> Bool

exponentesImpares n = all odd (exponentes n)

-- (exponentes n) es la lista de los exponentes de la factorización

-- prima de n. Por ejemplo,

-- exponentes 4 == [2]

-- exponentes 6 == [1,1]

-- exponentes 1200 == [4,1,2]

exponentes :: Integer -> [Int]

exponentes n = map length (group (primeFactors n))

-- 2ª solución

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

consecutivosExponentesImpares2 :: [[Integer]]

consecutivosExponentesImpares2 = aux 1

where aux n | exponentesImpares n = xs : aux (1 + last xs)

| otherwise = aux (n+1)

where xs = consecutivosExponentesImparesDesde n

-- Comprobación de equivalencia

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

-- La propiedad es

prop_consecutivosExponentesImpares :: Int -> Property

prop_consecutivosExponentesImpares n =

n > 0 ==>

consecutivosExponentesImpares !! n == consecutivosExponentesImpares2 !! n

-- La comprobación es

-- λ> quickCheck prop_consecutivosExponentesImpares

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> consecutivosExponentesImpares !! (5*10^4)

-- [214917,214918,214919,214920,214921,214922,214923]

-- (4.95 secs, 14,329,413,944 bytes)

-- λ> consecutivosExponentesImpares2 !! (5*10^4)

-- [214917,214918,214919,214920,214921,214922,214923]

-- (5.29 secs, 15,103,460,488 bytes)

-- Respuesta a la pregunta del problema

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

-- A partir del siguiente cálculo

-- λ> maximum [length xs | xs <- take (10^4) consecutivosExponentesImpares]

-- 7

-- se puede conjeturar que el mayor número de naturales consecutivos que pueden

-- tener la propiedad es 7. Por el cálculo, se sabe que es mayor o igual

-- que 7. Falta por comprobar que es menor o igual que 7; es decir,

prop_maximoConsecutivosExponentesImpares :: Int -> Property

prop_maximoConsecutivosExponentesImpares n =

n >= 0 ==>

length (consecutivosExponentesImpares !! n) <= 7

-- La comprobación es

-- λ> quickCheck prop_maximoConsecutivosExponentesImpares

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

Sucesión de mcd de consecutivos

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

El enunciado del problema B3 de la Fase Local de la Olimpiada Matemática Española del 2007 es

Sea a(n) = 1 + n³ la sucesión {2,9,28,65,…} y b(n) = mcd(a(n),a(n+1)). Hallar el máximo valor que puede tomar b(n).

Definir las listas

   sucesionA :: [Integer]
   sucesionB :: [Integer]

1 2	sucesionA :: [Integer] sucesionB :: [Integer]

tales que

los elementos de sucesionA son los términos de la sucesión a(n). Por ejemplo,

     take 12 sucesionA  ==  [2,9,28,65,126,217,344,513,730,1001,1332,1729]

1	take 12 sucesionA == [2,9,28,65,126,217,344,513,730,1001,1332,1729]

los elementos de sucesionAB son los términos de la sucesión b(n). Por ejemplo,

   sucesionB !! 0       ==  1
   sucesionB !! 4       ==  7
   sucesionB !! (10^9)  ==  1

sucesionB !! 0 == 1

sucesionB !! 4 == 7

sucesionB !! (10^9) == 1

Usando sucesionB, conjeturar la respuesta del problema y comprobarla con QuickCheck.

Soluciones

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

sucesionA :: [Integer]
sucesionA = [1+n^3 | n <- [1..]]

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

sucesionB :: [Integer]
sucesionB =
  zipWith gcd sucesionA (tail sucesionA)

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

-- Observando  los siguientes cálculos
--    λ> take 30 sucesionB
--    [1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1]
--    λ> take 10 [n | (n,x) <- zip [1..] sucesionB, x == 7]
--    [5,12,19,26,33,40,47,54,61,68]

sucesionB2 :: [Integer]
sucesionB2 = cycle [1,1,1,1,7,1,1]

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

-- La propiedad es
prop_sucesionB :: Int -> Property
prop_sucesionB n =
  n >= 0 ==>
  sucesionB !! n == sucesionB2 !! n

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

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

-- La comparación es
--    λ> sucesionB !! (10^7)
--    1
--    (5.23 secs, 2,880,105,504 bytes)
--    λ> sucesionB2 !! (10^7)
--    1
--    (0.06 secs, 98,600 bytes)

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

-- Observando los cálculos
--    λ> take 30 sucesionB
--    [1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1]
--    λ> take 30 ([1,1,1,1] ++ cycle (7 : replicate 6 1))
--    [1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1]
--    λ> take 100 sucesionB == take 100 ([1,1,1,1] ++ cycle (7 : replicate 6 1))
--    True
-- La conjetura es que el máximo es 7. Su expresión es

prop_maximo :: Int -> Property
prop_maximo n =
  n > 4 ==>
  maximum (take n sucesionB) == 7

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

import Data.List (cycle)

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

sucesionA :: [Integer]

sucesionA = [1+n^3 | n <- [1..]]

-- 1ª definición de sucesionB

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

sucesionB :: [Integer]

sucesionB =

zipWith gcd sucesionA (tail sucesionA)

-- 2ª definición de sucesionB

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

-- Observando los siguientes cálculos

-- λ> take 30 sucesionB

-- [1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1]

-- λ> take 10 [n | (n,x) <- zip [1..] sucesionB, x == 7]

-- [5,12,19,26,33,40,47,54,61,68]

sucesionB2 :: [Integer]

sucesionB2 = cycle [1,1,1,1,7,1,1]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_sucesionB :: Int -> Property

prop_sucesionB n =

n >= 0 ==>

sucesionB !! n == sucesionB2 !! n

-- La comprobación es

-- λ> quickCheck prop_sucesionB

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

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

-- 1

-- (5.23 secs, 2,880,105,504 bytes)

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

-- 1

-- (0.06 secs, 98,600 bytes)

-- Cálculo de la respuesta

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

-- Observando los cálculos

-- λ> take 30 sucesionB

-- [1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1]

-- λ> take 30 ([1,1,1,1] ++ cycle (7 : replicate 6 1))

-- [1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1,1,1,7,1,1,1,1]

-- λ> take 100 sucesionB == take 100 ([1,1,1,1] ++ cycle (7 : replicate 6 1))

-- True

-- La conjetura es que el máximo es 7. Su expresión es

prop_maximo :: Int -> Property

prop_maximo n =

n > 4 ==>

maximum (take n sucesionB) == 7

-- La comprobación es

-- λ> quickCheck prop_maximo

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

Biparticiones con la misma suma

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

El enunciado del problema 1 de la Fase Local de la Olimpiada Matemática Española del 2010 es

Sea I(n) el conjunto de los n primeros números naturales impares. Por ejemplo: I(3) = {1,3,5}, I(6) = {1,3,5,7,9,11}, etc.

¿Para qué números n el conjunto I(n) se puede descomponer en dos partes (disjuntas) de forma que coincidan las sumas de los números en cada una de ellas?

Definir las funciones

   biparticiones :: Integer -> [([Integer],[Integer])]
   tieneBiparticiones :: Integer -> Bool
   biparticionD :: Integer -> Maybe ([Integer],[Integer])

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

tieneBiparticiones :: Integer -> Bool

biparticionD :: Integer -> Maybe ([Integer],[Integer])

tales que

(biparticiones n) es la lista de las biparticiones de I(n) con igual suma; es decir, la lista de los pares (xs,ys) tales que xs e ys son subconjuntos disjuntos de I(n) cuya unión es I(n) y la suma de los elementos de xs es igual que la de los de ys. Por ejemplo,

     λ> biparticiones 4
     [([1,7],[3,5])]
     λ> biparticiones 5
     []
     λ> biparticiones 8
     [([1,3,13,15],[5,7,9,11]),([1,5,11,15],[3,7,9,13]),([1,7,9,15],[3,5,11,13]),([1,7,11,13],[3,5,9,15])]

λ> biparticiones 4

[([1,7],[3,5])]

λ> biparticiones 5

[]

λ> biparticiones 8

[([1,3,13,15],[5,7,9,11]),([1,5,11,15],[3,7,9,13]),([1,7,9,15],[3,5,11,13]),([1,7,11,13],[3,5,9,15])]

(tieneBiparticiones n) se verifica si I(n) tiene alguna bipartición con igual suma. Por ejemplo,

     tieneBiparticiones 4  ==  True
     tieneBiparticiones 5  ==  False
     tieneBiparticiones (10^(10^7))  ==  True

tieneBiparticiones 4 == True

tieneBiparticiones 5 == False

tieneBiparticiones (10^(10^7)) == True

(biparticionD n) es una de las biparticiones de I(n) con igual suma, si tiene alguna y Nothing, en caso contrario. Por ejemplo,

     λ> biparticionD 6
     Just ([7,11],[1,3,5,9])
     λ> biparticionD 7
     Nothing
     λ> biparticionD 8
     Just ([1,7,9,15],[3,5,11,13])
     λ> biparticionD 10
     Just ([7,11,13,19],[1,3,5,9,15,17])
     λ> biparticionD 12
     Just ([1,7,9,15,17,23],[3,5,11,13,19,21])
     λ> biparticionD 30
     Just ([7,11,13,19,21,27,29,35,37,43,45,51,53,59],[1,3,5,9,15,17,23,25,31,33,39,41,47,49,55,57])
     λ> length (show (biparticionD (2*10^4)))
     114455

λ> biparticionD 6

Just ([7,11],[1,3,5,9])

λ> biparticionD 7

Nothing

λ> biparticionD 8

Just ([1,7,9,15],[3,5,11,13])

λ> biparticionD 10

Just ([7,11,13,19],[1,3,5,9,15,17])

λ> biparticionD 12

Just ([1,7,9,15,17,23],[3,5,11,13,19,21])

λ> biparticionD 30

Just ([7,11,13,19,21,27,29,35,37,43,45,51,53,59],[1,3,5,9,15,17,23,25,31,33,39,41,47,49,55,57])

λ> length (show (biparticionD (2*10^4)))

114455

Usando tieneBiparticiones calcular los 10 primeros valores buscados (es decir, los 10 valores de n para los que I(n) se puede descomponer en dos partes (disjuntas) de forma que coincidan las sumas de los números en cada una de ellas) y generalizar.

Soluciones

import Data.List ((\\), delete, genericTake, sort, subsequences)
import Data.Maybe (listToMaybe)
import Test.QuickCheck (Property, (==>), quickCheck)

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

biparticiones :: Integer -> [([Integer],[Integer])]
biparticiones n =
  ordena [(bs \\ as,as) | as <- genericTake (2^(n-1)) (subsequences bs),
                          2 * sum as == m]
  where bs = genericTake n impares
        m  = sum bs

-- impares es la lista de los números impares. Por ejemplo,
--    take 9 impares  ==  [1,3,5,7,9,11,13,15,17]
impares :: [Integer]
impares = [1,3..]

-- (ordena ps) es lista obtenida poniendo en primer lugar la menor de
-- las componentes de los pares de ps y ordenando el resultado. Por
-- ejemplo,
--    ordena [(5,3),(1,7),(4,2)]  ==  [(1,7),(2,4),(3,5)]
ordena :: Ord a => [(a,a)] -> [(a,a)]
ordena ps = sort (map aux ps)
  where aux (xs,ys) | xs < ys   = (xs,ys)
                    | otherwise = (ys,xs)

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

biparticiones2 :: Integer -> [([Integer],[Integer])]
biparticiones2 n = sort (aux ([([a], delete a bs) | a <- bs]))
  where bs = genericTake n impares
        m  = sum bs
        aux [] = []
        aux ((_,[]):ps) = aux ps
        aux ((xs,ys):ps)
          | sum xs == sum ys = if xs < ys then (xs,ys) : aux ps
                               else aux ps
          | sum xs <  sum ys = aux ([(a:xs, delete a ys) | a <- ys, a < head xs] ++ ps)
          | otherwise        = aux ps

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

-- La propiedad es
prop_biparticiones :: Integer -> Bool
prop_biparticiones n =
  and [biparticiones k == biparticiones2 k | k <- [1..n]]

-- La comprobación es
--    λ> prop_biparticiones 20
--    True

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

-- La comparación es
--    λ> length (biparticiones 20)
--    3965
--    (0.36 secs, 568,151,296 bytes)
--    λ> length (biparticiones2 20)
--    3965
--    (2.51 secs, 2,490,876,672 bytes)
--    λ> head (biparticiones 20)
--    ([1,3,5,7,9,11,13,15,17,19,21,23,25,31],[27,29,33,35,37,39])
--    (0.37 secs, 562,477,968 bytes)
--    λ> head (biparticiones2 20)
--    ([1,3,5,7,9,11,13,15,17,19,21,23,25,31],[27,29,33,35,37,39])
--    (2.33 secs, 2,488,098,776 bytes)

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

tieneBiparticiones :: Integer -> Bool
tieneBiparticiones = not . null . biparticiones

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

-- Observando el siguiente cálculo
--    λ> [n | n <- [1..20], tieneBiparticiones n]
--    [4,6,8,10,12,14,16,18,20]

tieneBiparticiones2 :: Integer -> Bool
tieneBiparticiones2 n = n > 3 && even n

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

biparticionD :: Integer -> Maybe ([Integer],[Integer])
biparticionD = listToMaybe . biparticiones

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

biparticionD2 :: Integer -> Maybe ([Integer],[Integer])
biparticionD2 x
  | x < 4 || odd x = Nothing
  | otherwise      = Just (aux x)
  where
    aux 4 = ([1,7],[3,5])
    aux 6 = ([7,11],[1,3,5,9])
    aux n = (xs ++ [m+1,m+7], ys ++ [m+3,m+5])
      where (xs,ys) = aux (n-4)
            m       = 2*(n-4)

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

-- El cálculo es
--    λ> take 10 [n | n <- [1..], tieneBiparticiones n]
--    [4,6,8,10,12,14,16,18,20,22]
-- cuyos valores son los números pares mayores que 3.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

import Data.List ((\\), delete, genericTake, sort, subsequences)

import Data.Maybe (listToMaybe)

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

-- 1ª definición de biparticiones

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

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

biparticiones n =

ordena [(bs \\ as,as) | as <- genericTake (2^(n-1)) (subsequences bs),

2 * sum as == m]

where bs = genericTake n impares

m = sum bs

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

-- take 9 impares == [1,3,5,7,9,11,13,15,17]

impares :: [Integer]

impares = [1,3..]

-- (ordena ps) es lista obtenida poniendo en primer lugar la menor de

-- las componentes de los pares de ps y ordenando el resultado. Por

-- ejemplo,

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

ordena :: Ord a => [(a,a)] -> [(a,a)]

ordena ps = sort (map aux ps)

where aux (xs,ys) | xs < ys = (xs,ys)

| otherwise = (ys,xs)

-- 2ª definición de biparticiones

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

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

biparticiones2 n = sort (aux ([([a], delete a bs) | a <- bs]))

where bs = genericTake n impares

m = sum bs

aux [] = []

aux ((_,[]):ps) = aux ps

aux ((xs,ys):ps)

| sum xs == sum ys = if xs < ys then (xs,ys) : aux ps

else aux ps

| sum xs < sum ys = aux ([(a:xs, delete a ys) | a <- ys, a < head xs] ++ ps)

| otherwise = aux ps

-- Comprobación de equivalencia

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

-- La propiedad es

prop_biparticiones :: Integer -> Bool

prop_biparticiones n =

and [biparticiones k == biparticiones2 k | k <- [1..n]]

-- La comprobación es

-- λ> prop_biparticiones 20

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (biparticiones 20)

-- 3965

-- (0.36 secs, 568,151,296 bytes)

-- λ> length (biparticiones2 20)

-- 3965

-- (2.51 secs, 2,490,876,672 bytes)

-- λ> head (biparticiones 20)

-- ([1,3,5,7,9,11,13,15,17,19,21,23,25,31],[27,29,33,35,37,39])

-- (0.37 secs, 562,477,968 bytes)

-- λ> head (biparticiones2 20)

-- ([1,3,5,7,9,11,13,15,17,19,21,23,25,31],[27,29,33,35,37,39])

-- (2.33 secs, 2,488,098,776 bytes)

-- 1ª definición de tieneBiparticiones

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

tieneBiparticiones :: Integer -> Bool

tieneBiparticiones = not . null . biparticiones

-- 2ª definición de tieneBiparticiones

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

-- Observando el siguiente cálculo

-- λ> [n | n <- [1..20], tieneBiparticiones n]

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

tieneBiparticiones2 :: Integer -> Bool

tieneBiparticiones2 n = n > 3 && even n

-- 1ª definición de biparticionD

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

biparticionD :: Integer -> Maybe ([Integer],[Integer])

biparticionD = listToMaybe . biparticiones

-- 2ª definición de biparticionD

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

biparticionD2 :: Integer -> Maybe ([Integer],[Integer])

biparticionD2 x

| x < 4 || odd x = Nothing

| otherwise = Just (aux x)

where

aux 4 = ([1,7],[3,5])

aux 6 = ([7,11],[1,3,5,9])

aux n = (xs ++ [m+1,m+7], ys ++ [m+3,m+5])

where (xs,ys) = aux (n-4)

m = 2*(n-4)

-- Cálculo de la respuesta

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

-- El cálculo es

-- λ> take 10 [n | n <- [1..], tieneBiparticiones n]

-- [4,6,8,10,12,14,16,18,20,22]

-- cuyos valores son los números pares mayores que 3.

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>

Diferencias de potencias congruentes con 5 módulo 7

PorJosé A. Alonso 11-mayo-202118-mayo-2021

El enunciado de un problema 5 de la Fase Local de la Olimpiada Matemática Española del 2012 es

Consideremos el número entero positivo $n = 2^r - 16^s$ , donde r y s son también enteros positivos. Hallar las condiciones que deben cumplir r y s para que el resto de la división de n por 7 sea 5. Hallar el menor número que cumple esta condición.

Definir la lista

   exponentes :: [(Integer,Integer)]

1	exponentes :: [(Integer,Integer)]

tal que sus elementos son los pares de enteros positivos (r,s) tales que $2^r - 16^s$ es un número entero positivo cuyo resto al dividirlo por 7 es 5. Por ejemplo,

   head exponentes       ==  (10,2)
   exponentes !! 23      ==  (43,8)
   exponentes !! (10^7)  ==  (26836,1826)

head exponentes == (10,2)

exponentes !! 23 == (43,8)

exponentes !! (10^7) == (26836,1826)

Usando la función exponentes, calcular la respuesta a la pregunta del problema; es decir, hallar el menor número que cumple la condición.

Soluciones

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

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

exponentes :: [(Integer,Integer)]
exponentes =
  [(r,s) | (r,s) <- pares,
           let n = 2^r - 16^s,
           n > 0,
           n `mod` 7 == 5]

-- pares el lista de pares de enteros positivos con el primero mayor que
-- el segundo. Por ejemplo,
--    λ> take 10 pares
--    [(2,1),(3,1),(3,2),(4,1),(4,2),(4,3),(5,1),(5,2),(5,3),(5,4)]
pares :: [(Integer,Integer)]
pares = [(a,b) | a <- [1..]
               , b <- [1..a-1]]

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

-- Observando los siguientes cálculos
--    λ> take 28 exponentes
--    [(10,2),(13,2),(16,2),(19,2),(22,2),(22,5),(25,2),(25,5),(28,2),
--     (28,5),(31,2),(31,5),(34,2),(34,5),(34,8),(37,2),(37,5),(37,8),
--     (40,2),(40,5),(40,8),(43,2),(43,5),(43,8),(46,2),(46,5),(46,8),
--     (46,11)]
--    λ> [((x-1) `div` 3, (y-2) `div` 3) | (x,y) <- it]
--    [(3,0),(4,0),(5,0),(6,0),(7,0),(7,1),(8,0),(8,1),(9,0),(9,1),
--     (10,0),(10,1),(11,0),(11,1),(11,2),(12,0),(12,1),(12,2),(13,0),
--     (13,1),(13,2),(14,0),(14,1),(14,2),(15,0),(15,1),(15,2),(15,3)]

exponentes2 :: [(Integer,Integer)]
exponentes2 =
  concat [[(r,s) | s <- takeWhile (<= (r `div` 4)) ys] | r <- xs]
  where xs = [10,13..]
        ys = [2,5..]

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

exponentes3 :: [(Integer,Integer)]
exponentes3 = [(r,s) | r <- [1,4..], s <- [2,5..r `div` 4]]

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

-- La propiedad es
prop_exponentes :: Int -> Property
prop_exponentes n =
  n >= 0 ==>
  all (== (exponentes !! n))
      [exponentes2 !! n,
       exponentes3 !! n]

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

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

-- La comparación es
--    λ> exponentes !! (3*10^4)
--    (1471,332)
--    (5.21 secs, 7,844,582,216 bytes)
--    λ> exponentes2 !! (3*10^4)
--    (1471,332)
--    (0.04 secs, 6,551,432 bytes)
--    λ> exponentes3 !! (3*10^4)
--    (1471,332)
--    (0.01 secs, 5,512,056 bytes)
--
--    λ> exponentes2 !! (10^7)
--    (26836,1826)
--    (3.25 secs, 2,083,815,616 bytes)
--    λ> exponentes3 !! (10^7)
--    (26836,1826)
--    (2.57 secs, 1,757,467,216 bytes)

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

-- El cálculo es
--    λ> (r,s) = head exponentes
--    λ> 2^r - 16^s
--    768
-- Por tanto, el número pedido es el 768.

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

-- 1ª solución

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

exponentes :: [(Integer,Integer)]

exponentes =

[(r,s) | (r,s) <- pares,

let n = 2^r - 16^s,

n > 0,

n `mod` 7 == 5]

-- pares el lista de pares de enteros positivos con el primero mayor que

-- el segundo. Por ejemplo,

-- λ> take 10 pares

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

pares :: [(Integer,Integer)]

pares = [(a,b) | a <- [1..]

, b <- [1..a-1]]

-- 2ª solución

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

-- Observando los siguientes cálculos

-- λ> take 28 exponentes

-- [(10,2),(13,2),(16,2),(19,2),(22,2),(22,5),(25,2),(25,5),(28,2),

-- (28,5),(31,2),(31,5),(34,2),(34,5),(34,8),(37,2),(37,5),(37,8),

-- (40,2),(40,5),(40,8),(43,2),(43,5),(43,8),(46,2),(46,5),(46,8),

-- (46,11)]

-- λ> [((x-1) `div` 3, (y-2) `div` 3) | (x,y) <- it]

-- [(3,0),(4,0),(5,0),(6,0),(7,0),(7,1),(8,0),(8,1),(9,0),(9,1),

-- (10,0),(10,1),(11,0),(11,1),(11,2),(12,0),(12,1),(12,2),(13,0),

-- (13,1),(13,2),(14,0),(14,1),(14,2),(15,0),(15,1),(15,2),(15,3)]

exponentes2 :: [(Integer,Integer)]

exponentes2 =

concat [[(r,s) | s <- takeWhile (<= (r `div` 4)) ys] | r <- xs]

where xs = [10,13..]

ys = [2,5..]

-- 3ª solución

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

exponentes3 :: [(Integer,Integer)]

exponentes3 = [(r,s) | r <- [1,4..], s <- [2,5..r `div` 4]]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_exponentes :: Int -> Property

prop_exponentes n =

n >= 0 ==>

all (== (exponentes !! n))

[exponentes2 !! n,

exponentes3 !! n]

-- La comprobación es

-- λ> quickCheck prop_exponentes

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> exponentes !! (3*10^4)

-- (1471,332)

-- (5.21 secs, 7,844,582,216 bytes)

-- λ> exponentes2 !! (3*10^4)

-- (1471,332)

-- (0.04 secs, 6,551,432 bytes)

-- λ> exponentes3 !! (3*10^4)

-- (1471,332)

-- (0.01 secs, 5,512,056 bytes)

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

-- (26836,1826)

-- (3.25 secs, 2,083,815,616 bytes)

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

-- (26836,1826)

-- (2.57 secs, 1,757,467,216 bytes)

-- Cálculo de la respuesta

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

-- El cálculo es

-- λ> (r,s) = head exponentes

-- λ> 2^r - 16^s

-- 768

-- Por tanto, el número pedido es el 768.

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>

Suma de no múltiplos

PorJosé A. Alonso 10-mayo-202117-mayo-2021

El enunciado del problema 1 de la Fase Local de la Olimpiada Matemática Española del 2011 es

Dado un entero positivo n, hallar la suma de todos los enteros positivos inferiores a 10n que no son múltiplos de 2 ni de 5.

Definir la función

   suma :: Integer -> Integer

1	suma :: Integer -> Integer

tal que (suma n) es la suma de todos los enteros positivos inferiores a 10n que no son múltiplos de 2 ni de 5. Por ejemplo,

   suma 7  ==  980
   length (show (suma (10^(10^5))))  ==  200002
   length (show (suma (10^(10^6))))  ==  2000002
   length (show (suma (10^(10^7))))  ==  20000002

suma 7 == 980

length (show (suma (10^(10^5)))) == 200002

length (show (suma (10^(10^6)))) == 2000002

length (show (suma (10^(10^7)))) == 20000002

Soluciones

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

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

suma :: Integer -> Integer
suma n =
  sum [x | x <- [1..10*n],
           x `mod` 2 /= 0,
           x `mod` 5 /= 0]

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

suma2 :: Integer -> Integer
suma2 n =
  sum ([1..10*n] \\ ([2,4..10*n] ++ [5,10..10*n]))

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

-- Observando los siguientes cálculos
--    λ> map suma [1..10]
--    [20,80,180,320,500,720,980,1280,1620,2000]
--    λ> map (`div` 20) it
--    [1,4,9,16,25,36,49,64,81,100]

suma3 :: Integer -> Integer
suma3 n = 20*n^2

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

-- La propiedad es
prop_suma :: Integer -> Property
prop_suma n =
  n > 0 ==>
  all (== (suma n))
      [suma2 n,
       suma3 n]

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

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

-- La comparación es
--    λ> suma (2*10^3)
--    80000000
--    (0.05 secs, 6,671,720 bytes)
--    λ> suma2 (2*10^3)
--    80000000
--    (2.63 secs, 7,886,190,192 bytes)
--    λ> suma3 (2*10^3)
--    80000000
--    (0.02 secs, 106,736 bytes)
--
--    λ> suma (4*10^5)
--    3200000000000
--    (2.31 secs, 1,314,056,144 bytes)
--    λ> suma3 (4*10^5)
--    3200000000000
--    (0.02 secs, 106,808 bytes)

import Data.List ((\\))

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

-- 1ª solución

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

suma :: Integer -> Integer

suma n =

sum [x | x <- [1..10*n],

x `mod` 2 /= 0,

x `mod` 5 /= 0]

-- 2ª solución

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

suma2 :: Integer -> Integer

suma2 n =

sum ([1..10*n] \\ ([2,4..10*n] ++ [5,10..10*n]))

-- 3ª solución

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

-- Observando los siguientes cálculos

-- λ> map suma [1..10]

-- [20,80,180,320,500,720,980,1280,1620,2000]

-- λ> map (`div` 20) it

-- [1,4,9,16,25,36,49,64,81,100]

suma3 :: Integer -> Integer

suma3 n = 20*n^2

-- Comprobación de equivalencia

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

-- La propiedad es

prop_suma :: Integer -> Property

prop_suma n =

n > 0 ==>

all (== (suma n))

[suma2 n,

suma3 n]

-- La comprobación es

-- λ> quickCheck prop_suma

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> suma (2*10^3)

-- 80000000

-- (0.05 secs, 6,671,720 bytes)

-- λ> suma2 (2*10^3)

-- 80000000

-- (2.63 secs, 7,886,190,192 bytes)

-- λ> suma3 (2*10^3)

-- 80000000

-- (0.02 secs, 106,736 bytes)

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

-- 3200000000000

-- (2.31 secs, 1,314,056,144 bytes)

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

-- 3200000000000

-- (0.02 secs, 106,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>

Suma de serie racional

PorJosé A. Alonso 7-mayo-202114-mayo-2021

El enunciado del problema 6 de la Fase Local de la Olimpiada Matemática Española del 2020 es

Sea n un entero positivo. Calcular la siguiente suma

         3           4           5                    n+2
     --------- + --------- + --------- + ··· + ---------------------
      1·2·4·5     2·3·5·6     3·4·6·7           n·(n+1)·(n+3)·(n+4)

3 4 5 n+2

--------- + --------- + --------- + ··· + ---------------------

1·2·4·5 2·3·5·6 3·4·6·7 n·(n+1)·(n+3)·(n+4)

Definir la función

   sumaSerie :: Integer -> Rational

1	sumaSerie :: Integer -> Rational

tal que para cada entero positivo n, (sumaSerie n) es el valor de la siguiente sumaSerie

      3           4           5                    n+2
  --------- + --------- + --------- + ··· + ---------------------
   1·2·4·5     2·3·5·6     3·4·6·7           n·(n+1)·(n+3)·(n+4)

3 4 5 n+2

--------- + --------- + --------- + ··· + ---------------------

1·2·4·5 2·3·5·6 3·4·6·7 n·(n+1)·(n+3)·(n+4)

Por ejemplo,

   sumaSerie 1        ==  3 % 40
   sumaSerie 2        ==  7 % 72
   sumaSerie 3        ==  3 % 28
   sumaSerie (10^10)  ==  3125000001562500000 % 25000000012500000001

   length (show (sumaSerie (10^10)))      ==  42
   length (show (sumaSerie (10^(10^2))))  ==  402
   length (show (sumaSerie (10^(10^3))))  ==  4002
   length (show (sumaSerie (10^(10^4))))  ==  40002
   length (show (sumaSerie (10^(10^5))))  ==  400002
   length (show (sumaSerie (10^(10^6))))  ==  4000002

sumaSerie 1 == 3 % 40

sumaSerie 2 == 7 % 72

sumaSerie 3 == 3 % 28

sumaSerie (10^10) == 3125000001562500000 % 25000000012500000001

length (show (sumaSerie (10^10))) == 42

length (show (sumaSerie (10^(10^2)))) == 402

length (show (sumaSerie (10^(10^3)))) == 4002

length (show (sumaSerie (10^(10^4)))) == 40002

length (show (sumaSerie (10^(10^5)))) == 400002

length (show (sumaSerie (10^(10^6)))) == 4000002

Soluciones

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

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

sumaSerie :: Integer -> Rational
sumaSerie n =
  sum [k/((k-1)*(k-2)*(k+1)*(k+2))
      | a <- [3..n+2],
        let k = fromIntegral a]

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

-- Calculando los primeros términos
--    λ> [sumaSerie n | n <- [1..11]]
--    [3 % 40,7 % 72,3 % 28,9 % 80,25 % 216,33 % 280,21 % 176,13 % 108,63 % 520,75 % 616,11 % 90]
-- y usando Wolfram Alpha https://bit.ly/2PvoCEK

sumaSerie2 :: Integer -> Rational
sumaSerie2 n = m*(m+5)/(8*(m+1)*(m+4))
  where m = fromIntegral n

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

-- La propiedad es
prop_sumaSerie :: Integer -> Property
prop_sumaSerie n =
  n > 0 ==>
  sumaSerie n == sumaSerie2 n

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

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

-- La comparación es
--    λ> sumaSerie (10^6)
--    31250156250 % 250001250001
--    (4.99 secs, 6,029,246,016 bytes)
--    λ> sumaSerie2 (10^6)
--    31250156250 % 250001250001
--    (0.02 secs, 123,280 bytes)

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

-- 1ª solución

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

sumaSerie :: Integer -> Rational

sumaSerie n =

sum [k/((k-1)*(k-2)*(k+1)*(k+2))

| a <- [3..n+2],

let k = fromIntegral a]

-- 2ª solución

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

-- Calculando los primeros términos

-- λ> [sumaSerie n | n <- [1..11]]

-- [3 % 40,7 % 72,3 % 28,9 % 80,25 % 216,33 % 280,21 % 176,13 % 108,63 % 520,75 % 616,11 % 90]

-- y usando Wolfram Alpha https://bit.ly/2PvoCEK

sumaSerie2 :: Integer -> Rational

sumaSerie2 n = m*(m+5)/(8*(m+1)*(m+4))

where m = fromIntegral n

-- Comprobación de equivalencia

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

-- La propiedad es

prop_sumaSerie :: Integer -> Property

prop_sumaSerie n =

n > 0 ==>

sumaSerie n == sumaSerie2 n

-- La comprobación es

-- λ> quickCheck prop_sumaSerie

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> sumaSerie (10^6)

-- 31250156250 % 250001250001

-- (4.99 secs, 6,029,246,016 bytes)

-- λ> sumaSerie2 (10^6)

-- 31250156250 % 250001250001

-- (0.02 secs, 123,280 bytes)

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 persistentes de siete

PorJosé A. Alonso 6-mayo-202113-mayo-2021

El enunciado del problema 1 de la Fase Local de la Olimpiada Matemática Española del 2021 es

Determinar todos los números de cuatro cifras tales que al insertar un dígito 0 en cualquier posición se obtiene un múltiplo de 7.

Un número n se dice que es un múltiplo persistente de 7 si al insertar el dígito 0 en cualquier posición de n se obtiene un múltiplo de 7.

Definir las funciones

   esMultiploPersistente :: Integer -> Bool
   multiplosPersistentes :: Int -> [Integer]

1 2	esMultiploPersistente :: Integer -> Bool multiplosPersistentes :: Int -> [Integer]

tales que

(esMultiploPersistente n) se verifica si n es un múltiplo persistente de n. Por ejemplo,

     esMultiploPersistente 7007  ==  True
     esMultiploPersistente 7107  ==  False

1 2	esMultiploPersistente 7007 == True esMultiploPersistente 7107 == False

(multiplosPersistentes k) es la lista de los números con k dígitos que son múltiplos persistentes de 7. Por ejemplo,

     take 2 (multiplosPersistentes 4)   ==  [7000,7007]
     length (multiplosPersistentes 20)  ==  524288

1 2	take 2 (multiplosPersistentes 4) == [7000,7007] length (multiplosPersistentes 20) == 524288

Usando la función multiplosPersistentes, calcular la respuesta al problema de la Olimpiada.

Soluciones

import Data.List (sort)

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

esMultiploPersistente :: Integer -> Bool
esMultiploPersistente n =
  and [x `mod` 7 == 0 | x <- insertados n]

-- (insertados n) es la lista de los números obtenidos insertando un 0
-- en cualquier posición de n. Por ejemplo,
--    insertados 3264  ==  [3264,30264,32064,32604,32640]
insertados :: Integer -> [Integer]
insertados n =
  [read (xs ++ "0" ++ ys) | k <- [0..length ns],
                            let (xs,ys) = splitAt k ns]
  where ns = show n

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

multiplosPersistentes :: Int -> [Integer]
multiplosPersistentes n =
  filter esMultiploPersistente [10^(n-1)..10^n-1]

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

multiplosPersistentes2 :: Int -> [Integer]
multiplosPersistentes2 n =
  filter esMultiploPersistente [7*10^(n-1),7*10^(n-1)+7..7*((10^n-1) `div` 9)]

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

-- Observando los cálculos
--    multiplosPersistentes2 1  ==  [7]
--    multiplosPersistentes2 2  ==  [70,77]
--    multiplosPersistentes2 3  ==  [700,707,770,777]
--    multiplosPersistentes2 4  ==  [7000,7007,7070,7077,7700,7707,7770,7777]

esMultiploPersistente2 :: Integer -> Bool
esMultiploPersistente2 n =
  all (`elem` "07") (show n)

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

multiplosPersistentes3 :: Int -> [Integer]
multiplosPersistentes3 n =
  filter esMultiploPersistente2 [7*10^(n-1),7*10^(n-1)+7..7*((10^n-1) `div` 9)]

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

multiplosPersistentes4 :: Int -> [Integer]
multiplosPersistentes4 k =
  sort [read (reverse cs) | cs <- aux k]
  where aux 1 = ["7"]
        aux n = map ('0':) xs ++ map ('7':) xs
          where xs = aux (n-1)

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

-- La propiedad es
prop_multiplosPresistentes :: Int -> Bool
prop_multiplosPresistentes n =
  all (== (multiplosPersistentes n))
      [multiplosPersistentes2 n,
       multiplosPersistentes3 n,
       multiplosPersistentes4 n]

-- La comprobación es
--    λ> all prop_multiplosPresistentes [1..6]
--    True

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

-- La comparación es
--    λ> length (multiplosPersistentes 6)
--    32
--    (3.35 secs, 7,378,373,000 bytes)
--    λ> length (multiplosPersistentes2 6)
--    32
--    (0.12 secs, 171,735,992 bytes)
--    λ> length (multiplosPersistentes3 6)
--    32
--    (0.03 secs, 9,290,744 bytes)
--    λ> length (multiplosPersistentes4 6)
--    32
--    (0.01 secs, 294,584 bytes)
--
--    λ> length (multiplosPersistentes2 8)
--    128
--    (7.76 secs, 18,659,185,520 bytes)
--    λ> length (multiplosPersistentes3 8)
--    128
--    (0.73 secs, 1,007,383,168 bytes)
--    λ> length (multiplosPersistentes4 8)
--    128
--    (0.01 secs, 960,808 bytes)
--
--    λ> length (multiplosPersistentes3 9)
--    256
--    (6.82 secs, 10,517,232,576 bytes)
--    λ> length (multiplosPersistentes4 9)
--    256
--    (0.01 secs, 1,912,136 bytes)

100

101

102

103

104

105

106

107

108

109

110

import Data.List (sort)

-- 1ª definición de esMultiploPersistente

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

esMultiploPersistente :: Integer -> Bool

esMultiploPersistente n =

and [x `mod` 7 == 0 | x <- insertados n]

-- (insertados n) es la lista de los números obtenidos insertando un 0

-- en cualquier posición de n. Por ejemplo,

-- insertados 3264 == [3264,30264,32064,32604,32640]

insertados :: Integer -> [Integer]

insertados n =

[read (xs ++ "0" ++ ys) | k <- [0..length ns],

let (xs,ys) = splitAt k ns]

where ns = show n

-- 1ª definición de multiplosPersistentes

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

multiplosPersistentes :: Int -> [Integer]

multiplosPersistentes n =

filter esMultiploPersistente [10^(n-1)..10^n-1]

-- 2ª definición de multiplosPersistentes

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

multiplosPersistentes2 :: Int -> [Integer]

multiplosPersistentes2 n =

filter esMultiploPersistente [7*10^(n-1),7*10^(n-1)+7..7*((10^n-1) `div` 9)]

-- 3ª definición de esMultiploPersistente

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

-- Observando los cálculos

-- multiplosPersistentes2 1 == [7]

-- multiplosPersistentes2 2 == [70,77]

-- multiplosPersistentes2 3 == [700,707,770,777]

-- multiplosPersistentes2 4 == [7000,7007,7070,7077,7700,7707,7770,7777]

esMultiploPersistente2 :: Integer -> Bool

esMultiploPersistente2 n =

all (`elem` "07") (show n)

-- 3ª definición de multiplosPersistentes

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

multiplosPersistentes3 :: Int -> [Integer]

multiplosPersistentes3 n =

filter esMultiploPersistente2 [7*10^(n-1),7*10^(n-1)+7..7*((10^n-1) `div` 9)]

-- 4ª definición de multiplosPersistentes

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

multiplosPersistentes4 :: Int -> [Integer]

multiplosPersistentes4 k =

sort [read (reverse cs) | cs <- aux k]

where aux 1 = ["7"]

aux n = map ('0':) xs ++ map ('7':) xs

where xs = aux (n-1)

-- Comprobación de equivalencia

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

-- La propiedad es

prop_multiplosPresistentes :: Int -> Bool

prop_multiplosPresistentes n =

all (== (multiplosPersistentes n))

[multiplosPersistentes2 n,

multiplosPersistentes3 n,

multiplosPersistentes4 n]

-- La comprobación es

-- λ> all prop_multiplosPresistentes [1..6]

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (multiplosPersistentes 6)

-- 32

-- (3.35 secs, 7,378,373,000 bytes)

-- λ> length (multiplosPersistentes2 6)

-- 32

-- (0.12 secs, 171,735,992 bytes)

-- λ> length (multiplosPersistentes3 6)

-- 32

-- (0.03 secs, 9,290,744 bytes)

-- λ> length (multiplosPersistentes4 6)

-- 32

-- (0.01 secs, 294,584 bytes)

-- λ> length (multiplosPersistentes2 8)

-- 128

-- (7.76 secs, 18,659,185,520 bytes)

-- λ> length (multiplosPersistentes3 8)

-- 128

-- (0.73 secs, 1,007,383,168 bytes)

-- λ> length (multiplosPersistentes4 8)

-- 128

-- (0.01 secs, 960,808 bytes)

-- λ> length (multiplosPersistentes3 9)

-- 256

-- (6.82 secs, 10,517,232,576 bytes)

-- λ> length (multiplosPersistentes4 9)

-- 256

-- (0.01 secs, 1,912,136 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últiplos repitunos (OME1993 P4)

PorJosé A. Alonso 5-mayo-202112-mayo-2021

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

Demostrar que para todo número primo p distinto de 2 y de 5, existen infinitos múltiplos de p de la forma 1111……1 (escrito sólo con unos).

Definir la función

   multiplosRepitunos :: Integer -> [Integer]

1	multiplosRepitunos :: Integer -> [Integer]

tal que (multiplosRepitunos p n) es la lista de los múltiplos repitunos de p (es decir, de la forma 1111…1 escrito sólo con unos), donde p es un número primo distinto de 2 y 5. Por ejemplo,

   take 2 (multiplosRepitunos 7) == [111111,111111111111]
   head (multiplosRepitunos 19)  == 111111111111111111
   length (show (head (multiplosRepitunos (primes !! (10^5))))) == 43324

take 2 (multiplosRepitunos 7) == [111111,111111111111]

head (multiplosRepitunos 19) == 111111111111111111

length (show (head (multiplosRepitunos (primes !! (10^5))))) == 43324

Comprobar con QuickCheck que para todo primo p mayor que 5 y todo número entero positivo n, existe un mútiplo repituno de p mayor que n.

Soluciones

import Data.Numbers.Primes (primes)
import Test.QuickCheck (Property, (==>), quickCheck)

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

multiplosRepitunos :: Integer -> [Integer]
multiplosRepitunos p =
  [x | x <- repitunos
     , mod x p == 0]

-- repitunos es la lista de los números de la forma 111...1 (escrito sólo con
-- unos). Por ejemplo,
--    take 5 repitunos  ==  [1,11,111,1111,11111]
repitunos :: [Integer]
repitunos = 1 : [10*x+1 | x <- repitunos]

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

multiplosRepitunos2 :: Integer -> [Integer]
multiplosRepitunos2 p =
  [x | x <- repitunos2
     , mod x p == 0]

repitunos2 :: [Integer]
repitunos2 = [div (10^n-1) 9 | n <- [1..]]

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

-- La comparación es
--    λ> length (show (head (multiplosRepitunos (primes !! (10^5)))))
--    43324
--    (0.58 secs, 1,272,561,448 bytes)
--    λ> length (show (head (multiplosRepitunos2 (primes !! (10^5)))))
--    43324
--    (5.50 secs, 2,563,458,656 bytes)

-- Comprobación
-- ============

-- La propiedad es
prop_multiplosRepitunos :: Int -> Property
prop_multiplosRepitunos k =
  k > 2  ==>
  not (null (multiplosRepitunos (primes !! k)))

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

import Data.Numbers.Primes (primes)

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

-- 1ª solución

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

multiplosRepitunos :: Integer -> [Integer]

multiplosRepitunos p =

[x | x <- repitunos

, mod x p == 0]

-- repitunos es la lista de los números de la forma 111...1 (escrito sólo con

-- unos). Por ejemplo,

-- take 5 repitunos == [1,11,111,1111,11111]

repitunos :: [Integer]

repitunos = 1 : [10*x+1 | x <- repitunos]

-- 2ª solución

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

multiplosRepitunos2 :: Integer -> [Integer]

multiplosRepitunos2 p =

[x | x <- repitunos2

, mod x p == 0]

repitunos2 :: [Integer]

repitunos2 = [div (10^n-1) 9 | n <- [1..]]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (show (head (multiplosRepitunos (primes !! (10^5)))))

-- 43324

-- (0.58 secs, 1,272,561,448 bytes)

-- λ> length (show (head (multiplosRepitunos2 (primes !! (10^5)))))

-- 43324

-- (5.50 secs, 2,563,458,656 bytes)

-- Comprobación

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

-- La propiedad es

prop_multiplosRepitunos :: Int -> Property

prop_multiplosRepitunos k =

k > 2 ==>

not (null (multiplosRepitunos (primes !! k)))

-- La comprobación es

-- λ> quickCheck prop_multiplosRepitunos

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

Ecuación diofántica con primos (OME1995 P4)

PorJosé A. Alonso 4-mayo-202111-mayo-2021

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

Siendo p un número primo, halla las soluciones enteras de la ecuación:

p.(x + y) = x.y

Definir la función

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

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

tal que (soluciones p) es la lista de los pares de enteros (x,y) tales que p.(x + y) = x.y. Por ejemplo,

   λ> take 3 (soluciones 7)
   [(0,0),(14,14),(-42,6)]
   λ> sum [x+y | (x,y) <- take 6 (soluciones (primes !! (10^6)))]
   185830404

λ> take 3 (soluciones 7)

[(0,0),(14,14),(-42,6)]

λ> sum [x+y | (x,y) <- take 6 (soluciones (primes !! (10^6)))]

185830404

Soluciones

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

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

soluciones :: Integer -> [(Integer, Integer)]
soluciones p =
  [(x,y) | (x,y) <- pares,
           p * (x + y) == x * y]

-- pares es la lista de los pares de números enteros ordenados por la
-- suma de los valores absolutos de sus componentes. Por ejemplo,
--    λ> take 38 pares
--    [(0,0),(-1,0),(0,-1),(0,1),(1,0),(-2,0),(-1,-1),(-1,1),(0,-2),
--     (0,2),(1,-1),(1,1),(2,0),(-3,0),(-2,-1),(-2,1),(-1,-2),(-1,2),
--     (0,-3),(0,3),(1,-2),(1,2),(2,-1),(2,1),(3,0),(-4,0),(-3,-1),
--     (-3,1),(-2,-2),(-2,2),(-1,-3),(-1,3),(0,-4),(0,4),(1,-3),(1,3),
--     (2,-2),(2,2)]
pares :: [(Integer,Integer)]
pares = concatMap paresEnterosSuma [0..]

-- (paresEnterosSuma n) es la lista de pares de enteros (x,y) tales que la suma
-- de los valores absolutos de x e y es igual a n. Por ejemplo,
--    λ> paresEnterosSuma 3
--    [(-3,0),(-2,-1),(-2,1),(-1,-2),(-1,2),(0,-3),(0,3),(1,-2),(1,2),
--     (2,-1),(2,1),(3,0)]
paresEnterosSuma :: Integer -> [(Integer,Integer)]
paresEnterosSuma n = concatMap aux [-n..n]
  where aux k | m == 0    = [(k,0)]
              | otherwise = [(k,-m),(k,m)]
          where m = n - abs k

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

-- Observando los siguientes cálculos:
--    take 6 (soluciones 2)  == [(0,0),(-2,1),(1,-2),(4,4),(3,6),(6,3)]
--    take 6 (soluciones 3)  == [(0,0),(-6,2),(2,-6),(6,6),(4,12),(12,4)]
--    take 6 (soluciones 5)  == [(0,0),(10,10),(-20,4),(4,-20),(6,30),(30,6)]
--    take 6 (soluciones 7)  == [(0,0),(14,14),(-42,6),(6,-42),(8,56),(56,8)]
--    take 6 (soluciones 11) == [(0,0),(22,22),(-110,10),(10,-110),(12,132),(132,12)]

soluciones2 :: Integer -> [(Integer, Integer)]
soluciones2 2 = [(0,0),(-2,1),(1,-2),(4,4),(3,6),(6,3)]
soluciones2 3 = [(0,0),(-6,2),(2,-6),(6,6),(4,12),(12,4)]
soluciones2 p =
  [(0,0), (2*p,2*p), (p*(1-p),p-1), (p-1,p*(1-p)), (p+1,p*(p+1)), (p*(p+1),p+1)]

-- Comparación de equivalencia
-- ===========================

-- La propiedad es
prop_equivalencia :: Bool
prop_equivalencia =
  and [ take 6 (soluciones p) == soluciones2 p
      | p <- takeWhile (<= 37) primes]

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

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

-- La comparación es
--    λ> take 6 (soluciones 37)
--    [(0,0),(74,74),(-1332,36),(36,-1332),(38,1406),(1406,38)]
--    (3.88 secs, 2,521,196,352 bytes)
--    λ> take 6 (soluciones2 37)
--    [(0,0),(74,74),(-1332,36),(36,-1332),(38,1406),(1406,38)]
--    (0.01 secs, 144,192 bytes)

import Data.List (sort)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

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

soluciones p =

[(x,y) | (x,y) <- pares,

p * (x + y) == x * y]

-- pares es la lista de los pares de números enteros ordenados por la

-- suma de los valores absolutos de sus componentes. Por ejemplo,

-- λ> take 38 pares

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

-- (0,2),(1,-1),(1,1),(2,0),(-3,0),(-2,-1),(-2,1),(-1,-2),(-1,2),

-- (0,-3),(0,3),(1,-2),(1,2),(2,-1),(2,1),(3,0),(-4,0),(-3,-1),

-- (-3,1),(-2,-2),(-2,2),(-1,-3),(-1,3),(0,-4),(0,4),(1,-3),(1,3),

-- (2,-2),(2,2)]

pares :: [(Integer,Integer)]

pares = concatMap paresEnterosSuma [0..]

-- (paresEnterosSuma n) es la lista de pares de enteros (x,y) tales que la suma

-- de los valores absolutos de x e y es igual a n. Por ejemplo,

-- λ> paresEnterosSuma 3

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

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

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

paresEnterosSuma n = concatMap aux [-n..n]

where aux k | m == 0 = [(k,0)]

| otherwise = [(k,-m),(k,m)]

where m = n - abs k

-- 2ª solución

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

-- Observando los siguientes cálculos:

-- take 6 (soluciones 2) == [(0,0),(-2,1),(1,-2),(4,4),(3,6),(6,3)]

-- take 6 (soluciones 3) == [(0,0),(-6,2),(2,-6),(6,6),(4,12),(12,4)]

-- take 6 (soluciones 5) == [(0,0),(10,10),(-20,4),(4,-20),(6,30),(30,6)]

-- take 6 (soluciones 7) == [(0,0),(14,14),(-42,6),(6,-42),(8,56),(56,8)]

-- take 6 (soluciones 11) == [(0,0),(22,22),(-110,10),(10,-110),(12,132),(132,12)]

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

soluciones2 2 = [(0,0),(-2,1),(1,-2),(4,4),(3,6),(6,3)]

soluciones2 3 = [(0,0),(-6,2),(2,-6),(6,6),(4,12),(12,4)]

soluciones2 p =

[(0,0), (2*p,2*p), (p*(1-p),p-1), (p-1,p*(1-p)), (p+1,p*(p+1)), (p*(p+1),p+1)]

-- Comparación de equivalencia

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

-- La propiedad es

prop_equivalencia :: Bool

prop_equivalencia =

and [ take 6 (soluciones p) == soluciones2 p

| p <- takeWhile (<= 37) primes]

-- La comprobación es

-- λ> prop_equivalencia

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> take 6 (soluciones 37)

-- [(0,0),(74,74),(-1332,36),(36,-1332),(38,1406),(1406,38)]

-- (3.88 secs, 2,521,196,352 bytes)

-- λ> take 6 (soluciones2 37)

-- [(0,0),(74,74),(-1332,36),(36,-1332),(38,1406),(1406,38)]

-- (0.01 secs, 144,192 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>

Ordenación de los pares de enteros

PorJosé A. Alonso 3-mayo-202110-mayo-2021

Los pares de números enteros se pueden ordenar por la suma de los valores absolutos de sus componentes. Los primeros pares en dicha ordenación son

   (0,0),
   (-1,0),(0,-1),(0,1),(1,0),
   (-2,0),(-1,-1),(-1,1),(0,-2),(0,2),(1,-1),(1,1),(2,0), ...

(0,0),

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

(-2,0),(-1,-1),(-1,1),(0,-2),(0,2),(1,-1),(1,1),(2,0), ...

Definir la lista

   pares :: [(Integer, Integer)]

1	pares :: [(Integer, Integer)]

cuyos elementos son los pares de números enteros con la ordenación anterior. Por ejemplo,

   λ> take 38 pares
   [(0,0),(-1,0),(0,-1),(0,1),(1,0),(-2,0),(-1,-1),(-1,1),(0,-2),
    (0,2),(1,-1),(1,1),(2,0),(-3,0),(-2,-1),(-2,1),(-1,-2),(-1,2),
    (0,-3),(0,3),(1,-2),(1,2),(2,-1),(2,1),(3,0),(-4,0),(-3,-1),
    (-3,1),(-2,-2),(-2,2),(-1,-3),(-1,3),(0,-4),(0,4),(1,-3),(1,3),
    (2,-2),(2,2)]

λ> take 38 pares

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

(0,2),(1,-1),(1,1),(2,0),(-3,0),(-2,-1),(-2,1),(-1,-2),(-1,2),

(0,-3),(0,3),(1,-2),(1,2),(2,-1),(2,1),(3,0),(-4,0),(-3,-1),

(-3,1),(-2,-2),(-2,2),(-1,-3),(-1,3),(0,-4),(0,4),(1,-3),(1,3),

(2,-2),(2,2)]

Soluciones

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

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

pares :: [(Integer, Integer)]
pares =
  concat [sort (concat [aux (x,n-x) | x <- [0..n]])
         | n <- [0..]]
  where
    aux (0,0) = [(0,0)]
    aux (0,y) = [(0,y), (0,-y)]
    aux (x,0) = [(x,0), (-x,0)]
    aux (x,y) = [(x,y), (-x,y), (x,-y), (-x,-y)]

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

pares2 :: [(Integer,Integer)]
pares2 = concatMap paresEnterosSuma [0..]

-- (paresEnterosSuma n) es la lista de pares de enteros (x,y) tales que la suma
-- de los valores absolutos de x e y es igual a n. Por ejemplo,
--    λ> paresEnterosSuma 3
--    [(-3,0),(-2,-1),(-2,1),(-1,-2),(-1,2),(0,-3),(0,3),(1,-2),(1,2),
--     (2,-1),(2,1),(3,0)]
paresEnterosSuma :: Integer -> [(Integer,Integer)]
paresEnterosSuma n = concatMap aux [-n..n]
  where aux k | m == 0    = [(k,0)]
              | otherwise = [(k,-m),(k,m)]
          where m = n - abs k

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

-- La propiedad es
prop_pares :: Int -> Property
prop_pares n =
  n >= 0 ==>
  pares !! n == pares2 !! n

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

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

-- La comparación es
--    λ> pares !! (10^7)
--    (304,-1932)
--    (9.15 secs, 11,031,475,520 bytes)
--    λ> pares2 !! (10^7)
--    (304,-1932)
--    (2.84 secs, 3,401,450,320 bytes)

import Data.List (sort)

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

-- 1ª solución

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

pares :: [(Integer, Integer)]

pares =

concat [sort (concat [aux (x,n-x) | x <- [0..n]])

| n <- [0..]]

where

aux (0,0) = [(0,0)]

aux (0,y) = [(0,y), (0,-y)]

aux (x,0) = [(x,0), (-x,0)]

aux (x,y) = [(x,y), (-x,y), (x,-y), (-x,-y)]

-- 2ª solución

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

pares2 :: [(Integer,Integer)]

pares2 = concatMap paresEnterosSuma [0..]

-- (paresEnterosSuma n) es la lista de pares de enteros (x,y) tales que la suma

-- de los valores absolutos de x e y es igual a n. Por ejemplo,

-- λ> paresEnterosSuma 3

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

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

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

paresEnterosSuma n = concatMap aux [-n..n]

where aux k | m == 0 = [(k,0)]

| otherwise = [(k,-m),(k,m)]

where m = n - abs k

-- Comprobación de equivalencia

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

-- La propiedad es

prop_pares :: Int -> Property

prop_pares n =

n >= 0 ==>

pares !! n == pares2 !! n

-- La comprobación es

-- λ> quickCheck prop_pares

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

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

-- (304,-1932)

-- (9.15 secs, 11,031,475,520 bytes)

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

-- (304,-1932)

-- (2.84 secs, 3,401,450,320 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>

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

— (0.17 secs, 103,957,288 bytes)

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico