Ejercicio

Potencias con mismos finales

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

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

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

Definir la función

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

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

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

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

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

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

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

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

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

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

take 3 (potenciasMismoFinales 1007) == [(1,21),(2,22),(3,23)]

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

take 3 (potenciasMismoFinales 1009) == [(1,51),(2,52),(3,53)]

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

Soluciones

potenciasMismoFinales :: Integer -> [(Integer,Integer)]
potenciasMismoFinales x =
   [(m,n) | (m,n) <- pares,
            x^m `mod` 1000 == x^n `mod` 1000]

-- pares el lista de pares de enteros positivos, con el primero menor que
-- el segundo, ordenados por su suma y primer elemento. Por ejemplo,
--    λ> take 10 pares
--    [(1,2),(1,3),(1,4),(2,3),(1,5),(2,4),(1,6),(2,5),(3,4),(1,7)]
pares :: [(Integer,Integer)]
pares = [(m,n) | x <- [1..],
                 m <- [1..x],
                 let n = x-m,
                 n > m]

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

-- El cálculo es
--    λ> head (potenciasMismoFinales 1978)
--    (3,103)

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

potenciasMismoFinales x =

[(m,n) | (m,n) <- pares,

x^m `mod` 1000 == x^n `mod` 1000]

-- pares el lista de pares de enteros positivos, con el primero menor que

-- el segundo, ordenados por su suma y primer elemento. Por ejemplo,

-- λ> take 10 pares

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

pares :: [(Integer,Integer)]

pares = [(m,n) | x <- [1..],

m <- [1..x],

let n = x-m,

n > m]

-- Cálculo de la respuesta

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

-- El cálculo es

-- λ> head (potenciasMismoFinales 1978)

-- (3,103)

Nuevas soluciones

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

Mayor producto con sumandos de la descomposición

PorJosé A. Alonso 31-mayo-202126-enero-2022

El enunciado del 4º problema para la IMO (Olimpiada Internacional de Matemáticas) de 1976 es

Calcular el mayor número que se puede obtener multiplicando los enteros positivos cuya suma es 1976.

Definir la función

   mayorProductoSumandos :: Integer -> Integer

1	mayorProductoSumandos :: Integer -> Integer

tal que (mayorProductoSumandos n) el mayor número que se puede obtener multiplicando los enteros positivos cuya suma es n. Por ejemplo,

   mayorProductoSumandos 5 == 6

1	mayorProductoSumandos 5 == 6

ya que los posibles listas de sumandos con suma 5 son

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

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

sus productos son

   5,   6,     4,     4,       3,       2,         1

1	5, 6, 4, 4, 3, 2, 1

y el mayor de dichos productos es 6.

Otros ejemplos son

   mayorProductoSumandos 10   ==  36
   mayorProductoSumandos 100  ==  7412080755407364
   length (show (mayorProductoSumandos (10^8)))  ==  15904042

mayorProductoSumandos 10 == 36

mayorProductoSumandos 100 == 7412080755407364

length (show (mayorProductoSumandos (10^8))) == 15904042

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

Soluciones

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

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

mayorProductoSumandos :: Integer -> Integer
mayorProductoSumandos n =
  maximum [product xs | xs <- sumandos n]

-- (sumandos n) es la lista de las descomposiciones de n
-- como suma de números naturales. Por ejemplo,
--    sumandos 3  ==  [[3],[1,2],[1,1,1],[2,1]]
sumandos :: Integer -> [[Integer]]
sumandos 1 = [[1]]
sumandos n =
  [n]: [n-x:ys | x <- [1..n-1], ys <- sumandos x, n-x <= head ys]

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

mayorProductoSumandos2 :: Integer -> Integer
mayorProductoSumandos2 n
  | n < 5     = n
  | otherwise = maximum [(n-i) * mayorProductoSumandos2 i
                        | i <- [1..n-1]]

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

