Menu Close

Etiqueta: length

Factorizaciones de 4n+1

Sea S el conjunto

   S = {1, 5, 9, 13, 17, 21, 25, 29, 33, 37, 41, 45, ...}

de los enteros positivos congruentes con 1 módulo 4; es decir,

   S = {4n+1 | n ∈ N}

Un elemento n de S es irreducible si sólo es divisible por dos elementos de S: 1 y n. Por ejemplo, 9 es irreducible; pero 45 no lo es (ya que es el proctos de 5 y 9 que son elementos de S).

Definir las funciones

   esIrreducible :: Integer -> Bool
   factorizaciones :: Integer -> [[Integer]]
   conFactorizacionNoUnica :: [Integer]

tales que

  • (esIrreducible n) se verifica si n es irreducible. Por ejemplo,
     esIrreducible 9   ==  True
     esIrreducible 45  ==  False
  • (factorizaciones n) es la lista de conjuntos de elementos irreducibles de S cuyo producto es n. Por ejemplo,
     factorizaciones 9     ==  [[9]]
     factorizaciones 693   ==  [[9,77],[21,33]]
     factorizaciones 4389  ==  [[21,209],[33,133],[57,77]]
     factorizaciones 2205  ==  [[5,9,49],[5,21,21]]
  • conFactorizacionNoUnica es la lista de elementos de S cuya factorización no es única. Por ejemplo,
     λ> take 10 conFactorizacionNoUnica
     [441,693,1089,1197,1449,1617,1881,1953,2205,2277]

Soluciones

esIrreducible :: Integer -> Bool
esIrreducible n = divisores n == [1,n]
 
-- (divisores n) es el conjunto de elementos de S que dividen a n. Por
-- ejemplo, 
--    divisores 9    ==  [9]
--    divisores 693  ==  [9,21,33,77,693]
divisores :: Integer -> [Integer]
divisores n = [x | x <- [1,5..n], n `mod` x == 0] 
 
factorizaciones :: Integer -> [[Integer]]
factorizaciones 1 = [[1]]
factorizaciones n
  | esIrreducible n = [[n]]
  | otherwise       = [d:ds | d <- divisores n
                            , esIrreducible d
                            , ds@(e:_) <- factorizaciones (n `div` d)
                            , d <= e]
 
conFactorizacionNoUnica :: [Integer]
conFactorizacionNoUnica =
  [n | n <- [1,5..], length (factorizaciones n) > 1]

Pensamiento

¡Qué bien los nombres ponía
quien puso Sierra Morena
a esta serranía!

Antonio Machado

Conjuntos con más sumas que restas

Dado un conjunto de números naturales, por ejemplo A = {0, 2, 3, 4}, calculamos las sumas de todos los pares de elementos de A. Como A tiene 4 elementos hay 16 pares, pero no todas sus sumas son distintas. En este caso solo hay 8 sumas distintas: {0, 2, 3, 4, 5, 6, 7, 8}. Procediendo análogamente hay 9 diferencias distinatas entre los pares de A: {-4, -3, -2, -1, 0, 1, 2, 3, 4}.

Experimentando con más conjuntos, se puede conjeturar que el número de restas es mayor que el de sumas y argumentar que que mientras que con dos números distintos sólo se produce una suma distints sin embargo se producen dos restas distintas. Por ejemplo, con 5 y 7 sólo se produce una suma (ya que 5+7 y 7+5 ambos dan 12) pero dos restas (ya que 5-7 y 7-5 dan -2 y 2, respectivamente).

Sin embargo, la conjetura es falsa. Un contraejemplo en el conjunto {0, 2, 3, 4, 7, 11, 12, 14}, que tiene 26 sumas distintas con sus pares de elementos pero sólo 25 restas.

Los conjuntos con más sumas distintas con sus pares de elementos que restas se llaman conjuntos MSQR (por “más sumas que restas”).

El objetivo de este ejercicio es calcular los conjuntos MSQR.

Definir las funciones

   tieneMSQR :: [Integer] -> Bool
   conjuntosMSQR :: [[Integer]]

tales que

  • (tieneMSQR xs) se verifica si el conjunto xs tiene más sumas que restas. Por ejemplo,
     tieneMSQR [0, 2, 3, 4]                 ==  False
     tieneMSQR [0, 2, 3, 4, 7, 11, 12, 14]  ==  True
  • conjuntosMSQR es la lista de los conjuntos MSQR. Por ejemplo,
     λ> take 5 conjuntosMSQR
     [[14,12,11,7,4,3,2,0],
      [14,12,11,10,7,3,2,0],
      [14,13,12,9,5,4,2,1,0],
      [14,13,12,10,9,5,2,1,0],
      [15,13,12,8,5,4,3,1]]
 
      length (takeWhile (< [14]) conjuntosMSQR)   ==  0
      length (takeWhile (< [15]) conjuntosMSQR)   ==  4
      length (takeWhile (< [16]) conjuntosMSQR)   ==  10
      length (takeWhile (< [17]) conjuntosMSQR)   ==  30

