Menu Close

Etiqueta: or

Conjetura de Goldbach

Una forma de la conjetura de Golbach afirma que todo entero mayor que 1 se puede escribir como la suma de uno, dos o tres números primos.

Si se define el índice de Goldbach de n > 1 como la mínima cantidad de primos necesarios para que su suma sea n, entonces la conjetura de Goldbach afirma que todos los índices de Goldbach de los enteros mayores que 1 son menores que 4.

Definir las siguientes funciones

   indiceGoldbach  :: Int -> Int
   graficaGoldbach :: Int -> IO ()

tales que

  • (indiceGoldbach n) es el índice de Goldbach de n. Por ejemplo,
     indiceGoldbach 2                        ==  1
     indiceGoldbach 4                        ==  2
     indiceGoldbach 27                       ==  3
     sum (map indiceGoldbach [2..5000])      ==  10619
     maximum (map indiceGoldbach [2..5000])  ==  3
  • (graficaGoldbach n) dibuja la gráfica de los índices de Goldbach de los números entre 2 y n. Por ejemplo, (graficaGoldbach 150) dibuja
    Conjetura_de_Goldbach_150

Comprobar con QuickCheck la conjetura de Goldbach anterior.

Soluciones

import Data.Array
import Data.Numbers.Primes
import Graphics.Gnuplot.Simple
import Test.QuickCheck
 
 
-- 1ª definición
-- =============
 
indiceGoldbach :: Int -> Int
indiceGoldbach n =
  minimum (map length (particiones n))
 
particiones :: Int -> [[Int]]
particiones n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
    where f 0 = [[]]
          f m = [x:y | x <- xs, 
                       y <- v ! (m-x), 
                       [x] >= take 1 y]
            where xs = reverse (takeWhile (<= m) primes)
 
-- 2ª definición
-- =============
 
indiceGoldbach2 :: Int -> Int
indiceGoldbach2 x =
  head [n | n <- [1..], esSumaDe x n]
 
-- (esSumaDe x n) se verifica si x se puede escribir como la suma de n
-- primos. Por ejemplo,
--    esSumaDe 2  1  ==  True
--    esSumaDe 4  1  ==  False
--    esSumaDe 4  2  ==  True
--    esSumaDe 27 2  ==  False
--    esSumaDe 27 3  ==  True
esSumaDe :: Int -> Int -> Bool
esSumaDe x 1 = isPrime x
esSumaDe x n = or [esSumaDe (x-p) (n-1) | p <- takeWhile (<= x) primes]
 
-- 3ª definición
-- =============
 
indiceGoldbach3 :: Int -> Int
indiceGoldbach3 x =
  head [n | n <- [1..], esSumaDe3 x n]
 
esSumaDe3 :: Int -> Int -> Bool
esSumaDe3 x n = a ! (x,n) where
  a = array ((2,1),(x,9)) [((i,j),f i j) | i <- [2..x], j <- [1..9]]
  f i 1 = isPrime i
  f i j = or [a!(i-k,j-1) | k <- takeWhile (<= i) primes]
 
-- 4ª definición
-- =============
 
indiceGoldbach4 :: Int -> Int
indiceGoldbach4 n = v ! n where
  v = array (2,n) [(i,f i) | i <- [2..n]]
  f i | isPrime i = 1
      | otherwise = 1 + minimum [v!(i-p) | p <- takeWhile (< (i-1)) primes]
 
-- Comparación de eficiencia
-- =========================
 
--    λ> sum (map indiceGoldbach [2..80])
--    142
--    (2.66 secs, 1,194,330,496 bytes)
--    λ> sum (map indiceGoldbach2 [2..80])
--    142
--    (0.01 secs, 1,689,944 bytes)
--    λ> sum (map indiceGoldbach3 [2..80])
--    142
--    (0.03 secs, 27,319,296 bytes)
--    λ> sum (map indiceGoldbach4 [2..80])
--    142
--    (0.03 secs, 47,823,656 bytes)
--    
--    λ> sum (map indiceGoldbach2 [2..1000])
--    2030
--    (0.10 secs, 200,140,264 bytes)
--    λ> sum (map indiceGoldbach3 [2..1000])
--    2030
--    (3.10 secs, 4,687,467,664 bytes)
 
-- Gráfica
-- =======
 
