Menu Close

Etiqueta: length

Á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

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

Reparto de escaños por la ley d’Hont

El sistema D’Hondt es una fórmula creada por Victor d’Hondt, que permite obtener el número de cargos electos asignados a las candidaturas, en proporción a los votos conseguidos.

Tras el recuento de los votos, se calcula una serie de divisores para cada partido. La fórmula de los divisores es V/N, donde V representa el número total de votos recibidos por el partido, y N representa cada uno de los números enteros desde 1 hasta el número de cargos electos de la circunscripción objeto de escrutinio. Una vez realizadas las divisiones de los votos de cada partido por cada uno de los divisores desde 1 hasta N, la asignación de cargos electos se hace ordenando los cocientes de las divisiones de mayor a menor y asignando a cada uno un escaño hasta que éstos se agoten

Definir la función

   reparto :: Int -> [Int] -> [(Int,Int)]

tal que (reparto n vs) es la lista de los pares formados por los números de los partidos y el número de escaño que les corresponden al repartir n escaños en función de la lista de sus votos. Por ejemplo,

   ghci> reparto 7 [340000,280000,160000,60000,15000]
   [(1,3),(2,3),(3,1)]
   ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000]
   [(1,9),(2,7),(3,4),(4,1)]

es decir, en el primer ejemplo,

  • al 1º partido (que obtuvo 340000 votos) le corresponden 3 escaños,
  • al 2º partido (que obtuvo 280000 votos) le corresponden 3 escaños,
  • al 3º partido (que obtuvo 160000 votos) le corresponden 1 escaño.

Soluciones

import Data.List (sort, group)
 
-- Para los ejemplos que siguen, se usará la siguiente ditribución de
-- votos entre 5 partidos.
ejVotos :: [Int]
ejVotos = [340000,280000,160000,60000,15000]
 
-- 1ª solución
-- ===========
 
reparto :: Int -> [Int] -> [(Int,Int)]
reparto n vs = 
  [(x,1 + length xs) | (x:xs) <- group (sort (repartoAux n vs))] 
 
-- (repartoAux n vs) es el número de los partidos, cuyos votos son vs, que
-- obtienen los n escaños. Por ejemplo,
--    ghci> repartoAux 7 ejVotos
--    [1,2,1,3,2,1,2]
repartoAux :: Int -> [Int] -> [Int]
repartoAux n vs = map snd (repartoAux' n vs)
 
-- (repartoAux' n vs) es la lista formada por los n restos mayores
-- correspondientes a la lista de votos vs. Por ejemplo,
--    ghci> repartoAux' 7 ejVotos
--    [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1),
--     (93333,2)]
repartoAux' :: Int -> [Int] -> [(Int,Int)]
repartoAux' n vs = 
  take n (reverse (sort (concatMap (restos n) (votosPartidos vs))))
 
-- (votosPartidos vs) es la lista con los pares formados por los votos y
-- el número de cada partido. Por ejemplo, 
--    ghci> votosPartidos ejVotos
--    [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)]
votosPartidos :: [Int] -> [(Int,Int)]
votosPartidos vs = zip vs [1..]
 
-- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n.
-- Por ejemplo, 
--    ghci> restos 5 (340000,1)
--    [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)]
restos :: Int -> (Int,Int) -> [(Int,Int)]
restos n (x,i) = [(x `div` k,i) | k <- [1..n]]
 
-- 2ª solución
-- ===========
 
reparto2 :: Int -> [Int] -> [(Int,Int)]
reparto2 n xs = 
  ( map (\x -> (head x, length x))  
  . group  
  . sort  
  . map snd  
  . take n  
  . reverse  
  . sort
  ) [(x `div` i, p) | (x,p) <- zip xs [1..], i <- [1..n]]

Pensamiento

Sus cantares llevan
agua de remanso,
que parece quieta.
Y que no lo está;
mas no tiene prisa
por ir a la mar.

Antonio Machado

Elementos no repetidos

Definir la función

   noRepetidos :: Eq a => [a] -> [a]