Soluciones

import Data.List (tails, nub, sort)
 
-- 1ª solución
-- ===========
 
-- (sumas xs) es el conjunto de las sumas de pares de elementos de
-- xs. Por ejemplo,
--    sumas2 [0,2,3,4]  ==  [0,2,3,4,5,6,7,8]
sumas :: [Integer] -> [Integer]
sumas xs = nub [x + y | x <- xs, y <- xs]
 
-- (restas xs) es el conjunto de las restas de pares de elementos de
-- xs. Por ejemplo,
--    restas [0,2,3,4]  ==  [0,-2,-3,-4,2,-1,3,1,4]
restas :: [Integer] -> [Integer]
restas xs = nub [x - y | x <- xs, y <- xs]
 
tieneMSQR :: [Integer] -> Bool
tieneMSQR xs = length (sumas xs) > length (restas xs)
 
conjuntosMSQR :: [[Integer]]
conjuntosMSQR = [xs | xs <- enumeracionCFN, tieneMSQR xs]
 
-- enumeracionCFN es la enumeración de los conjuntos finitos de números
-- naturales del ejercicio anterior.
enumeracionCFN :: [[Integer]]
enumeracionCFN = concatMap enumeracionCFNHasta [0..]
 
-- (enumeracionCFNHasta n) es la lista de conjuntos con la enumeración
-- anterior cuyo primer elemento es n. Por ejemplo,
--    λ> enumeracionCFNHasta 1
--    [[1],[1,0]]
--    λ> enumeracionCFNHasta 2
--    [[2],[2,0],[2,1],[2,1,0]]
--    λ> enumeracionCFNHasta 3
--    [[3],[3,0],[3,1],[3,1,0],[3,2],[3,2,0],[3,2,1],[3,2,1,0]]
enumeracionCFNHasta :: Integer -> [[Integer]]
enumeracionCFNHasta 0 = [[],[0]]
enumeracionCFNHasta n =
  [n:xs | k <- [0..n-1], xs <- enumeracionCFNHasta k]
 
-- 2ª solución
-- ===========
 
-- (sumas2 xs) es el conjunto de las sumas de pares de elementos de
-- xs. Por ejemplo,
--    sumas2 [0,2,3,4]  ==  [0,2,3,4,5,6,7,8]
--    sumas2 [0,2,3,4]  ==  [0,2,3,4,5,6,7,8]
sumas2 :: [Integer] -> [Integer]
sumas2 xs = nub [x + y | (x:ys) <- tails xs, y <- (x:ys)]
 
-- (restas2 xs) es el conjunto de las restas de pares de elementos de
-- xs. Por ejemplo,
--    sumas2 [0,2,3,4]  ==  [0,2,3,4,5,6,7,8]
--    restas2 [0,2,3,4]  ==  [0,-2,-3,-4,2,-1,3,1,4]
restas2 :: [Integer] -> [Integer]
restas2 xs = 0 : ys ++ map negate ys
  where ys = nub [x - y | (x:ys) <- tails (sort xs), y <- ys]
 
tieneMSQR2 :: [Integer] -> Bool
tieneMSQR2 xs = length (sumas2 xs) > length (restas2 xs)
 
conjuntosMSQR2 :: [[Integer]]
conjuntosMSQR2 = [xs | xs <- enumeracionCFN, tieneMSQR2 xs]
 
-- Comparación de eficiencia
-- =========================
 
--    λ> length (takeWhile (< [17,16..0]) conjuntosMSQR)
--    66
--    (21.36 secs, 10,301,222,168 bytes)
--    λ> length (takeWhile (< [17,16..0]) conjuntosMSQR2)
--    66
--    (10.13 secs, 7,088,969,752 bytes)

Pensamiento

¡Qué fácil es volar, qué fácil es!
Todo consiste en no dejar que el suelo
se acerque a nuestros pies.

Antonio Machado

El teorema de Navidad de Fermat

El 25 de diciembre de 1640, en una carta a Mersenne, Fermat demostró la conjetura de Girard: todo primo de la forma 4n+1 puede expresarse de manera única como suma de dos cuadrados. Por eso es conocido como el Teorema de Navidad de Fermat.

Definir las funciones

   representaciones :: Integer -> [(Integer,Integer)]
   primosImparesConRepresentacionUnica :: [Integer]
   primos4nM1 :: [Integer]