graficaGoldbach :: Int -> IO ()
graficaGoldbach n =
  plotList [ Key Nothing
           , XRange (2,fromIntegral n)
           , PNG ("Conjetura_de_Goldbach_" ++ show n ++ ".png")
           ]
           [indiceGoldbach2 k | k <- [2..n]]
 
-- Comprobación de la conjetura de Goldbach
-- ========================================
 
-- La propiedad es
prop_Goldbach :: Int -> Property
prop_Goldbach x =
  x >= 2 ==> indiceGoldbach2 x < 4
 
-- La comprobación es
--    λ> quickCheck prop_Goldbach
--    +++ OK, passed 100 tests.

Otras soluciones

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

Pensamiento

“La diferencia entre los matemáticos y los físicos es que después de que los físicos prueban un gran resultado piensan que es fantástico, pero después de que los matemáticos prueban un gran resultado piensan que es trivial.”

Lucien Szpiro.

Evaluación de FNC (fórmulas en forma normal conjuntiva)

Una FNC (fórmula en forma normal conjuntiva) es una conjunción de cláusulas, donde una cláusula es una disyunción de literales y un literal es un átomo o su negación. Por ejemplo,

   (x(1) v -x(3)) & x(2) & (-x(2) v x(3) v x(1))

es una FNC con tres clásulas tales que la primera cláusula tiene 2 literales (x(1) y -x(3)), la segunda tiene 1 (x(2)) y la tercera tiene 3 (-x(2), x(3) y x(1)).

Usaremos las siguientes representaciones:

  • Los átomos se representan por enteros positivos. Por ejemplo, 3 representa x(3).
  • Los literales se representan por enteros. Por ejemplo, 3 representa el literal positivo x(3) y -5 el literal negativo -x(5).
  • Una cláusula es una lista de literales que representa la disyunción se sus literales. Por ejemplo, [3,2,-4] representa a (x(3) v x(2) v -x(4)).
  • Una fórmula en forma normal conjuntiva (FNC) es una lista de cláusulas que representa la conjunción de sus cláusulas. Por ejemplo, [[3,2],[-1,2,5]] representa a ((x(3) v x(2)) & (-x(1) v x(2) v x(5))).