-- Observando los siguientes cálculos
--    λ> [mayorProductoSumandos n | n <- [0..20]]
--    [0,1,2,3,4,6,9,12,18,27,36,54,81,108,162,243,324,486,729,972,1458]
--    λ> [mayorProductoSumandos n | n <- [0,3..20]]
--    [0,3,9,27,81,243,729]
--    λ> [mayorProductoSumandos n | n <- [1,4..20]]
--    [1,4,12,36,108,324,972]
--    λ> [mayorProductoSumandos n | n <- [2,5..20]]
--    [2,6,18,54,162,486,1458]

mayorProductoSumandos3 :: Integer -> Integer
mayorProductoSumandos3 n
  | n < 5     = n
  | otherwise = 3 * mayorProductoSumandos3 (n-3)

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

-- (factorizacion n) es la descomposición de n en factores primos como
-- una lista de pares donde los primeros elementos son la base y los
-- segundo son los exponentes. Por ejemplo,
--    factorizacion 3000  ==  [(2,3),(3,1),(5,3)]
-- ya que 3000 = 2^3*3*5^3
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
  [(head xs,genericLength xs) | xs <- group (primeFactors n)]

-- Observando los siguientes cálculos
--    λ> [factorizacion (mayorProductoSumandos3 n) | n <- [3,6..20]]
--    [[(3,1)],[(3,2)],[(3,3)],[(3,4)],[(3,5)],[(3,6)]]
--    λ> [factorizacion (mayorProductoSumandos3 n) | n <- [4,7..20]]
--    [[(2,2)],[(2,2),(3,1)],[(2,2),(3,2)],[(2,2),(3,3)],[(2,2),(3,4)],[(2,2),(3,5)]]
--    λ> [factorizacion (mayorProductoSumandos3 n) | n <- [5,8..20]]
--    [[(2,1),(3,1)],[(2,1),(3,2)],[(2,1),(3,3)],[(2,1),(3,4)],[(2,1),(3,5)],[(2,1),(3,6)]]

mayorProductoSumandos4 :: Integer -> Integer
mayorProductoSumandos4 n
    | n < 5     = n
    | otherwise = case r of
                    0 -> 3^q
                    1 -> 4*3^(q-1)
                    2 -> 2*3^q
  where (q,r) = quotRem n 3

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

-- Para los primeros valores la propiedad es
prop_equivalencia1 :: Integer -> Bool
prop_equivalencia1 n =
  and [f k == mayorProductoSumandos4 k
      | k <- [0..n],
        f <- [mayorProductoSumandos,
              mayorProductoSumandos2,
              mayorProductoSumandos3]]

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

-- Para los grandes valores la propiedad es
prop_equivalencia2 :: Integer -> Property
prop_equivalencia2 n =
  n >= 0 ==>
  mayorProductoSumandos3 n == mayorProductoSumandos4 n

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

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

-- La comparación es
--    λ> mayorProductoSumandos 22
--    2916
--    (2.99 secs, 2,319,928,184 bytes)
--    λ> mayorProductoSumandos2 22
--    2916
--    (0.47 secs, 313,625,800 bytes)
--    λ> mayorProductoSumandos3 22
--    2916
--    (0.01 secs, 103,864 bytes)
--    λ> mayorProductoSumandos4 22
--    2916
--    (0.01 secs, 102,712 bytes)
--
--    λ> mayorProductoSumandos2 25
--    8748
--    (3.26 secs, 2,508,295,368 bytes)
--    λ> mayorProductoSumandos3 25
--    8748
--    (0.00 secs, 103,960 bytes)
--    λ> mayorProductoSumandos4 25
--    8748
--    (0.00 secs, 102,856 bytes)
--
--    λ> length (show (mayorProductoSumandos3 (10^6)))
--    159041
--    (9.83 secs, 11,400,807,392 bytes)
--    λ> length (show (mayorProductoSumandos4 (10^6)))
--    159041
--    (0.03 secs, 10,082,080 bytes)
--
--    λ> length (show (mayorProductoSumandos4 (10^8)))
--    15904042
--    (3.53 secs, 1,022,783,472 bytes)

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