tal que (noRepetidos xs) es la lista de los elementos no repetidos de la lista xs. Por ejemplo,

   noRepetidos [3,2,5,2,4,7,3]  ==  [5,4,7]
   noRepetidos "noRepetidos"    ==  "nRptids"
   noRepetidos "Roma"           ==  "Roma"

Soluciones

import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
noRepetidos :: Eq a => [a] -> [a]
noRepetidos xs = 
  [x | x <- xs, ocurrencias x xs == 1]
 
-- (ocurrencias x ys) es el número de ocurrencias de x en ys. Por
-- ejemplo,
--    ocurrencias 3 [3,2,5,2,4,7,3]  ==  2
--    ocurrencias 5 [3,2,5,2,4,7,3]  ==  1
ocurrencias :: Eq a => a -> [a] -> Int
ocurrencias x ys = 
  length [y | y <- ys, y == x]
 
-- 2ª solución
-- ===========
noRepetidos2 :: Eq a => [a] -> [a]
noRepetidos2 [] = []
noRepetidos2 (x:xs) | elem x xs = noRepetidos2 [y | y <- xs, y /= x]
                    | otherwise = x : noRepetidos2 xs
 
-- Equivalencia
-- ============
 
-- La propiedad de equivalencia es
prop_equivalencia :: [Int] -> Bool
prop_equivalencia xs =
  noRepetidos xs == noRepetidos2 xs
 
-- La comprobación es
--    ghci> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.

Pensamiento

Y en perfecto rimo
— así a la vera del agua
el doble chopo del río.

Antonio Machado

Variación de la conjetura de Goldbach.

La conjetura de Goldbach afirma que

Todo número entero mayor que 5 se puede escribir como suma de tres números primos.

En este ejercicio consideraremos la variación consistente en exigir que los tres sumandos sean distintos.

Definir las funciones

   sumas3PrimosDistintos      :: Int -> [(Int,Int,Int)]
   conKsumas3PrimosDistintos  :: Int -> Int -> [Int]
   noSonSumas3PrimosDistintos :: Int -> [Int]

tales que

  • (sumas3PrimosDistintos n) es la lista de las descomposiciones decrecientes de n como tres primos distintos. Por ejemplo,
   sumas3PrimosDistintos 26  ==  [(13,11,2),(17,7,2),(19,5,2)]
   sumas3PrimosDistintos 18  ==  [(11,5,2),(13,3,2)]
   sumas3PrimosDistintos 10  ==  [(5,3,2)]
   sumas3PrimosDistintos 11  ==  []
  • (conKsumas3PrimosDistintos k n) es la lista de los números menores o iguales que n que se pueden escribir en k forma distintas como suma de tres primos distintos. Por ejemplo,
   conKsumas3PrimosDistintos 3 99  ==  [26,27,29,32,36,42,46,48,54,58,60]
   conKsumas3PrimosDistintos 2 99  ==  [18,20,21,22,23,24,25,28,30,34,64,70]
   conKsumas3PrimosDistintos 1 99  ==  [10,12,14,15,16,19,40]
   conKsumas3PrimosDistintos 0 99  ==  [11,13,17]
  • (noSonSumas3PrimosDistintos n) es la lista de los números menores o iguales que n que no se pueden escribir como suma de tres primos distintos. Por ejemplo,
   noSonSumas3PrimosDistintos 99   ==  [11,13,17]
   noSonSumas3PrimosDistintos 500  ==  [11,13,17]

Soluciones

import Data.Numbers.Primes
 
sumas3PrimosDistintos :: Int -> [(Int,Int,Int)]
sumas3PrimosDistintos n =
  [(a,b,c) | a <- takeWhile (<=n-5) primes
           , b <- takeWhile (<a) primes
           , let c = n - a - b
           , c < b
           , isPrime c]
 
conKsumas3PrimosDistintos :: Int -> Int -> [Int]
conKsumas3PrimosDistintos k n =
  [x | x <- [10..n]
     , length (sumas3PrimosDistintos x) == k]
 
