Menu Close

Etiqueta: length

Reducción de SAT a Clique

Nota: En este ejercicio se usa la misma notación que en los anteriores importando los módulos

+ Evaluacion_de_FNC
+ Modelos_de_FNC
+ Problema_SAT_para_FNC
+ Cliques
+ KCliques
+ Grafo_FNC

Definir las funciones

   cliquesFNC :: FNC -> [[(Int,Literal)]]
   cliquesCompletos :: FNC -> [[(Int,Literal)]]
   esSatisfaciblePorClique :: FNC -> Bool

tales que

  • (cliquesFNCf) es la lista de los cliques del grafo de f. Por ejemplo,
     λ> cliquesFNC [[1,-2,3],[-1,2],[-2,3]]
     [[], [(0,1)], [(1,2)], [(0,1),(1,2)], [(2,-2)],
      [(0,1),(2,-2)], [(2,3)], [(0,1),(2,3)], [(1,2),(2,3)],
      [(0,1),(1,2),(2,3)], [(0,-2)], [(2,-2),(0,-2)], [(2,3),(0,-2)],
      [(1,-1)], [(2,-2),(1,-1)], [(2,3),(1,-1)], [(0,-2),(1,-1)],
      [(2,-2),(0,-2),(1,-1)], [(2,3),(0,-2),(1,-1)], [(0,3)],
      [(1,2),(0,3)], [(2,-2),(0,3)], [(2,3),(0,3)],
      [(1,2),(2,3),(0,3)], [(1,-1),(0,3)],
      [(2,-2),(1,-1),(0,3)], [(2,3),(1,-1),(0,3)]]
  • (cliquesCompletos f) es la lista de los cliques del grafo de f que tiene tantos elementos como cláusulas tiene f. Por ejemplo,
     λ> cliquesCompletos [[1,-2,3],[-1,2],[-2,3]]
     [[(0,1),(1,2),(2,3)],   [(2,-2),(0,-2),(1,-1)],
      [(2,3),(0,-2),(1,-1)], [(1,2),(2,3),(0,3)],
      [(2,-2),(1,-1),(0,3)], [(2,3),(1,-1),(0,3)]]
     λ> cliquesCompletos [[1,2],[1,-2],[-1,2],[-1,-2]]
     []
  • (esSatisfaciblePorClique f) se verifica si f no contiene la cláusula vacía, tiene más de una cláusula y posee algún clique completo. Por ejemplo,
     λ> esSatisfaciblePorClique [[1,-2,3],[-1,2],[-2,3]]
     True
     λ> esSatisfaciblePorClique [[1,2],[1,-2],[-1,2],[-1,-2]]
     False

Comprobar con QuickCheck que toda fórmula en FNC es satisfacible si, y solo si, es satisfacible por Clique.

Soluciones

module Reduccion_de_SAT_a_Clique where
 
import Evaluacion_de_FNC
import Modelos_de_FNC
import Problema_SAT_para_FNC
import Cliques
import KCliques
import Grafo_FNC
import Data.List (nub, sort)
import Test.QuickCheck
 
cliquesFNC :: FNC -> [[(Int,Literal)]]
cliquesFNC f = cliques (grafoFNC f)
 
cliquesCompletos :: FNC -> [[(Int,Literal)]]
cliquesCompletos cs = kCliques (grafoFNC cs) (length cs)
 
esSatisfaciblePorClique :: FNC -> Bool
esSatisfaciblePorClique f =
     [] `notElem` f'
  && (length f' <= 1 || not (null (cliquesCompletos f')))
  where f' = nub (map (nub . sort) f) 
 
-- La propiedad es
prop_esSatisfaciblePorClique :: FNC -> Bool
prop_esSatisfaciblePorClique f =
  esSatisfacible f == esSatisfaciblePorClique f
 
-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=7}) prop_esSatisfaciblePorClique
--    +++ 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 resolución de problemas es una habilidad práctica como, digamos, la natación. Adquirimos cualquier habilidad práctica por imitación y práctica. Tratando de nadar, imitas lo que otras personas hacen con sus manos y pies para mantener sus cabezas sobre el agua, y, finalmente, aprendes a nadar practicando la natación. Al intentar resolver problemas, hay que observar e imitar lo que hacen otras personas al resolver problemas y, finalmente, se aprende a resolver problemas haciéndolos.”

George Pólya.

Cliques de orden k