-- El cálculo es
--    λ> mayorProductoSumandos4 1976
--    176528813092650631321824697527678863603414507360733532172646534742
--    374472004561447647833551576599071841268147340684692909561979543969
--    046876247215728742219795875277856143555895806750102055076974383708
--    360617266962123284615873951950033196388833843896325045289546019012
--    398784375461116652095995292235273337590912307103378
--    λ> factorizacion (mayorProductoSumandos4 1976)
--    [(2,1),(3,658)]
--    λ> mayorProductoSumandos3 1976 == 2*3^658
--    True

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

import Data.Numbers.Primes (primeFactors)

import Data.List (genericLength, group)

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

-- 1ª solución

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

mayorProductoSumandos :: Integer -> Integer

mayorProductoSumandos n =

maximum [product xs | xs <- sumandos n]

-- (sumandos n) es la lista de las descomposiciones de n

-- como suma de números naturales. Por ejemplo,

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

sumandos :: Integer -> [[Integer]]

sumandos 1 = [[1]]

sumandos n =

[n]: [n-x:ys | x <- [1..n-1], ys <- sumandos x, n-x <= head ys]

-- 2ª solución

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

mayorProductoSumandos2 :: Integer -> Integer

mayorProductoSumandos2 n

| n < 5 = n

| otherwise = maximum [(n-i) * mayorProductoSumandos2 i

| i <- [1..n-1]]

-- 3ª solución

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

-- Observando los siguientes cálculos

-- λ> [mayorProductoSumandos n | n <- [0..20]]

-- [0,1,2,3,4,6,9,12,18,27,36,54,81,108,162,243,324,486,729,972,1458]

-- λ> [mayorProductoSumandos n | n <- [0,3..20]]

-- [0,3,9,27,81,243,729]

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

-- [1,4,12,36,108,324,972]

-- λ> [mayorProductoSumandos n | n <- [2,5..20]]

-- [2,6,18,54,162,486,1458]

mayorProductoSumandos3 :: Integer -> Integer

mayorProductoSumandos3 n

| n < 5 = n

| otherwise = 3 * mayorProductoSumandos3 (n-3)

-- 4ª solución

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

-- (factorizacion n) es la descomposición de n en factores primos como

-- una lista de pares donde los primeros elementos son la base y los

-- segundo son los exponentes. Por ejemplo,

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

-- ya que 3000 = 2^3*3*5^3

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

factorizacion n =

[(head xs,genericLength xs) | xs <- group (primeFactors n)]

-- Observando los siguientes cálculos

-- λ> [factorizacion (mayorProductoSumandos3 n) | n <- [3,6..20]]

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

-- λ> [factorizacion (mayorProductoSumandos3 n) | n <- [4,7..20]]

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

-- λ> [factorizacion (mayorProductoSumandos3 n) | n <- [5,8..20]]

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

mayorProductoSumandos4 :: Integer -> Integer

mayorProductoSumandos4 n

| n < 5 = n

| otherwise = case r of

0 -> 3^q

1 -> 4*3^(q-1)

2 -> 2*3^q

where (q,r) = quotRem n 3

-- Comprobación de equivalencia

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

-- Para los primeros valores la propiedad es

prop_equivalencia1 :: Integer -> Bool

prop_equivalencia1 n =

and [f k == mayorProductoSumandos4 k

| k <- [0..n],

f <- [mayorProductoSumandos,

mayorProductoSumandos2,

mayorProductoSumandos3]]

-- La comprobación es

-- λ> prop_equivalencia1 20

-- True

-- Para los grandes valores la propiedad es

prop_equivalencia2 :: Integer -> Property

prop_equivalencia2 n =

n >= 0 ==>

mayorProductoSumandos3 n == mayorProductoSumandos4 n

-- La comprobación es

-- λ> quickCheck prop_equivalencia2

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> mayorProductoSumandos 22

-- 2916

-- (2.99 secs, 2,319,928,184 bytes)

-- λ> mayorProductoSumandos2 22

-- 2916

-- (0.47 secs, 313,625,800 bytes)

-- λ> mayorProductoSumandos3 22

-- 2916

-- (0.01 secs, 103,864 bytes)