noSonSumas3PrimosDistintos :: Int -> [Int]
noSonSumas3PrimosDistintos = conKsumas3PrimosDistintos 0

Pensamiento

En su claro verso
se canta y medita
sin grito ni ceño.

Antonio Machado

Conjetura de las familias estables por uniones

La conjetura de las familias estables por uniones fue planteada por Péter Frankl en 1979 y aún sigue abierta.

Una familia de conjuntos es estable por uniones si la unión de dos conjuntos cualesquiera de la familia pertenece a la familia. Por ejemplo, {∅, {1}, {2}, {1,2}, {1,3}, {1,2,3}} es estable por uniones; pero {{1}, {2}, {1,3}, {1,2,3}} no lo es.

La conjetura afirma que toda familia no vacía estable por uniones y distinta de {∅} posee algún elemento que pertenece al menos a la mitad de los conjuntos de la familia.

Definir las funciones

   esEstable :: Ord a => Set (Set a) -> Bool
   familiasEstables :: Ord a => Set a -> Set (Set (Set a))
   mayoritarios :: Ord a => Set (Set a) -> [a]
   conjeturaFrankl :: Int -> Bool

tales que

  • (esEstable f) se verifica si la familia f es estable por uniones. Por ejemplo,
     λ> esEstable (fromList [empty, fromList [1,2], fromList [1..5]])
     True
     λ> esEstable (fromList [empty, fromList [1,7], fromList [1..5]])
     False
     λ> esEstable (fromList [fromList [1,2], singleton 3, fromList [1..3]])
     True
  • (familiasEstables c) es el conjunto de las familias estables por uniones formadas por elementos del conjunto c. Por ejemplo,
     λ> familiasEstables (fromList [1..2])
     fromList
       [ fromList []
       , fromList [fromList []]
       , fromList [fromList [],fromList [1]]
       , fromList [fromList [],fromList [1],fromList [1,2]],
         fromList [fromList [],fromList [1],fromList [1,2],fromList [2]]
       , fromList [fromList [],fromList [1,2]]
       , fromList [fromList [],fromList [1,2],fromList [2]]
       , fromList [fromList [],fromList [2]]
       , fromList [fromList [1]]
       , fromList [fromList [1],fromList [1,2]]
       , fromList [fromList [1],fromList [1,2],fromList [2]]
       , fromList [fromList [1,2]]
       , fromList [fromList [1,2],fromList [2]]
       , fromList [fromList [2]]]
     λ> size (familiasEstables (fromList [1,2]))
     14
     λ> size (familiasEstables (fromList [1..3]))
     122
     λ> size (familiasEstables (fromList [1..4]))
     4960
  • (mayoritarios f) es la lista de elementos que pertenecen al menos a la mitad de los conjuntos de la familia f. Por ejemplo,
     mayoritarios (fromList [empty, fromList [1,3], fromList [3,5]]) == [3]
     mayoritarios (fromList [empty, fromList [1,3], fromList [4,5]]) == []
  • (conjeturaFrankl n) se verifica si para toda familia f formada por elementos del conjunto {1,2,…,n} no vacía, estable por uniones y distinta de {∅} posee algún elemento que pertenece al menos a la mitad de los conjuntos de f. Por ejemplo.
     conjeturaFrankl 2  ==  True
     conjeturaFrankl 3  ==  True
     conjeturaFrankl 4  ==  True

Soluciones

import Data.Set  as S ( Set
                      , delete
                      , deleteFindMin
                      , empty
                      , filter
                      , fromList
                      , insert
                      , map
                      , member
                      , null
                      , singleton
                      , size
                      , toList
                      , union
                      , unions
                      )
import Data.List as L ( filter
                      , null
                      )
 
esEstable :: Ord a => Set (Set a) -> Bool
esEstable xss =
  and [ys `S.union` zs `member` xss | (ys,yss) <- selecciones xss
                                    , zs <- toList yss]
 