tales que

  • (representaciones n) es la lista de pares de números naturales (x,y) tales que n = x^2 + y^2 con x <= y. Por ejemplo,
     representaciones  20           ==  [(2,4)]
     representaciones  25           ==  [(0,5),(3,4)]
     representaciones 325           ==  [(1,18),(6,17),(10,15)]
     representaciones 100000147984  ==  [(0,316228)]
     length (representaciones (10^10))    ==  6
     length (representaciones (4*10^12))  ==  7
  • primosImparesConRepresentacionUnica es la lista de los números primos impares que se pueden escribir exactamente de una manera como suma de cuadrados de pares de números naturales (x,y) con x <= y. Por ejemplo,
     λ> take 20 primosImparesConRepresentacionUnica
     [5,13,17,29,37,41,53,61,73,89,97,101,109,113,137,149,157,173,181,193]
  • primos4nM1 es la lista de los números primos que se pueden escribir como uno más un múltiplo de 4 (es decir, que son congruentes con 1 módulo 4). Por ejemplo,
     λ> take 20 primos4nM1
     [5,13,17,29,37,41,53,61,73,89,97,101,109,113,137,149,157,173,181,193]

El teorema de Navidad de Fermat afirma que un número primo impar p se puede escribir exactamente de una manera como suma de dos cuadrados de números naturales p = x² + y^2 (con x <= y) si, y sólo si, p se puede escribir como uno más un múltiplo de 4 (es decir, que es congruente con 1 módulo 4).

Comprobar con QuickCheck el teorema de Navidad de Fermat; es decir, que para todo número n, los n-ésimos elementos de primosImparesConRepresentacionUnica y de primos4nM1 son iguales.

Soluciones

import Data.Numbers.Primes (primes)
import Test.QuickCheck
 
-- 1ª definición de representaciones
-- =================================
 
representaciones :: Integer -> [(Integer,Integer)]
representaciones n =
  [(x,y) | x <- [0..n], y <- [x..n], n == x*x + y*y]
 
-- 2ª definición de representaciones
-- =================================
 
representaciones2 :: Integer -> [(Integer,Integer)]
representaciones2 n =
  [(x,raiz z) | x <- [0..raiz (n `div` 2)] 
              , let z = n - x*x
              , esCuadrado z]
 
-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado 25  ==  True
--    esCuadrado 26  ==  False
esCuadrado :: Integer -> Bool
esCuadrado x = x == y * y
  where y = raiz x
 
-- (raiz x) es la raíz cuadrada entera de x. Por ejemplo,
--    raiz 25  ==  5
--    raiz 24  ==  4
--    raiz 26  ==  5
raiz :: Integer -> Integer 
raiz 0 = 0
raiz 1 = 1
raiz x = aux (0,x)
    where aux (a,b) | d == x    = c
                    | c == a    = a
                    | d < x     = aux (c,b)
                    | otherwise = aux (a,c) 
              where c = (a+b) `div` 2
                    d = c^2
 
-- 3ª definición de representaciones
-- =================================
 
representaciones3 :: Integer -> [(Integer,Integer)]
representaciones3 n =
  [(x,raiz3 z) | x <- [0..raiz3 (n `div` 2)] 
               , let z = n - x*x
               , esCuadrado3 z]
 
-- (esCuadrado x) se verifica si x es un número al cuadrado. Por
-- ejemplo,
--    esCuadrado3 25  ==  True
--    esCuadrado3 26  ==  False
esCuadrado3 :: Integer -> Bool
esCuadrado3 x = x == y * y
  where y = raiz3 x
 
-- (raiz3 x) es la raíz cuadrada entera de x. Por ejemplo,
--    raiz3 25  ==  5
--    raiz3 24  ==  4
--    raiz3 26  ==  5
raiz3 :: Integer -> Integer
raiz3 x = floor (sqrt (fromIntegral x))
 
-- 4ª definición de representaciones
-- =================================
 
representaciones4 :: Integer -> [(Integer, Integer)]
representaciones4 n = aux 0 (floor (sqrt (fromIntegral n)))
  where aux x y
          | x > y     = [] 
          | otherwise = case compare (x*x + y*y) n of
                          LT -> aux (x + 1) y
                          EQ -> (x, y) : aux (x + 1) (y - 1)
                          GT -> aux x (y - 1)
 
-- Equivalencia de las definiciones de representaciones
-- ====================================================
 
-- La propiedad es
prop_representaciones_equiv :: (Positive Integer) -> Bool
prop_representaciones_equiv (Positive n) =
  representaciones  n == representaciones2 n &&
  representaciones2 n == representaciones3 n &&
  representaciones3 n == representaciones4 n
 
-- La comprobación es
--    λ> quickCheck prop_representaciones_equiv
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia de las definiciones de representaciones
-- =================================================================
 