-- λ> mayorProductoSumandos4 22

-- 2916

-- (0.01 secs, 102,712 bytes)

-- λ> mayorProductoSumandos2 25

-- 8748

-- (3.26 secs, 2,508,295,368 bytes)

-- λ> mayorProductoSumandos3 25

-- 8748

-- (0.00 secs, 103,960 bytes)

-- λ> mayorProductoSumandos4 25

-- 8748

-- (0.00 secs, 102,856 bytes)

-- λ> length (show (mayorProductoSumandos3 (10^6)))

-- 159041

-- (9.83 secs, 11,400,807,392 bytes)

-- λ> length (show (mayorProductoSumandos4 (10^6)))

-- 159041

-- (0.03 secs, 10,082,080 bytes)

-- λ> length (show (mayorProductoSumandos4 (10^8)))

-- 15904042

-- (3.53 secs, 1,022,783,472 bytes)

-- Cálculo de la respuesta al problema

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

-- El cálculo es

-- λ> mayorProductoSumandos4 1976

-- 176528813092650631321824697527678863603414507360733532172646534742

-- 374472004561447647833551576599071841268147340684692909561979543969

-- 046876247215728742219795875277856143555895806750102055076974383708

-- 360617266962123284615873951950033196388833843896325045289546019012

-- 398784375461116652095995292235273337590912307103378

-- λ> factorizacion (mayorProductoSumandos4 1976)

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

-- λ> mayorProductoSumandos3 1976 == 2*3^658

-- True

Nuevas soluciones

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

Múltiplos sin ceros

PorJosé A. Alonso 28-mayo-20214-junio-2021

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

Demostrar que cada n ≢ 0 (mod 10) posee algún múltiplo sin el dígito 0.

Definir la función

   multiplosSinCeros :: Integer -> [Integer]

1	multiplosSinCeros :: Integer -> [Integer]

tal que (multiplosSinCeros n) es la lista de los múltiplos de n sin el dígito 0. Por ejemplo,

   λ> take 10 (multiplosSinCeros 101)
   [1111,1212,1313,1414,1515,1616,1717,1818,1919,2121]

1 2	λ> take 10 (multiplosSinCeros 101) [1111,1212,1313,1414,1515,1616,1717,1818,1919,2121]

Comprobar con QuickCheck que si n es un número entero positivo no divisible por 10, entonces n posee algún múltiplo sin el dígito 0.

Soluciones

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

multiplosSinCeros :: Integer -> [Integer]
multiplosSinCeros n =
  filter sinCeros [n,2*n..]

sinCeros :: Integer -> Bool
sinCeros n =
  '0' `notElem` show n

-- La propiedad es
prop_multiplosSinCeros :: Integer -> Property
prop_multiplosSinCeros n =
  n > 0 && n `mod` 10 /= 0 ==>
  not (null (multiplosSinCeros n))

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

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

multiplosSinCeros :: Integer -> [Integer]

multiplosSinCeros n =

filter sinCeros [n,2*n..]

sinCeros :: Integer -> Bool

sinCeros n =

'0' `notElem` show n

-- La propiedad es

prop_multiplosSinCeros :: Integer -> Property

prop_multiplosSinCeros n =

n > 0 && n `mod` 10 /= 0 ==>

not (null (multiplosSinCeros n))

-- La comprobación es

-- λ> quickCheck prop_multiplosSinCeros

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Sumas con signos

PorJosé A. Alonso 27-mayo-20213-junio-2021

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

Sean x1, x2, x3, x4, x5, x6 enteros no divisibles por 7. Demostrar que alguna de las sumas

±x1 ± x2 ± x3 ± x4 ± x5 ± x6

es divisible por 7, donde los signos se seleccionan de todas las manera posibles. (Generalizar la propiedad para todos los primos).

Definir la función

   sumas :: [Integer] -> [Integer]

1	sumas :: [Integer] -> [Integer]

tal que (sumas xs) es la lista de los valores de las sumas

   ±x(1) ± x(2) ± ··· ± x(n)