-- (seleccciones xs) es la lista de los pares formada por un elemento de
-- xs y los restantes elementos. Por ejemplo,
--    λ> selecciones (fromList [3,2,5])
--    [(2,fromList [3,5]),(3,fromList [2,5]),(5,fromList [2,3])]
selecciones :: Ord a => Set a -> [(a,Set a)]
selecciones xs =
  [(x,delete x xs) | x <- toList xs] 
 
familiasEstables :: Ord a => Set a -> Set (Set (Set a))
familiasEstables xss =
  S.filter esEstable (familias xss)
 
-- (familias c) es la familia formadas con elementos de c. Por ejemplo,
--    λ> mapM_ print (familias (fromList [1,2]))
--    fromList []
--    fromList [fromList []]
--    fromList [fromList [],fromList [1]]
--    fromList [fromList [],fromList [1],fromList [1,2]]
--    fromList [fromList [],fromList [1],fromList [1,2],fromList [2]]
--    fromList [fromList [],fromList [1],fromList [2]]
--    fromList [fromList [],fromList [1,2]]
--    fromList [fromList [],fromList [1,2],fromList [2]]
--    fromList [fromList [],fromList [2]]
--    fromList [fromList [1]]
--    fromList [fromList [1],fromList [1,2]]
--    fromList [fromList [1],fromList [1,2],fromList [2]]
--    fromList [fromList [1],fromList [2]]
--    fromList [fromList [1,2]]
--    fromList [fromList [1,2],fromList [2]]
--    fromList [fromList [2]]
--    λ> size (familias (fromList [1,2]))
--    16
--    λ> size (familias (fromList [1,2,3]))
--    256
--    λ> size (familias (fromList [1,2,3,4]))
--    65536
familias :: Ord a => Set a -> Set (Set (Set a))
familias c =
  subconjuntos (subconjuntos c)
 
-- (subconjuntos c) es el conjunto de los subconjuntos de c. Por ejemplo,
--    λ> mapM_ print (subconjuntos (fromList [1,2,3]))
--    fromList []
--    fromList [1]
--    fromList [1,2]
--    fromList [1,2,3]
--    fromList [1,3]
--    fromList [2]
--    fromList [2,3]
--    fromList [3]
subconjuntos :: Ord a => Set a -> Set (Set a)
subconjuntos c
  | S.null c  = singleton empty
  | otherwise = S.map (insert x) sr `union` sr
  where (x,rc) = deleteFindMin c
        sr     = subconjuntos rc
 
-- (elementosFamilia f) es el conjunto de los elementos de los elementos
-- de la familia f. Por ejemplo, 
--    λ> elementosFamilia (fromList [empty, fromList [1,2], fromList [2,5]])
--    fromList [1,2,5]
elementosFamilia :: Ord a => Set (Set a) -> Set a
elementosFamilia = unions . toList
 
-- (nOcurrencias f x) es el número de conjuntos de la familia f a los
-- que pertenece el elemento x. Por ejemplo,
--    nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 3 == 2
--    nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 4 == 0
--    nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 5 == 1
nOcurrencias :: Ord a => Set (Set a) -> a -> Int
nOcurrencias f x =
  length (L.filter (x `member`) (toList f))
 
mayoritarios :: Ord a => Set (Set a) -> [a]
mayoritarios f =
  [x | x <- toList (elementosFamilia f)
     , nOcurrencias f x >= n]
  where n = (1 + size f) `div` 2
 
conjeturaFrankl :: Int -> Bool
conjeturaFrankl n =
  and [ not (L.null (mayoritarios f))
      | f <- fs
      , f /= fromList []
      , f /= fromList [empty]]
  where fs = toList (familiasEstables (fromList [1..n]))
 
 
-- conjeturaFrankl' :: Int -> Bool
conjeturaFrankl' n =
  [f | f <- fs
     , L.null (mayoritarios f)
     , f /= fromList []
     , f /= fromList [empty]]
  where fs = toList (familiasEstables (fromList [1..n]))

Pensamiento

Pero tampoco es razón
desdeñar
consejo que es confesión.

Antonio Machado