--    λ> representaciones 3025
--    [(0,55),(33,44)]
--    (2.86 secs, 1,393,133,528 bytes)
--    λ> representaciones2 3025
--    [(0,55),(33,44)]
--    (0.00 secs, 867,944 bytes)
--    λ> representaciones3 3025
--    [(0,55),(33,44)]
--    (0.00 secs, 173,512 bytes)
--    λ> representaciones4 3025
--    [(0,55),(33,44)]
--    (0.00 secs, 423,424 bytes)
--    
--    λ> length (representaciones2 (10^10))
--    6
--    (3.38 secs, 2,188,903,544 bytes)
--    λ> length (representaciones3 (10^10))
--    6
--    (0.10 secs, 62,349,048 bytes)
--    λ> length (representaciones4 (10^10))
--    6
--    (0.11 secs, 48,052,360 bytes)
--
--    λ> length (representaciones3 (4*10^12))
--    7
--    (1.85 secs, 1,222,007,176 bytes)
--    λ> length (representaciones4 (4*10^12))
--    7
--    (1.79 secs, 953,497,480 bytes)
 
-- Definición de primosImparesConRepresentacionUnica
-- =================================================
 
primosImparesConRepresentacionUnica :: [Integer]
primosImparesConRepresentacionUnica =
  [x | x <- tail primes
     , length (representaciones4 x) == 1]
 
-- Definición de primos4nM1
-- ========================
 
primos4nM1 :: [Integer]
primos4nM1 = [x | x <- primes
                , x `mod` 4 == 1]
 
-- Teorema de Navidad de Fermat
-- ============================
 
-- La propiedad es
prop_teoremaDeNavidadDeFermat :: Positive Int -> Bool
prop_teoremaDeNavidadDeFermat (Positive n) =
  primosImparesConRepresentacionUnica !! n == primos4nM1 !! n
 
-- La comprobación es
--    λ> quickCheck prop_teoremaDeNavidadDeFermat
--    +++ OK, passed 100 tests.

Pensamiento

Dijo Dios: brote la nada
Y alzó su mano derecha,
hasta ocultar su mirada.
Y quedó la nada hecha.

Antonio Machado

Árbol binario de divisores

El árbol binario de los divisores de 24 es

    90
    /\
   2  45
      /\
     3  15
        /\
       3  5

Se puede representar por

   N 90 (H 2) (N 45 (H 3) (N 15 (H 3) (H 5)))

usando el tipo de dato definido por

   data Arbol = H Int
              | N Int Arbol Arbol
     deriving (Eq, Show)

Análogamente se obtiene el árbol binario de cualquier número x: se comienza en x y en cada paso se tiene dos hijos (su menor divisor y su cociente) hasta obtener números primos en las hojas.

Definir las funciones

   arbolDivisores      :: Int -> Arbol
   hojasArbolDivisores :: Int -> [Int]

tales que

  • (arbolDivisores x) es el árbol binario de los divisores de x. Por ejemplo,
     λ> arbolDivisores 90
     N 90 (H 2) (N 45 (H 3) (N 15 (H 3) (H 5)))
     λ> arbolDivisores 24
     N 24 (H 2) (N 12 (H 2) (N 6 (H 2) (H 3)))
     λ> arbolDivisores 300
     N 300 (H 2) (N 150 (H 2) (N 75 (H 3) (N 25 (H 5) (H 5))))
  • (hojasArbolDivisores x) es la lista de las hohas del árbol binario de los divisores de x. Por ejemplo
     hojasArbolDivisores 90   ==  [2,3,3,5]
     hojasArbolDivisores 24   ==  [2,2,2,3]
     hojasArbolDivisores 300  ==  [2,2,3,5,5]

Soluciones

import Data.Numbers.Primes (isPrime, primeFactors)
 
data Arbol = H Int
           | N Int Arbol Arbol
  deriving (Eq, Show)
 
-- 1ª solución
-- ===========
 
arbolDivisores :: Int -> Arbol
arbolDivisores x
  | y == x    = H x
  | otherwise = N x (H y) (arbolDivisores (x `div` y))
  where y = menorDivisor x
 
-- (menorDivisor x) es el menor divisor primo de x. Por ejemplo,
--    menorDivisor 45  ==  3
--    menorDivisor 5   ==  5
menorDivisor :: Int -> Int
menorDivisor x =
  head [y | y <- [2..x], x `mod` y == 0]
 
hojasArbolDivisores :: Int -> [Int]
hojasArbolDivisores = hojas . arbolDivisores
 
-- (hojas a) es la lista de las hojas del árbol a. Por ejemplo,
--    hojas (N 3 (H 4) (N 5 (H 7) (H 2)))  ==  [4,7,2]
hojas :: Arbol -> [Int]
hojas (H x)     = [x]
hojas (N _ i d) = hojas i ++ hojas d
 
-- 2ª solución
-- ===========
 
arbolDivisores2 :: Int -> Arbol
arbolDivisores2 x
  | y == x    = H x
  | otherwise = N x (H y) (arbolDivisores (x `div` y))
  where (y:_) = primeFactors x
 
hojasArbolDivisores2 :: Int -> [Int]
hojasArbolDivisores2 = primeFactors

Pensamiento

Cuando el Ser que se es hizo la nada
y reposó que bien lo merecía,
ya tuvo el día noche, y compañía
tuvo el amante en la ausencia de la amada.