1	±x(1) ± x(2) ± ··· ± x(n)

donde [x(1),x(2),…,x(n)] = xs y los signos se seleccionan de todas las manera posibles. Por ejemplo,

   sort (sumas [3])      ==  [-3,3]
   sort (sumas [2,3])    ==  [-5,-1,1,5]
   sort (sumas [1,2,3])  ==  [-6,-4,-2,0,2,4,6]

sort (sumas [3]) == [-3,3]

sort (sumas [2,3]) == [-5,-1,1,5]

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

Comprobar con QuickCheck que para todo número primo impar p y toda lista xs de longitud (p-1) de elementos no divisibles por p se verifica que la lista (sumas xs) tiene algún elemento divisible por p.

Soluciones

import Data.List (sort)
import Test.QuickCheck (Positive(..), Property, Gen,
                        arbitrary, forAll, sample, suchThat)
import Data.Numbers.Primes (primes)

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

sumas :: [Integer] -> [Integer]
sumas ns = map sum (expresiones ns)

-- (expresiones xs) es la lista de las expresiones de la forma
--    ±x(1) ± x(2) ± ··· ± x(n)
-- donde [x(1),x(2),...,x(n)] = xs y los signos se seleccionan de todas
-- las manera posibles. Por ejemplo,
--    λ> expresiones [3]
--    [[3],[-3]]
--    λ> expresiones [2,3]
--    [[2,3],[2,-3],[-2,3],[-2,-3]]
--    λ> expresiones [1,2,3]
--    [[1, 2,3],[1, 2,-3],[1, -2,3],[1, -2,-3],
--     [-1,2,3],[-1,2,-3],[-1,-2,3],[-1,-2,-3]]
expresiones :: [Integer] -> [[Integer]]
expresiones []     = [[]]
expresiones (n:ns) = [x:xs | x <- [n,-n], xs <- expresiones ns]

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

sumas2 :: [Integer] -> [Integer]
sumas2 ns = map snd (expresiones2 ns)

-- (expresiones2 xs) es la lista de las expresiones, junto con sus
-- sumas, de la forma
--    ±x(1) ± x(2) ± ··· ± x(n)
-- donde [x(1),x(2),...,x(n)] = xs y los signos se seleccionan de todas
-- las manera posibles. Por ejemplo,
--    λ> expresiones2 [3]
--    [([3],3),([-3],-3)]
--    λ> expresiones2 [2,3]
--    [([2,3],5),([2,-3],-1),([-2,3],1),([-2,-3],-5)]
--    λ> expresiones2 [1,2,3]
--    [([1,2,3],6),([1,2,-3],0),([1,-2,3],2),([1,-2,-3],-4),
--     ([-1,2,3],4),([-1,2,-3],-2),([-1,-2,3],0),([-1,-2,-3],-6)]
expresiones2 :: [Integer] -> [([Integer],Integer)]
expresiones2 []     = [([],0)]
expresiones2 (n:ns) = [(x:xs,x+m) | x <- [n,-n], (xs,m) <- expresiones2 ns]

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

-- La propiedad es
prop_equiv :: [Integer] -> Bool
prop_equiv xs =
  sumas ys == sumas2 ys
  where ys = take 10 xs

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

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

-- La comparación es
--    λ> length (sumas [1..20])
--    1048576
--    (2.18 secs, 3,095,500,560 bytes)
--    λ> length (sumas2 [1..20])
--    1048576
--    (3.17 secs, 4,647,393,392 bytes)

-- Comprobación de la propiedad
-- ============================

-- La propiedad es
prop_sumas :: (Positive Int) -> Property
prop_sumas (Positive n) =
  forAll (listaNoDivisibles p (p-1)) (tieneSumaMultiplo p)
  where p = primes !! n

