Menu Close

Etiqueta: map

Teorema de la amistad

El teorema de la amistad afirma que

En cualquier reunión de n personas hay al menos dos personas que tienen el mismo número de amigos (suponiendo que la relación de amistad es simétrica).

Se pueden usar las siguientes representaciones:

  • números enteros para representar a las personas,
  • pares de enteros (x,y), con x < y, para representar que la persona x e y son amigas y
  • lista de pares de enteros para representar la reunión junto con las relaciones de amistad.

Por ejemplo, [(2,3),(3,5)] representa una reunión de tres personas
(2, 3 y 5) donde

  • 2 es amiga de 3,
  • 3 es amiga de 2 y 5 y
  • 5 es amiga de 3.
    Si clasificamos las personas poniendo en la misma clase las que tienen el mismo número de amigos, se obtiene [[2,5],[3]] ya que 2 y 5 tienen 1 amigo y 3 tiene 2 amigos.

Definir la función

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

tal que (clasesAmigos r) es la clasificación según el número de amigos de las personas de la reunión r; es decir, la lista cuyos elementos son las listas de personas con 1 amigo, con 2 amigos y así hasta que se completa todas las personas de la reunión r. Por ejemplo,

   clasesAmigos [(2,3),(3,5)]            ==  [[2,5],[3]]
   clasesAmigos [(2,3),(4,5)]            ==  [[2,3,4,5]]
   clasesAmigos [(2,3),(2,5),(3,5)]      ==  [[2,3,5]]
   clasesAmigos [(2,3),(3,4),(2,5)]      ==  [[4,5],[2,3]]
   clasesAmigos [(x,x+1) | x <- [1..5]]  ==  [[1,6],[2,3,4,5]]
   length (clasesAmigos [(x,x+1) | x <- [1..2020]]) == 2

Comprobar con QuickCheck el teorema de la amistad; es decir, si r es una lista de pares de enteros, entonces (clasesAmigos r’) donde r’ es la lista de los pares (x,y) de r con x < y y se supone que r’ es no vacía.

Soluciones

import Data.List (nub, sort)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
clasesAmigos :: [(Int,Int)] -> [[Int]]
clasesAmigos ps =
  filter (not . null)
         [[x | x <- xs, numeroDeAmigos ps x == n] | n <- [1..length xs]] 
  where xs = personas ps
 
-- (personas ps) es la lista de personas en la reunión ps. Por ejemplo,
--    personas [(2,3),(3,5)]  ==  [2,3,5]
personas :: [(Int,Int)] -> [Int]
personas ps = sort (nub (map fst ps ++ map snd ps))
 
-- (numeroDeAmigos ps x) es el número de amigos de x en la reunión
-- ps. Por ejemplo, 
--    numeroDeAmigos [(2,3),(3,5)] 2  ==  1
--    numeroDeAmigos [(2,3),(3,5)] 3  ==  2
--    numeroDeAmigos [(2,3),(3,5)] 5  ==  1
numeroDeAmigos :: [(Int,Int)] -> Int -> Int
numeroDeAmigos ps x = length (amigos ps x)
 
-- (amigos ps x) es la lista de los amigos de x en la reunión ps. Por
-- ejemplo, 
--    amigos [(2,3),(3,5)] 2  ==  [3]
--    amigos [(2,3),(3,5)] 3  ==  [5,2]
--    amigos [(2,3),(3,5)] 5  ==  [3]
amigos :: [(Int,Int)] -> Int -> [Int]
amigos ps x =
  nub ([b | (a,b) <- ps, a == x] ++ [a | (a,b) <- ps, b == x])
 
-- 2ª solución
-- ===========
 