Antonio Machado

Primos o cuadrados de primos

Definir la constante

   primosOcuadradosDePrimos :: [Integer]

cuyos elementos son los número primos o cuadrados de primos. Por ejemplo,

   λ> take 20 primosOcuadradosDePrimos
   [2,3,4,5,7,9,11,13,17,19,23,25,29,31,37,41,43,47,49,53]
   λ> primosOcuadradosDePrimos !! (10^6)
   15476729

Comprobar con QuickCheck que las lista primosOcuadradosDePrimos y unifactorizables (definida en el ejercicio anterior) son iguales.

Soluciones

import Test.QuickCheck
import Data.Numbers.Primes (primeFactors, primes)
 
-- 1ª solución
-- ===========
 
primosOcuadradosDePrimos :: [Integer]
primosOcuadradosDePrimos =
  filter esPrimoOcuadradoDePrimo [2..]
 
esPrimoOcuadradoDePrimo :: Integer -> Bool
esPrimoOcuadradoDePrimo n = aux xs
  where xs = primeFactors n
        aux [_]   = True
        aux [x,y] = x == y
        aux _     = False
 
-- 2ª solución
-- ===========
 
primosOcuadradosDePrimos2 :: [Integer]
primosOcuadradosDePrimos2 = mezcla primes (map (^2) primes)
 
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla (x:xs) (y:ys) | x < y     = x : mezcla xs (y:ys)
                     | otherwise = y : mezcla (x:xs) ys
 
-- Comparación de eficiencia
-- =========================
 
--    λ> primosOcuadradosDePrimos !! (2*10^4)
--    223589
--    (3.08 secs, 9,829,725,096 bytes)
--    λ> primosOcuadradosDePrimos2 !! (2*10^4)
--    223589
--    (0.04 secs, 73,751,888 bytes)
--
--    λ> primosOcuadradosDePrimos2 !! (5*10^5)
--    7362497
--    (1.29 secs, 3,192,803,040 bytes)
 
-- Propiedad de equivalencia
-- =========================
 
-- La propiedad es
prop_equivalencia :: Int -> Property
prop_equivalencia n =
  n >= 0 ==> primosOcuadradosDePrimos2 !! n == unifactorizables !! n
 
--  unifactorizables es la lísta de los números enteros mayores que 1
--  que se pueden escribir sólo de una forma única como producto de
--  enteros distintos mayores que uno. Por ejemplo,
--     λ> take 20 unifactorizables
--     [2,3,4,5,7,9,11,13,17,19,23,25,29,31,37,41,43,47,49,53]
--     λ> unifactorizables !! 300
--     1873
unifactorizables :: [Integer]
unifactorizables =
  [n | n <- [2..]
     , length (sublistasConProducto n [2..n]) == 1]
 
-- (sublistasConProducto n xs) es la lista de las sublistas de la
-- lista ordenada estrictamente creciente xs (cuyos elementos son
-- enteros mayores que 1) cuyo producto es el número entero n (con n
-- mayor que 1). Por ejemplo,  
--    λ> sublistasConProducto 72 [2,3,4,5,6,7,9,10,16]
--    [[2,4,9],[3,4,6]]
--    λ> sublistasConProducto 720 [2,3,4,5,6,7,9,10,16]
--    [[2,3,4,5,6],[2,4,9,10],[3,4,6,10],[5,9,16]]
--    λ> sublistasConProducto 2 [4,7]
--    []
sublistasConProducto :: Integer -> [Integer] -> [[Integer]]
sublistasConProducto _ [] = []
sublistasConProducto n (x:xs)
  | x > n     = []
  | x == n    = [[x]]
  | r == 0    = map (x:) (sublistasConProducto q xs)
                ++ sublistasConProducto n xs
  | otherwise = sublistasConProducto n xs
  where (q,r) = quotRem n x
 
-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.

Pensamiento

Despacito y buena letra: el hacer las cosas bien importa más que el hacerlas.

Antonio Machado

Sublistas con producto dado

Definir las funciones

   sublistasConProducto :: Integer -> [Integer] -> [[Integer]]
   unifactorizables :: [Integer]

tales que

  • (sublistasConProducto n xs) es la lista de las sublistas de la lista ordenada estrictamente creciente xs (cuyos elementos son enteros mayores que 1) cuyo producto es el número entero n (con n mayor que 1). Por ejemplo,
     λ> sublistasConProducto 72 [2,3,4,5,6,7,9,10,16]
     [[2,4,9],[3,4,6]]
     λ> sublistasConProducto 720 [2,3,4,5,6,7,9,10,16]
     [[2,3,4,5,6],[2,4,9,10],[3,4,6,10],[5,9,16]]
     λ> sublistasConProducto 2 [4,7]
     []
     λ> length (sublistasConProducto 1234567 [1..1234567])
     4
  • unifactorizables es la lísta de los números enteros mayores que 1 que se pueden escribir sólo de una forma única como producto de enteros distintos mayores que uno. Por ejemplo,
     λ> take 20 unifactorizables
     [2,3,4,5,7,9,11,13,17,19,23,25,29,31,37,41,43,47,49,53]
     λ> unifactorizables !! 300
     1873