-- (listaNoDivisibles p n) es un generador de listas de longitud n cuyos
-- elementos son son divisibles por p. Por ejemplo,
--    λ> sample (listaNoDivisibles 5 4)
--    [1,-1,1,-1]
--    [2,-2,-2,-2]
--    [3,-3,-2,2]
--    [4,4,-4,-4]
--    [1,8,8,1]
--    [-4,-3,3,2]
--    [8,-7,8,-13]
--    [-4,-12,-13,11]
--    [1,2,-12,-8]
--    [-4,-16,7,7]
--    [16,-17,16,-7]
listaNoDivisibles :: Integer -> Integer -> Gen [Integer]
listaNoDivisibles _ 0 = return []
listaNoDivisibles p n = do
  x <- suchThat arbitrary (\i -> i `mod` p /= 0)
  xs <- listaNoDivisibles p (n-1)
  return (x:xs)

-- (tieneSumaMultiplo n xs) se verifica si algún elemento de (sumas xs)
-- es un múltiplo de n. Por ejemplo,
--    tieneSumaMultiplo 5 [2,3]  ==  True
--    tieneSumaMultiplo 4 [2,3]  ==  False
tieneSumaMultiplo n xs =
  or [s `mod` n == 0 | s <- sumas xs]

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

100

101

102

103

104

105

106

107

108

109

110

111

112

import Data.List (sort)

import Test.QuickCheck (Positive(..), Property, Gen,

arbitrary, forAll, sample, suchThat)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

sumas :: [Integer] -> [Integer]

sumas ns = map sum (expresiones ns)

-- (expresiones xs) es la lista de las expresiones de la forma

-- ±x(1) ± x(2) ± ··· ± x(n)

-- donde [x(1),x(2),...,x(n)] = xs y los signos se seleccionan de todas

-- las manera posibles. Por ejemplo,

-- λ> expresiones [3]

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

-- λ> expresiones [2,3]

-- [[2,3],[2,-3],[-2,3],[-2,-3]]

-- λ> expresiones [1,2,3]

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

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

expresiones :: [Integer] -> [[Integer]]

expresiones [] = [[]]

expresiones (n:ns) = [x:xs | x <- [n,-n], xs <- expresiones ns]

-- 2ª solución

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

sumas2 :: [Integer] -> [Integer]

sumas2 ns = map snd (expresiones2 ns)

-- (expresiones2 xs) es la lista de las expresiones, junto con sus

-- sumas, de la forma

-- ±x(1) ± x(2) ± ··· ± x(n)

-- donde [x(1),x(2),...,x(n)] = xs y los signos se seleccionan de todas

-- las manera posibles. Por ejemplo,

-- λ> expresiones2 [3]

-- [([3],3),([-3],-3)]

-- λ> expresiones2 [2,3]

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

-- λ> expresiones2 [1,2,3]

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

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

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

expresiones2 [] = [([],0)]

expresiones2 (n:ns) = [(x:xs,x+m) | x <- [n,-n], (xs,m) <- expresiones2 ns]

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equiv :: [Integer] -> Bool

prop_equiv xs =

sumas ys == sumas2 ys

where ys = take 10 xs

-- La comprobación es

-- λ> quickCheck prop_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (sumas [1..20])

-- 1048576

-- (2.18 secs, 3,095,500,560 bytes)

-- λ> length (sumas2 [1..20])

-- 1048576

-- (3.17 secs, 4,647,393,392 bytes)

-- Comprobación de la propiedad

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

-- La propiedad es

prop_sumas :: (Positive Int) -> Property

prop_sumas (Positive n) =

forAll (listaNoDivisibles p (p-1)) (tieneSumaMultiplo p)

where p = primes !! n

-- (listaNoDivisibles p n) es un generador de listas de longitud n cuyos

-- elementos son son divisibles por p. Por ejemplo,

-- λ> sample (listaNoDivisibles 5 4)

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

-- [2,-2,-2,-2]

-- [3,-3,-2,2]

-- [4,4,-4,-4]

-- [1,8,8,1]

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

-- [8,-7,8,-13]

-- [-4,-12,-13,11]

-- [1,2,-12,-8]

-- [-4,-16,7,7]

-- [16,-17,16,-7]

listaNoDivisibles :: Integer -> Integer -> Gen [Integer]

listaNoDivisibles _ 0 = return []

listaNoDivisibles p n = do