Nota: En este ejercicio usaremos las mismas notaciones que en el anterior importando el módulo Cliques.

Definir la función

   kCliques :: Eq a => Grafo a -> Int -> [[a]]

tal que (kCliques g k) es la lista de los cliques del grafo g de tamaño k. Por ejemplo,

   λ> kCliques [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3
   [[2,3,5],[2,4,5]]
   λ> kCliques [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 2
   [[1,2],[2,3],[2,4],[2,5],[3,5],[4,5]]
   λ> kCliques [(n,n+1) | n <- [1..100]] 3
   []

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

Soluciones

module KCliques where
 
import Grafo
import Cliques
 
-- 1ª definición
kCliques1 :: Eq a => Grafo a -> Int -> [[a]]
kCliques1 g k =
  [xs | xs <- cliques g
      , length xs == k]
 
-- 2ª definición
kCliques :: Eq a => Grafo a -> Int -> [[a]]
kCliques g k =
  [xs | xs <- kSubconjuntos (nodos g) k
      , esClique g xs]
 
-- (kSubconjuntos xs k) es la lista de los subconjuntos de xs con k
-- elementos. Por ejemplo, 
--    ghci> kSubconjuntos "bcde" 2
--    ["bc","bd","be","cd","ce","de"]
--    ghci> kSubconjuntos "bcde" 3
--    ["bcd","bce","bde","cde"]
--    ghci> kSubconjuntos "abcde" 3
--    ["abc","abd","abe","acd","ace","ade","bcd","bce","bde","cde"]
kSubconjuntos :: [a] -> Int -> [[a]]
kSubconjuntos _ 0      = [[]]
kSubconjuntos [] _     = []
kSubconjuntos (x:xs) k = 
  [x:ys | ys <- kSubconjuntos xs (k-1)] ++ kSubconjuntos xs k  
 
-- Comparación de eficiencia
-- =========================
 
--    λ> kCliques1 [(n,n+1) | n <- [1..20]] 3
--    []
--    (4.28 secs, 3,204,548,608 bytes)
--    λ> kCliques [(n,n+1) | n <- [1..20]] 3
--    []
--    (0.01 secs, 3,075,768 bytes)

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

“Es mejor resolver un problema de cinco maneras diferentes, que resolver cinco problemas de una sola manera.”

George Pólya.

Conjetura de Lemoine

La conjetura de Lemoine afirma que

Todos los números impares mayores que 5 se pueden escribir de la forma p + 2q donde p y q son números primos. Por ejemplo, 47 = 13 + 2 x 17

Definir las funciones

   descomposicionesLemoine :: Integer -> [(Integer,Integer)]
   graficaLemoine :: Integer -> IO ()

tales que

  • (descomposicionesLemoine n) es la lista de pares de primos (p,q) tales que n = p + 2q. Por ejemplo,
     descomposicionesLemoine 5   ==  []
     descomposicionesLemoine 7   ==  [(3,2)]
     descomposicionesLemoine 9   ==  [(5,2),(3,3)]
     descomposicionesLemoine 21  ==  [(17,2),(11,5),(7,7)]
     descomposicionesLemoine 47  ==  [(43,2),(41,3),(37,5),(13,17)]
     descomposicionesLemoine 33  ==  [(29,2),(23,5),(19,7),(11,11),(7,13)]
     length (descomposicionesLemoine 2625)  ==  133
  • (graficaLemoine n) dibuja la gráfica de los números de descomposiciones de Lemoine para los números impares menores o iguales que n. Por ejemplo, (graficaLemoine n 400) dibuja

Comprobar con QuickCheck la conjetura de Lemoine.

Nota: Basado en Lemoine’s conjecture

Soluciones

import Data.Numbers.Primes (isPrime, primes)
import Graphics.Gnuplot.Simple
import Test.QuickCheck
 
descomposicionesLemoine :: Integer -> [(Integer,Integer)]
descomposicionesLemoine n =
  [(p,q) | q <- takeWhile (<=(n-2) `div` 2) primes
         , let p = n - 2 * q
         , isPrime p]
 
graficaLemoine :: Integer -> IO ()
graficaLemoine n = do
  plotList [ Key Nothing
           , Title "Conjetura de Lemoine"
           , PNG "Conjetura_de_Lemoine.png"
           ]
           [(k,length (descomposicionesLemoine k)) | k <- [1,3..n]]
 
-- La conjetura es
prop_conjeturaLemoine :: Integer -> Bool
prop_conjeturaLemoine n =
  not (null (descomposicionesLemoine n'))
  where n' = 7 + 2 * abs n
 
-- Su comprobación es
--    λ> quickCheck prop_conjeturaLemoine
--    +++ 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

“Todo el mundo sabe lo que es una curva, hasta que ha estudiado suficientes matemáticas para confundirse a través del incontable número de posibles excepciones.”

Felix Klein.

Máximo número de consecutivos iguales al dado

Definir la función

   maximoConsecutivosIguales :: Eq a => a -> [a] -> Int

tal que (maximoConsecutivosIguales x xs) es el mayor número de elementos consecutivos en xs iguales a x. Por ejemplo,

   maximoConsecutivosIguales 'b' "abbcccbbbd"    ==  3
   maximoConsecutivosIguales 'b' "abbbbcccbbbd"  ==  4
   maximoConsecutivosIguales 'e' "abbcccbbbd"    ==  0

Soluciones

import Data.List (group)
 
maximoConsecutivosIguales :: Eq a => a -> [a] -> Int
maximoConsecutivosIguales x = maximum
                            . (0:)
                            . map length
                            . filter ((== x) . head)
                            . group

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 programación de computadoras es un arte, porque aplica el conocimiento
acumulado al mundo, porque requiere habilidad e ingenio, y especialmente
porque produce belleza. Un programador que subconscientemente se ve
a sí mismo como un artista disfrutará con lo que hace y lo hará mejor.”

Donald Knuth.

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.

Sumas de cuatro cuadrados

El número 42 es una suma de cuatro cuadrados de números enteros positivos ya que

   42 = 16 + 16 + 9 + 1 = 4² + 4² + 3² + 1²

Definir las funciones

   sumas4Cuadrados :: Integer -> [(Integer,Integer,Integer,Integer)]
   graficaNumeroSumas4Cuadrados :: Integer -> IO ()

tales que

  • (sumas4Cuadrados n) es la lista de las descompociones de n como suma de cuatro cuadrados. Por ejemplo,
     sumas4Cuadrados 42  ==  [(16,16,9,1),(25,9,4,4),(36,4,1,1)]
     sumas4Cuadrados 14  ==  []
     length (sumas4Cuadrados (5*10^4))  ==  260
  • (graficaNumeroSumas4Cuadrados n) dibuja la gráfica del número de descomposiciones en sumas de 4 cuadrados de los n primeros. Por ejemplo, (graficaNumeroSumas4Cuadrados 600) dibuja

Soluciones

Pensamiento

import Graphics.Gnuplot.Simple
 
-- 1ª definición de sumas4Cuadrados
-- ================================
 
sumas4Cuadrados :: Integer -> [(Integer,Integer,Integer,Integer)]
sumas4Cuadrados n =
  [(a^2,b^2,c^2,d) | a <- [1..n]
                   , b <- [a..n]
                   , c <- [b..n]
                   , let d = n - a^2 - b^2 - c^2
                   , c^2 <= d 
                   , esCuadrado d]
 
-- (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 x = floor (sqrt (fromIntegral x))
 
-- 2ª definición de sumas4Cuadrados
-- ================================
 
-- Los intervalos de búqueda en la definición anterior se pueden reducir
-- teniendo en cuenta las siguientes restricciones
--    1 <= a <= b <= c <= d 
--    n = a² + b² + c² + d² >= 4a² ==> a <= sqrt (n/4)
--    n - a² = b² + c² + d² >= 3b² ==> b <= sqrt ((n-a²)/3)
--    n - a² - b² = c² + d² >= 2c² ==> c <= sqrt ((n-a²-b²)/2)
 
sumas4Cuadrados2 :: Integer -> [(Integer,Integer,Integer,Integer)]
sumas4Cuadrados2 n =
  [(a^2,b^2,c^2,d) | a <- [1 .. floor (sqrt (fromIntegral n / 4))]
                   , b <- [a .. floor (sqrt (fromIntegral (n-a^2) / 3))]
                   , c <- [b .. floor (sqrt (fromIntegral (n-a^2-b^2) / 2))]
                   , let d = n - a^2 - b^2 - c^2
                   , c^2 <= d 
                   , esCuadrado d]
 
-- Comparación de eficiencia
-- =========================
 
-- La comprobación es
--    λ> length (sumas4Cuadrados 300)
--    11
--    (7.93 secs, 11,280,814,312 bytes)
--    λ> length (sumas4Cuadrados2 300)
--    11
--    (0.01 secs, 901,520 bytes)
 
-- Definición de graficaConvergencia
-- ==================================
 
graficaNumeroSumas4Cuadrados :: Integer -> IO ()
graficaNumeroSumas4Cuadrados n =
  plotList [ Key Nothing
           , Title "Numero de sumas como 4 cuadrados"
           , PNG "Sumas_de_cuatro_cuadrados.png"
           ]
           [length (sumas4Cuadrados2 k) | k <- [0..n]] 
 
-- Definición de esSuma4Cuadrados
-- ==============================
 
-- (esSuma4Cuadrados n) se verifica si n es la suma de 4 cuadrados. Por
-- ejemplo, 
--    esSuma4Cuadrados 42  ==  True
--    esSuma4Cuadrados 11  ==  False
--    esSuma4Cuadrados 41  ==  False
esSuma4Cuadrados :: Integer -> Bool
esSuma4Cuadrados = not . null . sumas4Cuadrados2

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>

¿Cuál es el peor de todos
los afanes? Preguntar.
¿Y el mejor? – Hacer camino
sin volver la vista atrás.

Antonio Machado

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

Elementos múltiplos de la longitud de la lista

Definir las funciones

   multiplosDeLaLongitud :: [Int] -> [Int]
   multiplosDeLaLongitudDeConsecutivos :: Int -> Int -> [Int]

tales que

  • (multiplosDeLaLongitud xs) es la lista de los elementos de xs que son múltiplos de la longitud de xs. Por ejemplo,
     multiplosDeLaLongitud [2,4,6,8] == [4,8]
  • (multiplosDeLaLongitudDeConsecutivos n m) es la lista de elementos de [n..n+m-1] que son múltiplos de n. Por ejemplo,
     multiplosDeLaLongitudDeConsecutivos 9 2  ==  [10]
     multiplosDeLaLongitudDeConsecutivos 9 12 ==  [12]

Comprobar con QuickCheck si se verifican las siguientes propiedades

  • En cualquier conjunto de m elementos consecutivos, m divide exactamente a uno de dichos elementos. En otras palabras, si n y m son enteros positivos, entonces (multiplosDeLaLongitudDeConsecutivos n m) tiene exactamente un elemento.
  • Si n es un entero positivo y m >= n, entonces (multiplosDeLaLongitudDeConsecutivos n m) es igual a [m]
  • Si n y n son enteros positivos y m < n, entonces (multiplosDeLaLongitudDeConsecutivos n m) es igual a [m * ceiling (n’ / m’)] donde n’ y m’ son las formas decimales de n y m respectivamente.

Soluciones

import Test.QuickCheck
 
multiplosDeLaLongitud :: [Int] -> [Int]
multiplosDeLaLongitud xs =
  [x | x <- xs
     , x `mod`  n == 0]
  where n = length xs
 
multiplosDeLaLongitudDeConsecutivos :: Int -> Int -> [Int]
multiplosDeLaLongitudDeConsecutivos n m =
  multiplosDeLaLongitud [n..n+m-1]
 
-- La 1ª propiedad es
prop_multiplosDeLaLongitud :: Int -> Int -> Property
prop_multiplosDeLaLongitud n m =
  n > 0 && m > 0
  ==>
  length (multiplosDeLaLongitudDeConsecutivos n m) == 1
 
-- La comprobación es
--    λ> quickCheck prop_multiplosDeLaLongitud
--    +++ OK, passed 100 tests.
 
-- La 2ª propiedad es
prop_multiplosDeLaLongitud2 :: Int -> Int -> Property
prop_multiplosDeLaLongitud2 n m =
  n > 0 && m >= n
  ==>
  multiplosDeLaLongitudDeConsecutivos n m == [m]
 
-- La comprobación es
--    λ> quickCheck prop_multiplosDeLaLongitud2
--    +++ OK, passed 100 tests.
 
-- La 3ª propiedad es
prop_multiplosDeLaLongitud3 :: Int -> Int -> Property
prop_multiplosDeLaLongitud3 n m =
  n > 0 && 0 < m && m < n
  ==>
  multiplosDeLaLongitudDeConsecutivos n m == [m * ceiling (n' / m')]
  where n' = fromIntegral n
        m' = fromIntegral m 
 
-- La comprobación es
--    λ> quickCheck prop_multiplosDeLaLongitud3
--    +++ OK, passed 100 tests.
 
-- Con las propiedades anteriores se puede redefinir multiplos
multiplosDeLaLongitudDeConsecutivos2 :: Int -> Int -> [Int]
multiplosDeLaLongitudDeConsecutivos2 n m
  | m < n     = [m * ceiling (n' / m')]
  | otherwise = [m]
  where n' = fromIntegral n
        m' = fromIntegral m 
 
-- Comprobación de la equivalencia
prop_equiv :: Int -> Int -> Property
prop_equiv n m =
  n > 0 && m > 0
  ==>
  multiplosDeLaLongitudDeConsecutivos  n m ==
  multiplosDeLaLongitudDeConsecutivos2 n m
 
-- La comprobación es
--    λ> quickCheck prop_multiplosDeLaLongitud
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
--    λ> xs1 = [multiplosDeLaLongitudDeConsecutivos n (10^3) | n <- [1..10^4]]
--    (0.01 secs, 0 bytes)
--    λ> xs2 = [multiplosDeLaLongitudDeConsecutivos2 n (10^3) | n <- [1..10^4]]
--    (0.01 secs, 0 bytes)
--    λ> maximum xs1
--    [10000]
--    (2.51 secs, 2,093,241,168 bytes)
--    λ> maximum xs2
--    [10000]
--    (0.02 secs, 16,742,408 bytes)

Referencia

Pensamiento

Pensando que no veía
porque Dios no le miraba,
dijo Abel cuando moría:
Se acabó lo que se daba.

Antonio Machado

Las conjeturas de Catalan y de Pillai

La conjetura de Catalan, enunciada en 1844 por Eugène Charles Catalan y demostrada 2002 por Preda Mihăilescu1, afirma que

Las únicas dos potencias de números enteros consecutivos son 8 y 9 (que son respectivamente 2³ y 3²).

En otras palabras, la única solución entera de la ecuación

   x^a - y^b = 1

para x, a, y, b > 1 es x = 3, a = 2, y = 2, b = 3.

La conjetura de Pillai, propuesta por S.S. Pillai en 1942, generaliza este resultado y es un problema abierto. Afirma que cada entero se puede escribir sólo un número finito de veces como una diferencia de dos potencias perfectas. En otras palabras, para todo entero positivo n, el conjunto de soluciones de

   x^a - y^b = n

para x, a, y, b > 1 es finito.

Por ejemplo, para n = 4, hay 3 soluciones

   (2,3, 2,2) ya que 2³ -  2² =   8 -   4 = 4
   (6,2, 2,5) ya que 6² -  2⁵ =  36 -  32 = 4
   (5,3,11,2) ya que 5³ - 11² = 125 - 121 = 4

Las soluciones se pueden representar por la menor potencia (en el caso anterior, por 4, 32 y 121) ya que dado n (en el caso anterior es 4), la potencia mayor es la menor más n.

Definir las funciones

   potenciasPerfectas :: [Integer]
   solucionesPillati :: Integer -> [Integer]
   solucionesPillatiAcotadas :: Integer -> Integer -> [Integer]

tales que

  • potenciasPerfectas es la lista de las potencias perfectas (es decir, de los números de la forma x^a con x y a mayores que 1). Por ejemplo,
     take 10 potenciasPerfectas  ==  [4,8,9,16,25,27,32,36,49,64]
     potenciasPerfectas !! 200   ==  28224
  • (solucionesPillati n) es la lista de las menores potencias de las soluciones de la ecuación de Pillati x^a – y^b = n; es decir, es la lista de los u tales que u y u+n son potencias perfectas. Por ejemplo,
     take 3 (solucionesPillati 4)  ==  [4,32,121]
     take 2 (solucionesPillati 5)  ==  [4,27]
     take 4 (solucionesPillati 7)  ==  [9,25,121,32761]
  • (solucionesPillatiAcotadas c n) es la lista de elementos de (solucionesPillati n) menores que n. Por ejemplo,
     solucionesPillatiAcotadas (10^3) 1  ==  [8]
     solucionesPillatiAcotadas (10^3) 2  ==  [25]
     solucionesPillatiAcotadas (10^3) 3  ==  [125]
     solucionesPillatiAcotadas (10^3) 4  ==  [4,32,121]
     solucionesPillatiAcotadas (10^3) 5  ==  [4,27]
     solucionesPillatiAcotadas (10^3) 6  ==  []
     solucionesPillatiAcotadas (10^3) 7  ==  [9,25,121]
     solucionesPillatiAcotadas (10^5) 7  ==  [9,25,121,32761]

Soluciones

import Data.List (group)
import Data.Numbers.Primes (primeFactors)
 
-- Definiciones de potenciasPerfectas
-- ==================================
 
-- 1ª definición
-- -------------
 
potenciasPerfectas1 :: [Integer]
potenciasPerfectas1 = filter esPotenciaPerfecta [4..]
 
-- (esPotenciaPerfecta x) se verifica si x es una potencia perfecta. Por
-- ejemplo, 
--    esPotenciaPerfecta 36  ==  True
--    esPotenciaPerfecta 72  ==  False
esPotenciaPerfecta :: Integer -> Bool
esPotenciaPerfecta = not . null. potenciasPerfectasDe 
 
-- (potenciasPerfectasDe x) es la lista de pares (a,b) tales que 
-- x = a^b. Por ejemplo,
--    potenciasPerfectasDe 64  ==  [(2,6),(4,3),(8,2)]
--    potenciasPerfectasDe 72  ==  []
potenciasPerfectasDe :: Integer -> [(Integer,Integer)]
potenciasPerfectasDe n = 
    [(m,k) | m <- takeWhile (\x -> x*x <= n) [2..]
           , k <- takeWhile (\x -> m^x <= n) [2..]
           , m^k == n]
 
-- 2ª definición
-- -------------
 
potenciasPerfectas2 :: [Integer]
potenciasPerfectas2 = [x | x <- [4..], esPotenciaPerfecta2 x]
 
-- (esPotenciaPerfecta2 x) se verifica si x es una potencia perfecta. Por
-- ejemplo, 
--    esPotenciaPerfecta2 36  ==  True
--    esPotenciaPerfecta2 72  ==  False
esPotenciaPerfecta2 :: Integer -> Bool
esPotenciaPerfecta2 x = mcd (exponentes x) > 1
 
-- (exponentes x) es la lista de los exponentes de l factorización prima
-- de x. Por ejemplos,
--    exponentes 36  ==  [2,2]
--    exponentes 72  ==  [3,2]
exponentes :: Integer -> [Int]
exponentes x = [length ys | ys <- group (primeFactors x)] 
 
-- (mcd xs) es el máximo común divisor de la lista xs. Por ejemplo,
--    mcd [4,6,10]  ==  2
--    mcd [4,5,10]  ==  1
mcd :: [Int] -> Int
mcd = foldl1 gcd
 
-- 3ª definición
-- -------------
 
potenciasPerfectas3 :: [Integer]
potenciasPerfectas3 = mezclaTodas potencias
 
-- potencias es la lista las listas de potencias de todos los números
-- mayores que 1 con exponentes mayores que 1. Por ejemplo,
--    λ> map (take 3) (take 4 potencias)
--    [[4,8,16],[9,27,81],[16,64,256],[25,125,625]]
potencias :: [[Integer]]
potencias = [[n^k | k <- [2..]] | n <- [2..]]
 
-- (mezclaTodas xss) es la mezcla ordenada sin repeticiones de las
-- listas ordenadas xss. Por ejemplo,
--    take 7 (mezclaTodas potencias)  ==  [4,8,9,16,25,27,32]
mezclaTodas :: Ord a => [[a]] -> [a]
mezclaTodas = foldr1 xmezcla
  where xmezcla (x:xs) ys = x : mezcla xs ys
 
-- (mezcla xs ys) es la mezcla ordenada sin repeticiones de las
-- listas ordenadas xs e ys. Por ejemplo,
--    take 7 (mezcla [2,5..] [4,6..])  ==  [2,4,5,6,8,10,11]
mezcla :: Ord a => [a] -> [a] -> [a]
mezcla (x:xs) (y:ys) | x < y  = x : mezcla xs (y:ys)
                     | x == y = x : mezcla xs ys
                     | x > y  = y : mezcla (x:xs) ys
 
-- Comparación de eficiencia
-- -------------------------
 
--    λ> potenciasPerfectas1 !! 200
--    28224
--    (7.24 secs, 9,245,991,160 bytes)
--    λ> potenciasPerfectas2 !! 200
--    28224
--    (0.30 secs, 814,597,152 bytes)
--    λ> potenciasPerfectas3 !! 200
--    28224
--    (0.01 secs, 7,061,120 bytes)
 
-- En lo que sigue se usa la 3ª definición
potenciasPerfectas :: [Integer]
potenciasPerfectas = potenciasPerfectas3
 
-- Definición de solucionesPillati
-- ===============================
 
solucionesPillati :: Integer -> [Integer]
solucionesPillati n =
  [x | x <- potenciasPerfectas
     , esPotenciaPerfecta2 (x+n)]
 
-- Definición de solucionesPillatiAcotadas
-- =======================================
 
solucionesPillatiAcotadas :: Integer -> Integer -> [Integer]
solucionesPillatiAcotadas c n =
  [x | x <- takeWhile (< (c-n)) potenciasPerfectas
     , esPotenciaPerfecta2 (x+n)]

Referencia

Pensamiento

Y te enviaré mi canción:
“Se canta lo que se pierde”,
con un papagayo verde
que la diga en tu balcón.

Antonio Machado

Teorema de existencia de divisores

El teorema de existencia de divisores afirma que

En cualquier subconjunto de {1, 2, …, 2m} con al menos m+1 elementos existen números distintos a, b tales que a divide a b.

Un conjunto de números naturales xs es mayoritario si existe un m tal que la lista de xs es un subconjunto de {1,2,…,2m} con al menos m+1 elementos. Por ejemplo, {2,3,5,6} porque es un subconjunto de {1,2,…,6} con más de 3 elementos.

Definir las funciones

   divisoresMultiplos :: [Integer] -> [(Integer,Integer)]
   esMayoritario :: [Integer] -> Bool

tales que

  • (divisores xs) es la lista de pares de elementos distintos de (a,b) tales que a divide a b. Por ejemplo,
     divisoresMultiplos [2,3,5,6]  ==  [(2,6),(3,6)]
     divisoresMultiplos [2,3,5]    ==  []
     divisoresMultiplos [4..8]     ==  [(4,8)]
  • (esMayoritario xs) se verifica xs es mayoritario. Por ejemplo,
     esMayoritario [2,3,5,6]  ==  True
     esMayoritario [2,3,5]    ==  False

Comprobar con QuickCheck el teorema de existencia de divisores; es decir, en cualquier conjunto mayoritario existen números distintos a, b tales que a divide a b. Para la comprobación se puede usar el siguiente generador de conjuntos mayoritarios

   mayoritario :: Gen [Integer]
   mayoritario = do
     m' <- arbitrary
     let m = 1 + abs m'
     xs' <- sublistOf [1..2*m] `suchThat` (\ys -> genericLength ys > m)
     return xs'

con lo que la propiedad que hay que comprobar con QuickCheck es

   teorema_de_existencia_de_divisores :: Property
   teorema_de_existencia_de_divisores =
     forAll mayoritario (not . null . divisoresMultiplos)

Soluciones

import Data.List (genericLength)
import Test.QuickCheck
 
divisoresMultiplos :: [Integer] -> [(Integer,Integer)]
divisoresMultiplos xs =
  [(x,y) | x <- xs
         , y <- xs
         , y /= x
         , y `mod` x == 0]
 
esMayoritario :: [Integer] -> Bool
esMayoritario xs =
  not (null xs) && length xs > ceiling (n / 2) 
  where n = fromIntegral (maximum xs)
 
-- Comprobación del teorema
-- ========================
 
-- La propiedad es
teorema_de_existencia_de_divisores :: Property
teorema_de_existencia_de_divisores =
  forAll mayoritario (not . null . divisoresMultiplos)
 
-- mayoritario es un generador de conjuntos mayoritarios. Por ejemplo, 
--    λ> sample mayoritario
--    [1,2]
--    [2,5,7,8]
--    [1,2,8,10,14]
--    [3,8,11,12,13,15,18,19,22,23,25,26]
--    [1,3,4,6]
--    [3,6,9,11,12,14,17,19]
mayoritario :: Gen [Integer]
mayoritario = do
  m' <- arbitrary
  let m = 1 + abs m'
  xs' <- sublistOf [1..2*m] `suchThat` (\ys -> genericLength ys > m)
  return xs'
 
-- La comprobación es
--    λ> quickCheck teorema_de_existencia_de_divisores
--    +++ OK, passed 100 tests.

Pensamiento

Guiomar, Guiomar,
mírame en ti castigado:
reo de haberte creado,
ya no te puedo olvidar.

Antonio Machado