Soluciones

import Test.QuickCheck
import Data.List (nub, sort, subsequences)
 
-- 1ª solución
-- ===========
 
sublistasConProducto :: Integer -> [Integer] -> [[Integer]]
sublistasConProducto n xs =
  [ys | ys <- subsequences xs
      , product ys == n]
 
-- 2ª solución
-- ===========
 
sublistasConProducto2 :: Integer -> [Integer] -> [[Integer]]
sublistasConProducto2 _ [] = []
sublistasConProducto2 n (x:xs)
  | x > n     = []
  | x == n    = [[x]]
  | r == 0    = map (x:) (sublistasConProducto2 q xs)
                ++ sublistasConProducto2 n xs
  | otherwise = sublistasConProducto2 n xs
  where (q,r) = quotRem n x
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_sublistasConProducto :: Integer -> [Integer] -> Bool
prop_sublistasConProducto n xs =
  sort (sublistasConProducto n' xs') == sublistasConProducto2 n' xs'
  where n'  = 2 + abs n
        xs' = (nub . sort . map ((+2) . abs)) xs
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=30}) prop_sublistasConProducto
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--    λ> sublistasConProducto 15 [1..23]
--    [[3,5],[1,3,5],[15],[1,15]]
--    (3.44 secs, 7,885,411,472 bytes)
--    λ> sublistasConProducto2 15 [1..23]
--    [[1,3,5],[1,15],[3,5],[15]]
--    (0.01 secs, 135,056 bytes)
--
--    λ> length (sublistasConProducto2 1234567 [1..1234567])
--    4
--    (1.49 secs, 1,054,380,480 bytes)
 
-- Definición de unifactorizables
-- ==============================
 
unifactorizables :: [Integer]
unifactorizables =
  [n | n <- [2..]
     , length (sublistasConProducto2 n [2..n]) == 1]

Pensamiento

Y en el encinar,
¡luna redonda y beata,
siempre conmigo a la par!
Cerca de Úbeda la grande,
cuyos cerros nadie verá,
me iba siguiendo la luna
sobre el olivar.
Una luna jadeante,
siempre conmigo a la par.

Antonio Machado

Mayor producto de n dígitos consecutivos de un número

Definir la función

   mayorProducto :: Int -> Integer -> Integer

tal que (mayorProducto n x) es el mayor producto de n dígitos consecutivos del número x (suponiendo que x tiene al menos n dígitos). Por ejemplo,

   mayorProducto 2 325                  ==  10
   mayorProducto 5 11111                ==  1
   mayorProducto 5 113111               ==  3
   mayorProducto 5 110111               ==  0
   mayorProducto 5 10151112             ==  10
   mayorProducto 5 101511124            ==  10
   mayorProducto 5 (product [1..1000])  ==  41472

Nota: Este ejercicio está basado en el problema 8 del Proyecto Euler

Soluciones

import Data.List (inits, tails)
import Data.Char (digitToInt)
 
-- 1ª solución
-- ===========
 
mayorProducto :: Int -> Integer -> Integer
mayorProducto n x =
  maximum [product xs | xs <- segmentos n (digitos x)]
 
-- (digitos x) es la lista de las digitos del número x. Por ejemplo, 
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos x = map (toInteger . digitToInt) (show x)
 
-- (segmentos n xs) es la lista de los segmentos de longitud n de la
-- lista xs. Por ejemplo,
--    segmentos 2 [3,5,4,6]  ==  [[3,5],[5,4],[4,6]]
segmentos :: Int -> [Integer] -> [[Integer]]
segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))
 
-- 2ª solución
-- ===========
 
mayorProducto2 :: Int -> Integer -> Integer
mayorProducto2 n x = maximum (aux ns)
    where ns     = [read [d] | d <- show x]
          aux xs | length xs < n = []
                 | otherwise     = product (take n xs) : aux (tail xs)
 
-- 3ª solución
-- ===========
 
mayorProducto3 :: Int -> Integer -> Integer
mayorProducto3 n = maximum
                 . map (product . take n)
                 . filter ((>=n) . length) 
                 . tails
                 . digitos
 
-- 4ª solución
-- ===========
 
mayorProducto4 :: Int -> Integer -> Integer
mayorProducto4 n = maximum  
                 . map (product . map (fromIntegral . digitToInt)) 
                 . filter ((==n) . length) 
                 . concatMap inits
                 . tails 
                 . show
 
-- Comparación de eficiencia
-- =========================
 
