Productos de sumas de progresiones aritméticas
El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1978 es
Para cada número entero d ≥ 1, sea M(d) el conjunto de todos enteros positivos que no se pueden escribir como una suma de una progresión aritmética de diferencia d, teniendo al menos dos sumandos y formadas por enteros positivos. Sean A = M(1), B = M(2)-{2} y C = M(3). Demostrar que todo c ∈ C se puede escribir de una única manera como c = ab con a ∈ A, b ∈ B.
Definir las funciones
1 2 3 4 |
conjuntoA :: [Integer] conjuntoB :: [Integer] conjuntoC :: [Integer] productosAB :: Integer -> [(Integer,Integer)] |
tales que
- conjuntoA es la lista de los elementos del conjunto A; es decir, de los números que no se pueden escribir como sumas de progresiones aritméticas de diferencia uno, con al menos dos términos, de números enteros positivos. Por ejemplo,
1 2 |
conjuntoA !! 2 == 4 length (show (conjuntoA !! (10^7))) == 3010300 |
- conjuntoB es la lista de los elementos del conjunto B; es decir, los números (distintos de dos) que no se pueden escribir como sumas de progresiones aritméticas de diferencia dos, con al menos dos términos, de números enteros positivos. Por ejemplo,
1 2 |
conjuntoB !! 3 == 5 conjuntoB !! (10^6) == 15485863 |
- conjuntoC es la lista de los elementos del conjunto C; es decir, los números que no se pueden escribir como sumas de progresiones aritméticas de diferencia tres, con al menos dos términos, de números enteros positivos. Por ejemplo,
1 |
conjuntoC !! 4 == 6 |
- (productosAB x) es la lista de los pares (a,b) tales que a es un elementos del conjunto A, b es un elemento del conjunto B y su producto es x. Por ejemplo,
1 2 |
productosAB 10 == [(2,5)] productosAB 15 == [] |
Comprobar con QuickCheck la propiedad del problema de la Olimpiada; es decir, para todo c ∈ C la lista (productosAB c) tiene exactamente un elemento.
Soluciones
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 |
import Data.List (foldr1) import Data.Numbers.Primes (primes,primeFactors) import Test.QuickCheck -- Nota: Se usarán las funciones definidas en los ejercicios -- anteriores. conjuntoA :: [Integer] conjuntoA = [2^k | k <- [0..]] conjuntoB :: [Integer] conjuntoB = 1 : tail primes conjuntoC :: [Integer] conjuntoC = noSonSumasDePADeDiferencia 3 noSonSumasDePADeDiferencia :: Integer -> [Integer] noSonSumasDePADeDiferencia d = diferencia [1..] (sonSumasDePADeDiferencia d) sonSumasDePADeDiferencia :: Integer -> [Integer] sonSumasDePADeDiferencia d = mezclaTodas [sumasDePADeDiferencia d a | a <- [1..]] sumasDePADeDiferencia :: Integer -> Integer -> [Integer] sumasDePADeDiferencia d a = tail (scanl1 (+) [a,a+d..]) mezclaTodas :: Ord a => [[a]] -> [a] mezclaTodas = foldr1 xmezcla where xmezcla (x:xs) ys = x : mezcla xs ys mezcla :: Ord a => [a] -> [a] -> [a] mezcla (x:xs) (y:ys) | x < y = x : mezcla xs (y:ys) | x == y = x : mezcla xs ys | x > y = y : mezcla (x:xs) ys diferencia :: [Integer] -> [Integer] -> [Integer] diferencia (x:xs) (y:ys) | x == y = diferencia xs ys | otherwise = x : diferencia xs (y:ys) productosAB :: Integer -> [(Integer,Integer)] productosAB c = [(a,b) | a <- takeWhile (<= c) conjuntoA, c `mod` a == 0, let b = c `div` a, b `pertenece` conjuntoB] pertenece :: Integer -> [Integer] -> Bool pertenece x ys = x == head (dropWhile (< x) ys) -- La propiedad es prop_productosAB :: Int -> Property prop_productosAB k = k >= 0 ==> length (productosAB (conjuntoC !! k)) == 1 -- La comprobación es -- λ> quickCheck prop_productosAB -- +++ OK, passed 100 tests. |
Nuevas soluciones
- En los comentarios se pueden escribir nuevas soluciones.
- El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>