x <- suchThat arbitrary (\i -> i `mod` p /= 0)

xs <- listaNoDivisibles p (n-1)

return (x:xs)

-- (tieneSumaMultiplo n xs) se verifica si algún elemento de (sumas xs)

-- es un múltiplo de n. Por ejemplo,

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

-- tieneSumaMultiplo 4 [2,3] == False

tieneSumaMultiplo n xs =

or [s `mod` n == 0 | s <- sumas xs]

-- La comprobación es

-- λ> quickCheck prop_sumas

-- +++ OK, passed 100 tests.

Nuevas soluciones

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

Números divisibles respecto de una sucesión

PorJosé A. Alonso 26-mayo-20212-junio-2021

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

Sean a(0), a(1), …, a(n) (con n ≥ 1) números enteros positivos. Encontrar todos los números enteros y tales que

a(0) | y; (a(0)+a(1)) | (y+a(1)); … ; (a(0)+a(n)) | (y+a(n)).

donde «x | y» significa que «y es divisible por x».

Se dice que un número y es divisible respecto de la sucesión a(0), a(1), …, a(n) si verifica la propiedad anterior; es decir,

      a(0) | y; (a(0)+a(1)) | (y+a(1)); ... ; (a(0)+a(n)) | (y+a(n)).

1	a(0) \| y; (a(0)+a(1)) \| (y+a(1)); ... ; (a(0)+a(n)) \| (y+a(n)).

Definir la función

   divisiblesSucesion :: [Integer] -> [Integer]

1	divisiblesSucesion :: [Integer] -> [Integer]

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

   take 6 (divisiblesSucesion [2,5,3])     ==  [2,72,142,212,282,352]
   divisiblesSucesion [3,5..30] !! (10^5)  ==  144144000003
   divisiblesSucesion [3,5..30] !! (10^6)  ==  1441440000003
   divisiblesSucesion [3,5..30] !! (10^7)  ==  14414400000003

take 6 (divisiblesSucesion [2,5,3]) == [2,72,142,212,282,352]

divisiblesSucesion [3,5..30] !! (10^5) == 144144000003

divisiblesSucesion [3,5..30] !! (10^6) == 1441440000003

divisiblesSucesion [3,5..30] !! (10^7) == 14414400000003

Soluciones

import Test.QuickCheck (quickCheck)

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

divisiblesSucesion :: [Integer] -> [Integer]
divisiblesSucesion xs =
  filter (esDivisibleSucesion xs) [1..]

-- (esDivisibleSucesion xs y) se verifica si y es divisible respecto de
-- la sucesión xs. Por ejemplo,
--    esDivisibleSucesion [2,5,3] 72  ==  True
--    esDivisibleSucesion [2,5,3] 12  ==  False
esDivisibleSucesion :: [Integer] -> Integer -> Bool
esDivisibleSucesion [] _      = True
esDivisibleSucesion (a0:as) y =
  y `mod` a0 == 0 &&
  and [(y+a) `mod` (a0+a) == 0 | a <- as]

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

-- En los siguientes cálculos
--    λ> take 5 (divisiblesSucesion [2,3,5])
--    [2,72,142,212,282]
--    λ> foldl1 lcm [2, 2+3, 2+5]
--    70
--    λ> take 5 (divisiblesSucesion [2,3,5,6])
--    [2,282,562,842,1122]
--    λ> foldl1 lcm [2, 2+3, 2+5, 2+6]
--    280
--    λ> take 5 (divisiblesSucesion [1,3,5,6])
--    [1,85,169,253,337]
--    λ> foldl1 lcm [1, 1+3, 1+5, 1+6]
--    84
-- se observa que los resultados son progresiones aritméticas cuyo
-- primer elemento es a(0) y la diferencia es el mínimo común múltiplo
-- de [a(0), a(0)+a(1), a(0)+a(2), ..., a(0)+a(n)]

divisiblesSucesion2 :: [Integer] -> [Integer]
divisiblesSucesion2 []      = [1..]
divisiblesSucesion2 (a0:as) = [a0,a0+m..]
  where m = mcm (a0 : [a0+a | a <- as])