--    λ> mayorProducto 5 (product [1..500])
--    28224
--    (0.01 secs, 1,645,256 bytes)
--    λ> mayorProducto2 5 (product [1..500])
--    28224
--    (0.03 secs, 5,848,416 bytes)
--    λ> mayorProducto3 5 (product [1..500])
--    28224
--    (0.03 secs, 1,510,640 bytes)
--    λ> mayorProducto4 5 (product [1..500])
--    28224
--    (1.85 secs, 10,932,551,216 bytes)
--    
--    λ> mayorProducto 5 (product [1..7000])
--    46656
--    (0.10 secs, 68,590,808 bytes)
--    λ> mayorProducto2 5 (product [1..7000])
--    46656
--    (1.63 secs, 157,031,432 bytes)
--    λ> mayorProducto3 5 (product [1..7000])
--    46656
--    (1.55 secs, 65,727,176 bytes)

Pensamiento

“El control de la complejidad es la esencia de la programación.” ~ B.W. Kernigan

Menor número triangular con más de n divisores

La sucesión de los números triangulares se obtiene sumando los números naturales.

   *     *      *        *         *   
        * *    * *      * *       * *  
              * * *    * * *     * * * 
                      * * * *   * * * *
                               * * * * * 
   1     3      6        10        15

Así, el 7º número triangular es

   1 + 2 + 3 + 4 + 5 + 6 + 7 = 28.

Los primeros 10 números triangulares son

   1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

Los divisores de los primeros 7 números triangulares son:

    1: 1
    3: 1,3
    6: 1,2,3,6
   10: 1,2,5,10
   15: 1,3,5,15
   21: 1,3,7,21
   28: 1,2,4,7,14,28

Como se puede observar, 28 es el menor número triangular con más de 5 divisores.

Definir la función

   menorTriangularConAlMenosNDivisores :: Int -> Integer

tal que (menorTriangularConAlMenosNDivisores n) es el menor número triangular que tiene al menos n divisores. Por ejemplo,

   menorTriangularConAlMenosNDivisores 5    ==  28
   menorTriangularConAlMenosNDivisores 50   ==  25200
   menorTriangularConAlMenosNDivisores 500  ==  76576500

Nota: Este ejercicio está basado en el problema 12 del Proyecto Euler

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)
 
menorTriangularConAlMenosNDivisores :: Int -> Integer
menorTriangularConAlMenosNDivisores n = 
  head [x | x <- triangulares, nDivisores x >= n]
 