Una interpretación I es un conjunto de átomos. Se supone que los átomos de I son verdaderos y los restantes son falsos. Por ejemplo, en la interpretación [2,5]

  • el literal x(2) es verdadero (porque 2 ∈ [2,5])
  • el literal x(3) es falso (porque 3 ∉ [2,5])
  • el literal -x(4) es verdadero (porque 4 ∉ [2,5])
  • la cláusula (x(2) v x(3)) es verdadera (porque x(2) es verdadero)
  • la cláusula (x(3) v x(4)) es falsa (porque x(3) y x(4) son falsos)
  • la FNC ((x(2) v x(5)) & (-x(4) v x(3)) es verdadera porque lo son sus dos cláusulas

En el ejercicio se usarán los siguientes tipos de datos

   type Atomo          = Int
   type Literal        = Int
   type Clausula       = [Literal]
   type FNC            = [Clausula]
   type Interpretacion = [Atomo]

Definir las siguientes funciones

   valorLiteral  :: Interpretacion -> Literal -> Bool
   valorClausula :: Interpretacion -> Clausula -> Bool
   valor         :: Interpretacion -> FNC -> Bool

tales que

  • (valorLiteral i l) es el valor del literal l en la interpretación i. Por ejemplo,
     valorLiteral [3,5] 3     ==  True
     valorLiteral [3,5] 4     ==  False
     valorLiteral [3,5] (-3)  ==  False
     valorLiteral [3,5] (-4)  ==  True
  • (valorClausula i c) es el valor de la cláusula c en la interpretación i. Por ejemplo,
     valorClausula [3,5] [2,3,-5]  ==  True
     valorClausula [3,5] [2,4,-1]  ==  True
     valorClausula [3,5] [2,4,1]   ==  False
  • (valor i f) es el valor de la fórmula en FNC f en la interpretación i. Por ejemplo,
     valor [1,3] [[1,-2],[3]]  ==  True
     valor [1]   [[1,-2],[3]]  ==  False
     valor [1]   []            ==  True

Nota: Escribir la solución en el módulo Evaluacion_de_FNC para poderlo usar en los siguientes ejercicios.

Soluciones

module Evaluacion_de_FNC where
 
type Atomo          = Int
type Literal        = Int
type Clausula       = [Literal]
type FNC            = [Clausula]
type Interpretacion = [Atomo]
 
-- Definición de valorLiteral
-- ==========================
 
valorLiteral :: Interpretacion -> Literal -> Bool
valorLiteral i l
  | l > 0     = l `elem` i
  | otherwise = negate l `notElem` i
 
-- Definiciones de valorClausula
-- =============================
 
-- 1ª definición
valorClausula :: Interpretacion -> Clausula -> Bool
valorClausula i c = or [valorLiteral i l | l <- c]
 
-- 2ª definición
valorClausula2 :: Interpretacion -> Clausula -> Bool
valorClausula2 i = any (valorLiteral i)
 
-- Definiciones de valor de FNC
-- ============================
 
-- 1ª definición
valor :: Interpretacion -> FNC -> Bool
valor i f = and [valorClausula i c | c <- f]
 
-- 2ª definición
valor2 :: Interpretacion -> FNC -> Bool
valor2 i = all (valorClausula i)

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang=”haskell”> y otra con </pre>

Pensamiento

“Todo buen matemático es al menos medio filósofo, y todo buen filósofo es al menos medio matemático.”

Gottlob Frege.

La conjetura de Mertens

Un número entero n es libre de cuadrados si no existe un número primo p tal que p² divide a n; es decir, los factores primos de n son todos distintos.

La función de Möbius μ(n) está definida para todos los enteros positivos como sigue:

  • μ(n) = 1 si n es libre de cuadrados y tiene un número par de factores primos.
  • μ(n) = -1 si n es libre de cuadrados y tiene un número impar de factores primos.
  • μ(n) = 0 si n no es libre de cuadrados.

Sus primeros valores son 1, -1, -1, 0, -1, 1, -1, 0, 0, 1, …

La función de Mertens M(n) está definida para todos los enteros positivos como la suma de μ(k) para 1 ≤ k ≤ n. Sus primeros valores son 1, 0, -1, -1, -2, -1, -2, -2, …

La conjetura de Mertens afirma que

Para todo entero x mayor que 1, el valor absoluto de la función de Mertens en x es menor que la raíz cuadrada de x.

La conjetura fue planteada por Franz Mertens en 1897. Riele Odlyzko, demostraronen 1985 que la conjetura de Mertens deja de ser cierta más o menos a partir de 10^{10^{64}}, cifra que luego de algunos refinamientos se redujo a 10^{10^{40}}.

Definir las funciones

   mobius :: Integer -> Integer
   mertens :: Integer -> Integer
   graficaMertens :: Integer -> IO ()

tales que

  • (mobius n) es el valor de la función de Möbius en n. Por ejemplo,
     mobius 6   ==  1
     mobius 30  ==  -1
     mobius 12  ==  0
  • (mertens n) es el valor de la función de Mertens en n. Por ejemplo,
     mertens 1     ==  1
     mertens 2     ==  0
     mertens 3     ==  -1
     mertens 5     ==  -2
     mertens 661   ==  -11
     mertens 1403  ==  11
  • (graficaMertens n) dibuja la gráfica de la función de Mertens, la raíz cuadrada y el opuestos de la raíz cuadrada para los n primeros n enteros positivos. Por ejemplo, (graficaMertens 1000) dibuja

Comprobar con QuickCheck la conjetura de Mertens.

Nota: El ejercicio está basado en La conjetura de Merterns y su relación con un número tan raro como extremada y colosalmente grande publicado por @Alvy la semana pasada en Microsiervos.

Soluciones

import Data.Numbers.Primes (primeFactors)
import Test.QuickCheck
import Graphics.Gnuplot.Simple
 
mobius :: Integer -> Integer
mobius n | tieneRepetidos xs = 0
         | otherwise         = (-1)^(length xs)
  where xs = primeFactors n
 
tieneRepetidos :: [Integer] -> Bool
tieneRepetidos xs =
  or [x == y | (x,y) <- zip xs (tail xs)]
 
mertens :: Integer -> Integer
mertens n = sum (map mobius [1..n])
 
-- Definición de graficaMertens
-- ============================
 
graficaMertens :: Integer -> IO ()
graficaMertens n = do
  plotLists [ Key Nothing
            , Title "Conjetura de Mertens"
            , PNG "La_conjetura_de_Mertens.png"
            ]
            [ [mertens k | k <- [1..n]]
            , raices
            , map negate raices
            ]
 
  where
    raices = [ceiling (sqrt k) | k <- [1..fromIntegral n]]
 
-- Conjetura de Mertens
-- ====================
 
-- La conjetura es
conjeturaDeMertens :: Integer -> Property
conjeturaDeMertens n =
  n > 1
  ==>
  abs (mertens n) < ceiling (sqrt n')
  where n' = fromIntegral n
 
-- La comprobación es
--    λ> quickCheck conjeturaDeMertens
--    +++ OK, passed 100 tests.

Otras soluciones

  • Se pueden escribir otras soluciones en los comentarios.
  • El código se debe escribir entre una línea con <pre lang=”haskell”> y otra con </pre>

Pensamiento

“El control de la complejidad es la esencia de la programación informática.”

Brian Kernighan.

Relación definida por una partición

Dos elementos están relacionados por una partición xss si pertenecen al mismo elemento de xss.

Definir la función

   relacionados :: Eq a => [[a]] -> a -> a -> Bool

tal que (relacionados xss y z) se verifica si los elementos y y z están relacionados por la partición xss. Por ejemplo,

   relacionados [[1,3],[2],[9,5,7]] 7 9  ==  True
   relacionados [[1,3],[2],[9,5,7]] 3 9  ==  False
   relacionados [[1,3],[2],[9,5,7]] 4 9  ==  False

Soluciones

import Data.List ((\\), intersect)
 
-- 1ª definición
-- =============
 
relacionados :: Eq a => [[a]] -> a -> a -> Bool
relacionados [] _ _ = False
relacionados (xs:xss) y z
  | y `elem` xs = z `elem` xs
  | otherwise   = relacionados xss y z
 
-- 2ª definición
-- =============
 
relacionados2 :: Eq a => [[a]] -> a -> a -> Bool
relacionados2 xss y z =
  or [elem y xs && elem z xs | xs <- xss]
 
-- 3ª definición
-- =============
 
relacionados3 :: Eq a => [[a]] -> a -> a -> Bool
relacionados3 xss y z =
  or [[y,z] `subconjunto` xs | xs <- xss]
 
-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys; es
-- decir, si todos los elementos de xs pertenecen a ys. Por ejemplo,  
--    subconjunto [3,2,3] [2,5,3,5]  ==  True
--    subconjunto [3,2,3] [2,5,6,5]  ==  False
subconjunto :: Eq a => [a] -> [a] -> Bool
subconjunto xs ys = and [elem x ys | x <- xs]
 
-- 4ª definición
-- =============
 
relacionados4 :: Eq a => [[a]] -> a -> a -> Bool
relacionados4 xss y z =
  any ([y,z] `subconjunto`) xss

Pensamiento

No hay lío político que no sea un trueque, una confusión de máscaras, un mal ensayo de comedia, en que nadie sabe su papel.

Antonio Machado

Conjetura de Goldbach

Una forma de la conjetura de Golbach afirma que todo entero mayor que 1 se puede escribir como la suma de uno, dos o tres números primos.

Si se define el índice de Goldbach de n > 1 como la mínima cantidad de primos necesarios para que su suma sea n, entonces la conjetura de Goldbach afirma que todos los índices de Goldbach de los enteros mayores que 1 son menores que 4.

Definir las siguientes funciones

   indiceGoldbach  :: Int -> Int
   graficaGoldbach :: Int -> IO ()

tales que

  • (indiceGoldbach n) es el índice de Goldbach de n. Por ejemplo,
     indiceGoldbach 2                        ==  1
     indiceGoldbach 4                        ==  2
     indiceGoldbach 27                       ==  3
     sum (map indiceGoldbach [2..5000])      ==  10619
     maximum (map indiceGoldbach [2..5000])  ==  3
  • (graficaGoldbach n) dibuja la gráfica de los índices de Goldbach de los números entre 2 y n. Por ejemplo, (graficaGoldbach 150) dibuja
    Conjetura_de_Goldbach_150

Comprobar con QuickCheck la conjetura de Goldbach anterior.

Soluciones

import Data.Array
import Data.Numbers.Primes
import Graphics.Gnuplot.Simple
import Test.QuickCheck
 
 
-- 1ª definición
-- =============
 
indiceGoldbach :: Int -> Int
indiceGoldbach n =
  minimum (map length (particiones n))
 
particiones :: Int -> [[Int]]
particiones n = v ! n where
  v = array (0,n) [(i,f i) | i <- [0..n]]
    where f 0 = [[]]
          f m = [x:y | x <- xs, 
                       y <- v ! (m-x), 
                       [x] >= take 1 y]
            where xs = reverse (takeWhile (<= m) primes)
 
-- 2ª definición
-- =============
 
indiceGoldbach2 :: Int -> Int
indiceGoldbach2 x =
  head [n | n <- [1..], esSumaDe x n]
 
-- (esSumaDe x n) se verifica si x se puede escribir como la suma de n
-- primos. Por ejemplo,
--    esSumaDe 2  1  ==  True
--    esSumaDe 4  1  ==  False
--    esSumaDe 4  2  ==  True
--    esSumaDe 27 2  ==  False
--    esSumaDe 27 3  ==  True
esSumaDe :: Int -> Int -> Bool
esSumaDe x 1 = isPrime x
esSumaDe x n = or [esSumaDe (x-p) (n-1) | p <- takeWhile (<= x) primes]
 
-- 3ª definición
-- =============
 
indiceGoldbach3 :: Int -> Int
indiceGoldbach3 x =
  head [n | n <- [1..], esSumaDe3 x n]
 
esSumaDe3 :: Int -> Int -> Bool
esSumaDe3 x n = a ! (x,n) where
  a = array ((2,1),(x,9)) [((i,j),f i j) | i <- [2..x], j <- [1..9]]
  f i 1 = isPrime i
  f i j = or [a!(i-k,j-1) | k <- takeWhile (<= i) primes]
 
-- 4ª definición
-- =============
 
indiceGoldbach4 :: Int -> Int
indiceGoldbach4 n = v ! n where
  v = array (2,n) [(i,f i) | i <- [2..n]]
  f i | isPrime i = 1
      | otherwise = 1 + minimum [v!(i-p) | p <- takeWhile (< (i-1)) primes]
 
-- Comparación de eficiencia
-- =========================
 
--    λ> sum (map indiceGoldbach [2..80])
--    142
--    (2.66 secs, 1,194,330,496 bytes)
--    λ> sum (map indiceGoldbach2 [2..80])
--    142
--    (0.01 secs, 1,689,944 bytes)
--    λ> sum (map indiceGoldbach3 [2..80])
--    142
--    (0.03 secs, 27,319,296 bytes)
--    λ> sum (map indiceGoldbach4 [2..80])
--    142
--    (0.03 secs, 47,823,656 bytes)
--    
--    λ> sum (map indiceGoldbach2 [2..1000])
--    2030
--    (0.10 secs, 200,140,264 bytes)
--    λ> sum (map indiceGoldbach3 [2..1000])
--    2030
--    (3.10 secs, 4,687,467,664 bytes)
 
-- Gráfica
-- =======
 
graficaGoldbach :: Int -> IO ()
graficaGoldbach n =
  plotList [ Key Nothing
           , XRange (2,fromIntegral n)
           , PNG ("Conjetura_de_Goldbach_" ++ show n ++ ".png")
           ]
           [indiceGoldbach2 k | k <- [2..n]]
 
-- Comprobación de la conjetura de Goldbach
-- ========================================
 
-- La propiedad es
prop_Goldbach :: Int -> Property
prop_Goldbach x =
  x >= 2 ==> indiceGoldbach2 x < 4
 
-- La comprobación es
--    λ> quickCheck prop_Goldbach
--    +++ OK, passed 100 tests.

Números dorados

Los dígitos del número 2375 se pueden separar en dos grupos de igual tamaño ([7,2] y [5,3]) tales que para los correspondientes números (72 y 53) se verifique que la diferencia de sus cuadrados sea el número original (es decir, 72^2 – 53^2 = 2375).

Un número x es dorado si sus dígitos se pueden separar en dos grupos de igual tamaño tales que para los correspondientes números (a y b) se verifique que la diferencia de sus cuadrados sea el número original (es decir, b^2 – a^2 = x).

Definir la función

   esDorado :: Integer -> Bool

tales que (esDorado x) se verifica si x es un número dorado. Por
ejemplo,

   λ> esDorado 2375
   True
   λ> take 5 [x | x <- [1..], esDorado x]
   [48,1023,1404,2325,2375]

Soluciones

 
import Data.List (permutations)
 
esDorado :: Integer -> Bool
esDorado x =
  even (length (show x)) &&
  or [b^2 - a^2 == x | (a,b) <- particionesNumero x]
 
-- (particiones xs) es la lista de las formas de dividir xs en dos
-- partes de igual longitud (se supone que xs tiene un número par de
-- elementos). Por ejemplo,
--    λ> particiones "abcd"
--    [("ab","cd"),("ba","cd"),("cb","ad"),("bc","ad"),("ca","bd"),
--     ("ac","bd"),("dc","ba"),("cd","ba"),("cb","da"),("db","ca"),
--     ("bd","ca"),("bc","da"),("da","bc"),("ad","bc"),("ab","dc"),
--     ("db","ac"),("bd","ac"),("ba","dc"),("da","cb"),("ad","cb"),
--     ("ac","db"),("dc","ab"),("cd","ab"),("ca","db")]
particiones :: [a] -> [([a],[a])]
particiones xs =
  [splitAt m ys | ys <- permutations xs]
  where m = length xs `div` 2
 
-- (particionesNumero n) es la lista de las formas de dividir n en dos
-- partes de igual longitud (se supone que n tiene un número par de
-- dígitos). Por ejemplo,
--    λ> particionesNumero 1234
--    [(12,34),(21,34),(32,14),(23,14),(31,24),(13,24),(43,21),(34,21),
--     (32,41),(42,31),(24,31),(23,41),(41,23),(14,23),(12,43),(42,13),
--     (24,13),(21,43),(41,32),(14,32),(13,42),(43,12),(34,12),(31,42)]
particionesNumero :: Integer -> [(Integer,Integer)]
particionesNumero n =
  [(read xs,read ys) | (xs,ys) <- particiones (show n)]

Distancia a Erdős

Una de las razones por la que el matemático húngaro Paul Erdős es conocido es por la multitud de colaboraciones que realizó durante toda su carrera, un total de 511. Tal es así que se establece la distancia a Erdős como la distancia que has estado de coautoría con Erdős. Por ejemplo, si eres Paul Erdős tu distancia a Erdős es 0, si has escrito un artículo con Erdős tu distancia es 1, si has escrito un artículo con alguien que ha escrito un artículo con Erdős tu distancia es 2, etc. El objetivo de este problema es definir una función que a partir de una lista de pares de coautores y un número natural n calcular la lista de los matemáticos a una distancia n de Erdős.

Para el problema se considerará la siguiente lista de coautores

   coautores :: [(String,String)]
   coautores =
     [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
      ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
      ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
      ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
      ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
      ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
      ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
      ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
      ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
      ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]

La lista anterior es real y se ha obtenido del artículo Famous trails to Paul Erdős.

Definir la función

   numeroDeErdos :: [(String, String)] -> Int -> [String]

tal que (numeroDeErdos xs n) es la lista de lista de los matemáticos de la
lista de coautores xs que se encuentran a una distancia n de Erdős. Por ejemplo,

   λ> numeroDeErdos coautores 0
   ["Paul Erdos"]
   λ> numeroDeErdos coautores 1
   ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway","A. J. Granville"]
   λ> numeroDeErdos coautores 2
   ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle","B. Mazur"]

Nota: Este ejercicio ha sido propuesto por Enrique Naranjo.

Soluciones

data Arbol a = N a [Arbol a]
             deriving Show 
 
coautores :: [(String,String)]
coautores =
  [("Paul Erdos","Ernst Straus"),("Paul Erdos","Pascual Jordan"),
   ("Paul Erdos","D. Kleitman"),("Albert Einstein","Ernst Straus"),
   ("John von Newmann","David Hilbert"),("S. Glashow","D. Kleitman"),
   ("John von Newmann","Pascual Jordan"), ("David Pines","D. Bohm"),
   ("Albert Einstein","Otto Stern"),("S. Glashow", "M. Gell-Mann"),
   ("Richar Feynman","M. Gell-Mann"),("M. Gell-Mann","David Pines"),
   ("David Pines","A. Bohr"),("Wolfgang Pauli","Albert Einstein"),
   ("D. Bohm","L. De Broglie"), ("Paul Erdos","J. Conway"),
   ("J. Conway", "P. Doyle"),("Paul Erdos","A. J. Granville"),
   ("A. J. Granville","B. Mazur"),("B. Mazur","Andrew Wiles")]
 
-- 1ª solución
-- ===========
 
numeroDeErdos :: [(String, String)] -> Int -> [String]
numeroDeErdos xs n = nivel n (arbolDeErdos xs "Paul Erdos")
 
-- (arbolDeErdos xs a) es el árbol de coautores de a según la lista de
-- coautores xs. Por ejemplo,
--    λ> arbolDeErdos coautores "Paul Erdos"
--    N "Paul Erdos"
--      [N "Ernst Straus"
--         [N "Albert Einstein"
--           [N "Wolfgang Pauli" [],
--            N "Otto Stern" []]],
--          N "Pascual Jordan"
--            [N "John von Newmann"
--               [N "David Hilbert" []]],
--          N "D. Kleitman"
--            [N "S. Glashow"
--               [N "M. Gell-Mann"
--                  [N "Richar Feynman" [],
--                   N "David Pines"
--                     [N "A. Bohr" [],
--                      N "D. Bohm"
--                        [N "L. De Broglie" []]]]]],
--          N "J. Conway"
--            [N "P. Doyle" []],
--             N "A. J. Granville"
--               [N "B. Mazur"
--                  [N "Andrew Wiles" []]]]
arbolDeErdos :: [(String, String)] -> String -> Arbol String
arbolDeErdos xs a =
  N a [arbolDeErdos noColaboradores n | n <- colaboradores]
  where
    colaboradores   = [filtra a (x,y) | (x,y) <- xs, x == a || y == a]
    filtra a (x,y) | a == x    = y
                   | otherwise = x
    noColaboradores = [(x,y) | (x,y) <- xs, x /= a, y /= a]
 
-- (nivel n a) es la lista de los elementos del árbol a en el nivel
-- n. Por ejemplo,      
--    nivel 0 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [3]
--    nivel 1 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [5,7]
--    nivel 2 (N 3 [N 5 [N 6 []], N 7 [N 9 []]])   ==  [6,9]
nivel :: Int -> Arbol a -> [a]
nivel 0 (N a xs) = [a]
nivel n (N a xs) = concatMap (nivel (n-1)) xs
 
-- 2ª solución
-- ===========
 
numeroDeErdos2 :: [(String, String)] -> Int -> [String]
numeroDeErdos2 = auxC ["Paul Erdos"] 
  where
    auxC v xs 0 = v
    auxC v xs x = auxC  (n v) (m v xs) (x-1)
      where n v =     [a | (a,b) <- xs, elem b v] ++
                      [b | (a,b) <- xs, elem a v]
            m ys xs = [(a,b) | (a,b) <- xs
                             , notElem a ys && notElem b ys]
 
-- 3ª solución
-- ===========
 
numeroDeErdos3 :: [(String, String)] -> Int -> [String]
numeroDeErdos3 ps n = (sucCoautores "Paul Erdos" ps) !! n
 
-- (sucCoautores a ps) es la sucesión de coautores de a en ps ordenados
-- por diatancia. Por ejemplo, 
--    λ> take 3 (sucCoautores "Paul Erdos" coautores)
--    [["Paul Erdos"],
--     ["Ernst Straus","Pascual Jordan","D. Kleitman","J. Conway",
--      "A. J. Granville"],
--     ["Albert Einstein","John von Newmann","S. Glashow","P. Doyle",
--      "B. Mazur"]]
--    λ> sucCoautores "Albert Einstein" coautores
--    [["Albert Einstein"],
--     ["Ernst Straus","Otto Stern","Wolfgang Pauli"],
--     ["Paul Erdos"],
--     ["Pascual Jordan","D. Kleitman","J. Conway", "A. J. Granville"],
--     ["John von Newmann","S. Glashow","P. Doyle","B. Mazur"],
--     ["David Hilbert","M. Gell-Mann","Andrew Wiles"],
--     ["David Pines","Richar Feynman"],
--     ["D. Bohm","A. Bohr"],
--     ["L. De Broglie"]]
sucCoautores :: String -> [(String, String)] -> [[String]]
sucCoautores a ps =
  takeWhile (not . null) (map fst (iterate sig ([a], as \\ [a])))
  where as = elementos ps
        sig (xs,ys) = (zs,ys \\ zs)
          where zs = [y | y <- ys
                        , or [elem (x,y) ps || elem (y,x) ps | x <- xs]]
 
-- (elementos ps) es la lista de los elementos de los pares ps. Por
-- ejemplo,
--    elementos [(1,3),(3,2),(1,5)]  ==  [1,3,2,5]
elementos :: Eq a => [(a, a)] -> [a]
elementos = nub . (concatMap (\(x,y) -> [x,y]))

Conflictos de horarios

Los horarios de los cursos se pueden representar mediante matrices donde las filas indican los curso, las columnas las horas de clase y el valor correspondiente al curso i y la hora j es verdadero indica que i tiene clase a la hora j.

En Haskell, podemos usar la matrices de la librería Data.Matrix y definir el tipo de los horarios por

   type Horario = Matrix Bool

Un ejemplo de horario es

   ejHorarios1 :: Horario
   ejHorarios1 = fromLists [[True,  True,  False, False],
                            [False, True,  True,  False],
                            [False, False, True,  True]]

en el que el 1º curso tiene clase a la 1ª y 2ª hora, el 2º a la 2ª y a la 3ª y el 3º a la 3ª y a la 4ª.

Definir la función

   cursosConflictivos :: Horario -> [Int] -> Bool

tal que (cursosConflictivos h is) se verifica para si los cursos de la lista is hay alguna hora en la que más de uno tiene clase a dicha hora. Por ejemplo,

   cursosConflictivos ejHorarios1 [1,2]  ==  True
   cursosConflictivos ejHorarios1 [1,3]  ==  False

Soluciones

import Data.Matrix
 
type Horario = Matrix Bool
 
ejHorarios1 :: Horario
ejHorarios1 = fromLists [[True,  True,  False, False],
                         [False, True,  True,  False],
                         [False, False, True,  True]]
 
--    horaConflictiva ejHorarios1 [1,2]   2  ==  True
--    horaConflictiva ejHorarios1 [1,3]   2  ==  False
--    horaConflictiva ejHorarios1 [1,2,3] 1  ==  False
horaConflictiva :: Horario -> [Int] -> Int -> Bool
horaConflictiva h is j =
  length [i | i <- is, h ! (i,j)] > 1
 
cursosConflictivos :: Horario -> [Int] -> Bool
cursosConflictivos h is =
  or [horaConflictiva h is j | j <- [1..n]]
  where n = ncols h

Acrónimos

Introducción

A partir de una palabra de puede formar un acrónimo uniendo un prefijo de la primera con un sufijo de la segunda. Por ejemplo,

  • “ofimática” es un acrónimo de “oficina” e “informática”
  • “informática” es un acrónimo de “información” y “automática”
  • “teleñeco” es un acrónimo de “televisión” y “muñeco”

Enunciado

-- Definir la función
--    esAcronimo :: String -> String -> String -> Bool
-- tal que (esAcronimo xs ys zs) se verifica si xs es un acrónimo de ys
-- y zs. Por ejemplo,
--    esAcronimo "ofimatica" "oficina" "informatica"       ==  True
--    esAcronimo "informatica" "informacion" "automatica"  ==  True
import Data.List
import Test.QuickCheck
 
-- 1ª definición
-- =============
 
esAcronimo1 :: String -> String -> String -> Bool
esAcronimo1 xs ys zs =
    xs `elem` acronimos ys zs
 
-- (acronimos xs ys) es la lista de acrónimos de xs e ys. Por ejemplo,
--    ghci> acronimos "ab" "cde"
--    ["cde","de","e","","acde","ade","ae","a","abcde","abde","abe","ab"]
acronimos :: String -> String -> [String]
acronimos xs ys =
    [us++vs | us <- inits xs, vs <- tails ys]
 
-- 2ª definición
-- =============
 
esAcronimo2 :: String -> String -> String -> Bool
esAcronimo2 xs ys zs = 
    or [isPrefixOf us ys && isSuffixOf vs zs | 
        (us,vs) <- [splitAt n xs | n <- [0..length xs]]]
 
-- Verificación de equivalencia
-- ============================
 
-- La propiedad es
prop_esAcronimo :: String -> String -> String -> Bool
prop_esAcronimo xs ys zs =
    esAcronimo1 xs ys zs == esAcronimo2 xs ys zs
 
-- La comprobación es
--    ghci> quickCheck prop_esAcronimo
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    ghci> let r = replicate
--    
--    ghci> let n = 500 in esAcronimo1 (r n 'a' ++ r n 'b') (r n 'a') (r n 'b')
--    True
--    (3.76 secs, 1779334696 bytes)
--    
--    ghci> let n = 500 in esAcronimo2 (r n 'a' ++ r n 'b') (r n 'a') (r n 'b')
--    True
--    (0.04 secs, 16715376 bytes)
--
-- La 2ª definición es más eficiente