-- (mcm xs) es el mínimo común múltiplo de xs. Por ejemplo,
--    mcm [2,5,3]  ==  30
--    mcm [2,2+5,2+3]  ==  70
mcm :: [Integer] -> Integer
mcm = foldl1 lcm

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

-- La propiedad es
prop_equivalencia :: [Integer] -> Bool
prop_equivalencia  xs =
  take 3 (divisiblesSucesion ys) == take 3 (divisiblesSucesion2 ys)
  where ys = take 5 [1 + (x `mod` 10) | x <- xs]

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

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

-- La comparación es
--    λ> divisiblesSucesion [3,5..30] !! 20
--    28828803
--    (16.86 secs, 15,933,990,784 bytes)
--    λ> divisiblesSucesion2 [3,5..30] !! 20
--    28828803
--    (0.01 secs, 112,496 bytes)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

divisiblesSucesion :: [Integer] -> [Integer]

divisiblesSucesion xs =

filter (esDivisibleSucesion xs) [1..]

-- (esDivisibleSucesion xs y) se verifica si y es divisible respecto de

-- la sucesión xs. Por ejemplo,

-- esDivisibleSucesion [2,5,3] 72 == True

-- esDivisibleSucesion [2,5,3] 12 == False

esDivisibleSucesion :: [Integer] -> Integer -> Bool

esDivisibleSucesion [] _ = True

esDivisibleSucesion (a0:as) y =

y `mod` a0 == 0 &&

and [(y+a) `mod` (a0+a) == 0 | a <- as]

-- 2ª solución

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

-- En los siguientes cálculos

-- λ> take 5 (divisiblesSucesion [2,3,5])

-- [2,72,142,212,282]

-- λ> foldl1 lcm [2, 2+3, 2+5]

-- 70

-- λ> take 5 (divisiblesSucesion [2,3,5,6])

-- [2,282,562,842,1122]

-- λ> foldl1 lcm [2, 2+3, 2+5, 2+6]

-- 280

-- λ> take 5 (divisiblesSucesion [1,3,5,6])

-- [1,85,169,253,337]

-- λ> foldl1 lcm [1, 1+3, 1+5, 1+6]

-- 84

-- se observa que los resultados son progresiones aritméticas cuyo

-- primer elemento es a(0) y la diferencia es el mínimo común múltiplo

-- de [a(0), a(0)+a(1), a(0)+a(2), ..., a(0)+a(n)]

divisiblesSucesion2 :: [Integer] -> [Integer]

divisiblesSucesion2 [] = [1..]

divisiblesSucesion2 (a0:as) = [a0,a0+m..]

where m = mcm (a0 : [a0+a | a <- as])

-- (mcm xs) es el mínimo común múltiplo de xs. Por ejemplo,

-- mcm [2,5,3] == 30

-- mcm [2,2+5,2+3] == 70

mcm :: [Integer] -> Integer

mcm = foldl1 lcm

-- Comprobación de equivalencia

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

-- La propiedad es

prop_equivalencia :: [Integer] -> Bool

prop_equivalencia xs =

take 3 (divisiblesSucesion ys) == take 3 (divisiblesSucesion2 ys)

where ys = take 5 [1 + (x `mod` 10) | x <- xs]

-- La comprobación es

-- λ> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> divisiblesSucesion [3,5..30] !! 20

-- 28828803

-- (16.86 secs, 15,933,990,784 bytes)

-- λ> divisiblesSucesion2 [3,5..30] !! 20

-- 28828803

-- (0.01 secs, 112,496 bytes)

Nuevas soluciones

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

Potencias con mismos finales

Soluciones

Nuevas soluciones

Mayor producto con sumandos de la descomposición

Soluciones

Nuevas soluciones

Múltiplos sin ceros

Soluciones

Nuevas soluciones

Sumas con signos

Soluciones

Nuevas soluciones

Números divisibles respecto de una sucesión

Soluciones

Nuevas soluciones

Entradas recientes

Buscar

Correo electrónico