-- Nota: Se usarán las funciones
-- + triangulares definida en [Números triangulares](http://bit.ly/2rtr6a3) y
-- + nDivisores definida en [Número de divisores](http://bit.ly/2DgVh74)
 
-- triangulares es la sucesión de los números triangulares. Por ejemplo,
--    take 10 triangulares  ==  [1,3,6,10,15,21,28,36,45,55]
triangulares :: [Integer]
triangulares = scanl1 (+) [1..]
 
-- (nDivisores x) es el número de divisores de x. Por ejemplo,
--    nDivisores 28  ==  6
nDivisores :: Integer -> Int
nDivisores = product . map ((+1) . length) . group . primeFactors

Pensamiento

“La Matemática es una ciencia experimental y la computación es el experimento.” ~ Rivin

Producto cartesiano de una familia de conjuntos

Definir la función

   producto :: [[a]] -> [[a]]

tal que (producto xss) es el producto cartesiano de los conjuntos xss. Por ejemplo,

   ghci> producto [[1,3],[2,5]]
   [[1,2],[1,5],[3,2],[3,5]]
   ghci> producto [[1,3],[2,5],[6,4]]
   [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]]
   ghci> producto [[1,3,5],[2,4]]
   [[1,2],[1,4],[3,2],[3,4],[5,2],[5,4]]
   ghci> producto []
   [[]]

Comprobar con QuickCheck que para toda lista de listas de números enteros, xss, se verifica que el número de elementos de (producto xss) es igual al producto de los números de elementos de cada una de las listas de xss.

Nota. Al hacer la comprobación limitar el tamaño de las pruebas como se indica a continuación

   quickCheckWith (stdArgs {maxSize=9}) prop_producto

Soluciones

-- 1ª solución
-- ===========
 
producto :: [[a]] -> [[a]]
producto []       = [[]]
producto (xs:xss) = inserta xs (producto xss)
 
-- (inserta xs xss) inserta cada elemento de xs en los elementos de
-- xss. Por ejemplo,
--    λ> inserta [1,2] [[3,4],[5,6]]
--    [[1,3,4],[1,5,6],[2,3,4],[2,5,6]]
-- La función inserta se puede definir de distintas maneras, como se
-- muestra a continuación. Elegimos la primera.
inserta :: [a] -> [[a]] -> [[a]]
inserta = inserta1
 
inserta1 :: [a] -> [[a]] -> [[a]]
inserta1 [] _       = []
inserta1 (x:xs) yss = [x:ys | ys <- yss] ++ inserta1 xs yss
 
inserta2 :: [a] -> [[a]] -> [[a]]
inserta2 [] _       = []
inserta2 (x:xs) yss = map (x:) yss ++ inserta2 xs yss
 
inserta3 :: [a] -> [[a]] -> [[a]]
inserta3 xs yss = concatMap (\k -> map (k:) yss) xs
 
inserta4 :: [a] -> [[a]] -> [[a]]
inserta4 xs xss = [x:ys | x <- xs, ys <- xss]
 
-- 2ª solución
-- ===========
 
producto2 :: [[a]] -> [[a]]
producto2 = foldr inserta [[]]
 
-- 3ª solución
-- ===========
 
producto3 :: [[a]] -> [[a]]
producto3 []       = [[]]
producto3 (xs:xss) = [x:ys | x <- xs, ys <- producto3 xss]
 
-- 4ª solución
-- ===========
 
producto4 :: [[a]] -> [[a]]
producto4 = sequence
 
-- Comparación de eficiencia
-- =========================
 
--    λ> length (producto (replicate 8 [1..8]))
--    16777216
--    (3.78 secs, 3,374,739,944 bytes)
--    λ> length (producto2 (replicate 8 [1..8]))
--    16777216
--    (3.82 secs, 3,374,737,200 bytes)
--    λ> length (producto3 (replicate 8 [1..8]))
--    16777216
--    (15.64 secs, 19,193,238,456 bytes)
--    λ> length (producto4 (replicate 8 [1..8]))
--    16777216
--    (2.32 secs, 1,840,810,296 bytes)
 
-- La propiedad es
prop_producto :: [[Int]] -> Bool
prop_producto xss =
  length (producto xss) == product (map length xss)
 
-- La comprobación es
--    λ>  quickCheckWith (stdArgs {maxSize=9}) prop_producto
--    +++ OK, passed 100 tests.

Pensamiento

Busca el tú que nunca es tuyo
ni puede serlo jamás.

Antonio Machado

Mayor producto de n dígitos consecutivos de un número

Definir la función

   mayorProducto :: Int -> Integer -> Integer

tal que (mayorProducto n x) es el mayor producto de n dígitos consecutivos del número x (suponiendo que x tiene al menos n dígitos). Por ejemplo,

   mayorProducto 2 325                  ==  10
   mayorProducto 5 11111                ==  1
   mayorProducto 5 113111               ==  3
   mayorProducto 5 110111               ==  0
   mayorProducto 5 10151112             ==  10
   mayorProducto 5 101511124            ==  10
   mayorProducto 5 (product [1..1000])  ==  41472

Soluciones

import Test.QuickCheck
import Data.List (inits, tails)
import Data.Char (digitToInt)
 
-- 1ª solución
-- ===========
 
mayorProducto1 :: Int -> Integer -> Integer
mayorProducto1 n x =
  maximum [product xs | xs <- segmentos n (cifras x)]
 
-- (cifras x) es la lista de las cifras del número x. Por ejemplo, 
--    cifras 325  ==  [3,2,5]
cifras :: Integer -> [Integer]
cifras x = map (toInteger . digitToInt) (show x)
 
-- (segmentos n xs) es la lista de los segmentos de longitud n de la
-- lista xs. Por ejemplo,
--    segmentos 2 [3,5,4,6]  ==  [[3,5],[5,4],[4,6]]
segmentos :: Int -> [Integer] -> [[Integer]]
segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))
 
-- 2ª solución
-- ===========
 
mayorProducto2 :: Int -> Integer -> Integer
mayorProducto2 n x = maximum (aux ns)
    where ns     = [read [d] | d <- show x]
          aux xs | length xs < n = []
                 | otherwise     = product (take n xs) : aux (tail xs)
 
-- 3ª solución
-- ===========
 
mayorProducto3 :: Int -> Integer -> Integer
mayorProducto3 n = maximum
                 . map (product . take n)
                 . filter ((>=n) . length) 
                 . tails
                 . cifras
 
-- 4ª solución
-- ===========
 
mayorProducto4 :: Int -> Integer -> Integer
mayorProducto4 n = maximum  
                 . map (product . map (fromIntegral . digitToInt)) 
                 . filter ((==n) . length) 
                 . concatMap inits
                 . tails 
                 . show
 
-- ---------------------------------------------------------------------
-- Comparación de soluciones                                          --
-- ---------------------------------------------------------------------
 
-- Tiempo (en segundos) del cálculo de (mayorProducto 5 (product [1..n]))
-- 
--    | Def | 500  | 1000 | 5000 | 10000 
--    | 1   | 0.01 | 0.02 | 0.06 | 0.11
--    | 2   | 0.01 | 0.03 | 0.80 | 3.98
--    | 3   | 0.01 | 0.03 | 0.82 | 4.13
--    | 4   | 2.77 |      |      |

Pensamiento

A las palabras de amor
les sienta bien su poquito
de exageración.

Antonio Machado