clasesAmigos2 :: [(Int,Int)] -> [[Int]]
clasesAmigos2 = clases . sort . tablaAmigos
  where
    clases [] = []
    clases ps@((x,y):ps') = (map snd (takeWhile (\(a,b) -> a == x) ps)) :
                            clases (dropWhile (\(a,b) -> a == x) ps')
 
-- (tablaAmigos ps) es la lista de pares (a,b) tales que b es una
-- persona de la reunión ps y a es su número de amigos. Por ejemplo,
--    tablaAmigos [(2,3),(3,5)]   ==  [(1,2),(2,3),(1,5)]
tablaAmigos :: [(Int,Int)] -> [(Int,Int)]
tablaAmigos ps = [(numeroDeAmigos ps x,x) | x <- personas ps]
 
-- Equivalencia de las definiciones
-- ================================
 
-- La propiedad es
prop_equivalencia :: [(Int,Int)] -> Property
prop_equivalencia ps =
  not (null ps')
  ==> 
  clasesAmigos ps' == clasesAmigos2 ps'
  where ps' = [(x,y) | (x,y) <- ps, x < y]
 
-- La comprobación es
--    λ> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.
--    (1.06 secs, 337,106,752 bytes)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> length (clasesAmigos [(x,x+1) | x <- [1..200]]) 
--    2
--    (2.37 secs, 804,402,848 bytes)
--    λ> length (clasesAmigos2 [(x,x+1) | x <- [1..200]]) 
--    2
--    (0.02 secs, 4,287,256 bytes)
 
-- El teorema de la amistad
-- ========================
 
-- La propiedad es
teoremaDeLaAmistad :: [(Int,Int)] -> Property
teoremaDeLaAmistad ps =
  not (null ps')
  ==> 
  not (null [xs | xs <- clasesAmigos2 ps', length xs > 1])
  where ps' = [(x,y) | (x,y) <- ps, x < y]
 
-- La comprobación es
--    λ> quickCheck teoremaDeLaAmistad
--    +++ OK, passed 100 tests.

Referencia

Pensamiento

Me dijo el agua clara que reía,
bajo el sol, sobre el mármol de la fuente:
si te inquieta el enigma del presente
aprende el son de la salmodia mía.

Antonio Machado

Teorema de Hilbert-Waring

El problema de Waring, propuesto por Edward Waring consiste en déterminar si, para cada número entero k mayor que 1, existe un número n tal que todo entero positivo se puede escribir como una suma de k-potencias de números positivos con n sumandos como máximo.

La respuesta afirmativa al problema, aportada por David Hilbert, se conoce como el teorema de Hilbert-Waring. Su enunciado es

Para cada número entero k, con k ≥ 2, existe un entero positivo g(k) tal que todo entero positivo se puede expresar como una suma de a lo más g(k) k-ésimas potencias.

Definir las funciones

   descomposiciones :: Integer -> Integer -> Integer -> [[Integer]]
   orden :: Integer -> Integer -> Integer

tales que

  • (descomposiciones x k n) es la lista de descomposiciones de x como suma de n potencias con exponente k de números enteros positivos.
     descomposiciones 9   2 1  ==  [[9]]
     descomposiciones 9   3 1  ==  []
     descomposiciones 9   3 2  ==  [[1,8]]
     descomposiciones 9   4 9  ==  [[1,1,1,1,1,1,1,1,1]]
     descomposiciones 25  2 2  ==  [[9,16]]
     descomposiciones 133 2 3  ==  [[8,125]]
     descomposiciones 38  3 2  ==  [[1,1,36],[4,9,25]]
  • (orden x k) es el menor número de sumandos necesario para expresar x como suma de k-ésimas potencias. Por ejemplo,
     orden 9  2  ==  1
     orden 9  3  ==  2
     orden 9  4  ==  9
     orden 10 2  ==  2
     orden 10 3  ==  3
     orden 10 4  ==  10
     [maximum [orden x k | x <- [1..1000]] | k <- [1..6]] == [1,4,9,19,37,73]

Comprobar el teorema de Hilbert-Waring para k hasta 7; es decir, para todo número x positivo se verifica que

   orden x 2 <= 4   
   orden x 3 <= 9   
   orden x 4 <= 19  
   orden x 5 <= 37  
   orden x 6 <= 73  
   orden x 7 <= 143

y, en general,

   orden x k <= 2^k + floor ((3/2)^k) - 2

Soluciones

import Test.QuickCheck
 
descomposiciones :: Integer -> Integer -> Integer -> [[Integer]]
descomposiciones x k n =
  sumas x (takeWhile (<= x) (potencias k)) n
 
-- (potencias n) es la lista de las potencias de n
--    take 7 (potencias 2)  ==  [1,4,9,16,25,36,49]
--    take 7 (potencias 3)  ==  [1,8,27,64,125,216,343]
potencias :: Integer -> [Integer]
potencias n = map (^n) [1..]
 
-- (sumas n ys x) es la lista de las descomposiciones de x como
-- sumas de n sumandos de la lista creciente ys. Por ejemplo,
--    sumas 3 [1,2] 2  ==  [[1,2]]
--    sumas 4 [1,2] 2  ==  [[2,2]]
--    sumas 5 [1,2] 2  ==  []
--    sumas 5 [1,2] 3  ==  [[1,2,2]]
--    sumas 6 [1,2] 3  ==  [[2,2,2]]
--    sumas 6 [1,2,5] 2  ==  [[1,5]]
sumas :: Integer -> [Integer] -> Integer -> [[Integer]]
sumas _ [] _                   = []
sumas x ys 1     | x `elem` ys = [[x]]
                 | otherwise   = []
sumas x (y:ys) n | y > x       = []
                 | otherwise   = map (y:) (sumas (x-y) (y:ys) (n-1)) ++
                                 sumas x ys n
 
orden :: Integer -> Integer -> Integer
orden x k = head [n | n <- [1..]
                    , not (null (descomposiciones x k n))]
 
-- El teorema es                                 
teorema_Hilbert_Waring :: Integer -> Integer -> Property
teorema_Hilbert_Waring x k =
  x > 0 && k >= 2
  ==>
  orden x 2 <= 4   &&
  orden x 3 <= 9   &&
  orden x 4 <= 19  &&
  orden x 5 <= 37  &&
  orden x 6 <= 73  &&
  orden x 7 <= 143 &&
  orden x k <= 2^k + floor ((3/2)^k) - 2
 
-- La comprobación es
--    λ> quickCheck teorema_Hilbert_Waring
--    +++ OK, passed 100 tests.

Referencia

Pensamiento

¡Y en la tersa arena,
cerca de la mar,
tu carne rosa y morena,
súbitamente Guiomar!

Antonio Machado

Teorema de Liouville sobre listas CuCu

Una lista CuCu es una lista de números enteros positivos tales que la suma de sus Cubos es igual al Cuadrado de su suma. Por ejemplo, [1, 2, 3, 2, 4, 6] es una lista CuCu ya que

   1³ + 2³ + 3³ + 2³ + 4³ + 6³ = (1 + 2 + 3 + 2 + 4 + 6)²

La lista de Liouville correspondiente al número entero positivo n es la lista formada por el número de divisores de cada divisor de n. Por ejemplo, para el número 20 se tiene que sus divisores son

   1, 2, 4, 5, 10, 20

puesto que el número de sus divisores es

  • El 1 tiene 1 divisor (el 1 solamente).
  • El 2 tiene 2 divisores (el 1 y el 2).
  • El 4 tiene 3 divisores (el 1, el 2 y el 4).
  • El 5 tiene 2 divisores (el 1 y el 5).
  • El 10 tiene 4 divisores (el 1, el 2, el 5 y el 10).
  • El 20 tiene 6 divisores (el 1, el 2, el 4, el 5, el 10 y el 20).

la lista de Liouville de 20 es [1, 2, 3, 2, 4, 6] que, como se comentó anteriormente, es una lista CuCu.

El teorema de Lioville afirma que todas las lista de Lioville son CuCu.

Definir las funciones

   esCuCu :: [Integer] -> Bool
   liouville :: Integer -> [Integer]

tales que

  • (esCuCu xs) se verifica si la lista xs es CuCu; es decir, la suma de los cubos de sus elementos es igual al cuadrado de su suma. Por ejemplo,
     esCuCu [1,2,3]        ==  True
     esCuCu [1,2,3,2]      ==  False
     esCuCu [1,2,3,2,4,6]  ==  True
  • (liouville n) es la lista de Lioville correspondiente al número n. Por ejemplo,
     liouville 20  ==  [1,2,3,2,4,6]
     liouville 60  ==  [1,2,2,3,2,4,4,6,4,6,8,12]
     length (liouville (product [1..25]))  ==  340032

Comprobar con QuickCheck

  • que para todo entero positivo n, (liouville (2^n)) es la lista [1,2,3,…,n+1] y
  • el teorema de Lioville; es decir, para todo entero positivo n, (liouville n) es una lista CuCu.

Nota: Este ejercicio está basado en Cómo generar conjuntos CuCu de Gaussianos.

Soluciones

import Data.List (genericLength, group, inits, sort)
import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck
 
esCuCu :: [Integer] -> Bool
esCuCu xs = sum (map (^3) xs) == (sum xs)^2
 
-- 1ª definición de liouville
-- ==========================
 
liouville :: Integer -> [Integer]
liouville n = map numeroDivisores (divisores n)
 
-- (divisores x) es el conjunto de divisores de los x. Por ejemplo, 
--   divisores 30  ==  [1,2,3,5,6,10,15,30]
divisores :: Integer -> [Integer]
divisores n = [x | x <- [1..n], n `mod` x == 0]
 
-- (numeroDivisores x) es el número de divisores de x. Por ejemplo, 
--    numeroDivisores 12  ==  6
--    numeroDivisores 25  ==  3
numeroDivisores :: Integer -> Integer
numeroDivisores n = genericLength (divisores n) 
 
  -- 2ª definición de liouville
-- ============================
 
liouville2 :: Integer -> [Integer]
liouville2 n = map numeroDivisores2 (divisores2 n)
 
-- Se usan las funciones
-- + divisores de "Conjunto de divisores" http://bit.ly/2OtbFIj
-- + numeroDivisores de "Número de divisores" http://bit.ly/2DgVh74
 
-- (divisores2 x) es el conjunto de divisores de los x. Por ejemplo, 
--   divisores2 30  ==  [1,2,3,5,6,10,15,30]
divisores2 :: Integer -> [Integer]
divisores2 = sort
           . map (product . concat)
           . sequence
           . map inits
           . group
           . primeFactors
 
-- (numeroDivisores2 x) es el número de divisores de x. Por ejemplo, 
--    numeroDivisores2 12  ==  6
--    numeroDivisores2 25  ==  3
numeroDivisores2 :: Integer -> Integer
numeroDivisores2 =
  product . map ((+1) . genericLength) . group . primeFactors
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> length (liouville (product [1..11]))
--    540
--    (13.66 secs, 7,983,550,640 bytes)
--    λ> length (liouville2 (product [1..11]))
--    540
--    (0.01 secs, 1,255,328 bytes)
 
-- Propiedad
-- =========
 
-- La propiedad es
prop_Liouville :: Integer -> Property
prop_Liouville n =
  n > 0 ==> liouville2 (2^n) == [1..n+1]
 
-- La comprobación es
--    λ> quickCheck prop_Liouville
--    +++ OK, passed 100 tests.
 
-- Teorema de Liouville
-- ====================
 
-- La propiedad es
teorema_Liouville :: Integer -> Property
teorema_Liouville n =
  n > 0 ==> esCuCu (liouville n)
 
-- La comprobación es
--    λ> quickCheck teorema_Liouville
--    +++ OK, passed 100 tests.

Pensamiento

¡Oh, tarde viva y quieta
que opuso al panta rhei su nada corre.

Antonio Machado

Enumeración de conjuntos finitos de naturales

Los conjuntos finitos de números naturales se pueden enumerar como sigue

    0: []
    1: [0]
    2: [1]
    3: [1,0]
    4: [2]
    5: [2,0]
    6: [2,1]
    7: [2,1,0]
    8: [3]
    9: [3,0]
   10: [3,1]
   11: [3,1,0]
   12: [3,2]
   13: [3,2,0]
   14: [3,2,1]
   15: [3,2,1,0]
   16: [4]
   17: [4,0]
   18: [4,1]
   19: [4,1,0]

en la que los elementos están ordenados de manera decreciente.

Definir la constante

   enumeracionCFN :: [[Integer]]

tal que sus elementos son los conjuntos de los números naturales con la ordenación descrita anteriormente. Por ejemplo,

   λ> take 20 enumeracionCFN
   [[],
    [0],
    [1],[1,0],
    [2],[2,0],[2,1],[2,1,0],
    [3],[3,0],[3,1],[3,1,0],[3,2],[3,2,0],[3,2,1],[3,2,1,0],
    [4],[4,0],[4,1],[4,1,0]]

Comprobar con QuickCheck que

  • si (xs,ys) es un par de elementos consecutivos de enumeracionCFN, entonces xs < ys;
  • todo conjunto finito de números naturales, representado por una lista decreciente, está en enumeracionCFN.

Soluciones

import Data.List (genericLength, nub, sort)
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
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
-- ===========
 
enumeracionCFN2 :: [[Integer]]
enumeracionCFN2 = [] : aux 0 [[]]
  where aux n xs = yss ++ aux (n+1) (xs ++ yss)
          where yss = map (n:) xs
 
-- 3ª solución
-- ===========
 
enumeracionCFN3 :: [[Integer]]
enumeracionCFN3 = map conjunto [0..]
 
-- (conjunto n) es el conjunto en la posición n. Por ejemplo,
--   conjunto 6  ==  [2,1]
conjunto :: Integer -> [Integer]
conjunto n = reverse [x | (x,y) <- zip [0..] (binario n), y == 1]
 
-- (binario n) es la representación binarioa del número n (en orden
-- inverso). Por ejemplo,
--   binario 6  ==  [0,1,1]
binario :: Integer -> [Integer]
binario 0 = [0]
binario 1 = [1]
binario n = n `mod` 2 : binario (n `div` 2)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> enumeracionCFN !! (4*10^5)
--    [18,17,12,11,9,7]
--    (1.18 secs, 576,924,344 bytes)
--    λ> enumeracionCFN2 !! (4*10^5)
--    [18,17,12,11,9,7]
--    (0.10 secs, 72,399,784 bytes)
--    λ> enumeracionCFN3 !! (4*10^5)
--    [18,17,12,11,9,7]
--    (0.07 secs, 64,123,952 bytes)
--
--    λ> enumeracionCFN2 !! (6*10^6)
--    [22,20,19,17,16,15,11,10,8,7]
--    (1.25 secs, 1,082,690,216 bytes)
--    λ> enumeracionCFN3 !! (6*10^6)
--    [22,20,19,17,16,15,11,10,8,7]
--    (0.38 secs, 960,134,256 bytes)
 
-- Propiedades
-- ===========
 
-- La primera propiedad es
prop_enumeracionCFN :: Int -> Property
prop_enumeracionCFN n =
  n >= 0 ==> xs < ys
  where (xs:ys:_) = drop n enumeracionCFN
 
-- La comprobación es
--    λ> quickCheck prop_enumeracionCFN
--    +++ OK, passed 100 tests.
 
-- La segunda propiedad es
prop_completa :: [Integer] -> Bool
prop_completa xs =
  xs' `elem` enumeracionCFN
  where xs' = reverse (sort (nub (map abs xs)))
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=15}) prop_completa
--    +++ OK, passed 100 tests.

Pensamiento

Junto al agua fría,
en la senda clara,
sombra dará algún día,
ese arbolillo en que nadie repara.

Antonio Machado

Cálculo de pi usando la fórmula de Vieta

La fórmula de Vieta para el cálculo de pi es la siguiente
Calculo_de_pi_usando_la_formula_de_Vieta

Definir las funciones

   aproximacionPi :: Int -> Double
   errorPi :: Double -> Int

tales que

  • (aproximacionPi n) es la aproximación de pi usando n factores de la fórmula de Vieta. Por ejemplo,
     aproximacionPi  5  ==  3.140331156954753
     aproximacionPi 10  ==  3.1415914215112
     aproximacionPi 15  ==  3.141592652386592
     aproximacionPi 20  ==  3.1415926535886207
     aproximacionPi 25  ==  3.141592653589795
  • (errorPi x) es el menor número de factores de la fórmula de Vieta necesarios para obtener pi con un error menor que x. Por ejemplo,
     errorPi 0.1        ==  2
     errorPi 0.01       ==  4
     errorPi 0.001      ==  6
     errorPi 0.0001     ==  7
     errorPi 1e-4       ==  7
     errorPi 1e-14      ==  24
     pi                 ==  3.141592653589793
     aproximacionPi 24  ==  3.1415926535897913

Soluciones

-- 1ª definición de aproximacionPi
aproximacionPi :: Int -> Double
aproximacionPi n = product [2 / aux x | x <- [0..n]]
  where
    aux 0 = 1
    aux 1 = sqrt 2
    aux n = sqrt (2 + aux (n-1))
 
-- 2ª definición de aproximacionPi
aproximacionPi2 :: Int -> Double
aproximacionPi2 n = product [2/x | x <- 1 : xs] 
  where xs = take n $ iterate (\x -> sqrt (2+x)) (sqrt 2)
 
-- 3ª definición de aproximaxionPi
aproximacionPi3 :: Int -> Double
aproximacionPi3 n =  product (2 : take n (map (2/) xs))
  where xs = sqrt 2 : [sqrt (2 + x) | x <- xs]
 
-- 1ª definición de errorPi
errorPi :: Double -> Int
errorPi x = head [n | n <- [1..]
                    , abs (pi - aproximacionPi n) < x]
 
-- 2ª definición de errorPi
errorPi2 :: Double -> Int
errorPi2 x = until aceptable (+1) 1
  where aceptable n = abs (pi - aproximacionPi n) < x

Pensamiento

El tiempo que la barba me platea,
cavó mis ojos y agrandó mi frente,
va siendo en mi recuerdo transparente,
y mientras más al fondo, más clarea.

Antonio Machado