nub

Reducción de SAT a Clique

PorJosé A. Alonso 27-febrero-20205-marzo-2020

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

+ 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

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)]]

λ> 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]]
     []

λ> 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

λ> 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.

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.

Nodos y conexiones de un grafo

PorJosé A. Alonso 19-febrero-202026-febrero-2020

Un grafo no dirigido se representa por la lista de sus arcos. Por ejemplo, el grafo

             1  -- 2 -- 4
                   | \  |
                   |  \ |
                   3 -- 5

1 -- 2 -- 4

| \ |

3 -- 5

se representa por [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)].

Se define el tipo de grafo por

   type Grafo a = [(a,a)]

1	type Grafo a = [(a,a)]

Definir las funciones

   nodos      :: Eq a => Grafo a -> [a]
   conectados :: Eq a => Grafo a -> a -> a -> Bool

1 2	nodos :: Eq a => Grafo a -> [a] conectados :: Eq a => Grafo a -> a -> a -> Bool

tales que

(nodos g) es la lista de los nodos del grafo g. Por ejemplo,

     nodos [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)]  ==  [1,2,3,4,5]

1	nodos [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] == [1,2,3,4,5]

(conectados g x y) se verifica si el grafo no dirigido g posee un arco con extremos x e y. Por ejemplo,

     conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3 2  ==  True
     conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 2 3  ==  True
     conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3 4  ==  False

conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3 2 == True

conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 2 3 == True

conectados [(1,2),(2,3),(2,4),(2,5),(3,5),(4,5)] 3 4 == False

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

module Grafo where

import Data.List (nub)

type Grafo a = [(a,a)]

nodos :: Eq a => Grafo a -> [a]
nodos g = nub (concat [[x,y] | (x,y) <- g])

conectados :: Eq a => Grafo a -> a -> a -> Bool
conectados g x y =
  (x,y) `elem` g || (y,x) `elem` g

module Grafo where

import Data.List (nub)

type Grafo a = [(a,a)]

nodos :: Eq a => Grafo a -> [a]

nodos g = nub (concat [[x,y] | (x,y) <- g])

conectados :: Eq a => Grafo a -> a -> a -> Bool

conectados g x y =

(x,y) `elem` g || (y,x) `elem` g

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>

Soluciones

Pensamiento

«La elegancia de un teorema es directamente proporcional al número de ideas que puedes ver en él e inversamente proporcional al esfuerzo que requiere verlas.»

George Pólya.

Átomos de FNC (fórmulas en forma normal conjuntiva)

PorJosé A. Alonso 13-febrero-202020-febrero-2020

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

Definir las siguientes funciones

    atomosClausula :: Clausula -> [Atomo]
    atomosFNC      :: FNC -> [Atomo]

1 2	atomosClausula :: Clausula -> [Atomo] atomosFNC :: FNC -> [Atomo]

tales que

(atomosClausula c) es el conjunto de los átomos de la cláusula c. Por ejemplo,

     atomosClausula [3,1,-3] == [1,3]

1	atomosClausula [3,1,-3] == [1,3]

(atomosFNC f) es el conjunto de los átomos de la FNC f. Por ejemplo,

   atomosFNC [[4,5],[1,-2],[-4,-1,-5]]  ==  [1,2,4,5]

1	atomosFNC [[4,5],[1,-2],[-4,-1,-5]] == [1,2,4,5]

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

Soluciones

module Atomos_de_FNC where
  
import Evaluacion_de_FNC
import Data.List (sort, nub)

-- 1ª definición de atomosClausula
atomosClausula :: Clausula -> [Atomo]
atomosClausula c = sort (nub (map abs c))

-- 2ª definición de atomosClausula
atomosClausula2 :: Clausula -> [Atomo]
atomosClausula2 = sort . nub . map abs

-- 1ª definición de atomosFNC
atomosFNC :: FNC -> [Atomo]
atomosFNC f = sort (nub (concat [atomosClausula c | c <- f]))

-- 2ª definición
atomosFNC2 :: FNC -> [Atomo]
atomosFNC2 f = sort (nub (concatMap atomosClausula f))

-- 3ª definición
atomosFNC3 :: FNC -> [Atomo]
atomosFNC3 = sort . nub . concatMap atomosClausula

module Atomos_de_FNC where

import Evaluacion_de_FNC

import Data.List (sort, nub)

-- 1ª definición de atomosClausula

atomosClausula :: Clausula -> [Atomo]

atomosClausula c = sort (nub (map abs c))

-- 2ª definición de atomosClausula

atomosClausula2 :: Clausula -> [Atomo]

atomosClausula2 = sort . nub . map abs

-- 1ª definición de atomosFNC

atomosFNC :: FNC -> [Atomo]

atomosFNC f = sort (nub (concat [atomosClausula c | c <- f]))

-- 2ª definición

atomosFNC2 :: FNC -> [Atomo]

atomosFNC2 f = sort (nub (concatMap atomosClausula f))

-- 3ª definición

atomosFNC3 :: FNC -> [Atomo]

atomosFNC3 = sort . nub . concatMap atomosClausula

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 esencia de las matemáticas es su libertad.»

Georg Cantor.

Teorema de la amistad

PorJosé A. Alonso 17-enero-202024-enero-2020

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]]

1	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

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.

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

Pigeonhole among friends

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

Conjetura de Grimm

PorJosé A. Alonso 2-enero-202015-enero-2020

La conjetura de Grimm establece que a cada elemento de un conjunto de números compuestos consecutivos se puede asignar un número primo que lo divide, de forma que cada uno de los números primos elegidos es distinto de todos los demás. Más formalmente, si n+1, n+2, …, n+k son números compuestos, entonces existen números primos p(i), distintos entre sí, tales que p(i) divide a n+i para 1 ≤ i ≤ k.

Diremos que la lista ps = [p(1),…,p(k)] es una sucesión de Grim para la lista xs = [x(1),…,x(k)] si p(i) son números primos distintos y p(i) divide a x(i), para 1 ≤ i ≤ k. Por ejemplo, 2, 5, 13, 3, 7 es una sucesión de Grim de 24, 25, 26, 27, 28.

Definir las funciones

   compuestos :: Integer -> [Integer]
   sucesionesDeGrim :: [Integer] -> [[Integer]]

1 2	compuestos :: Integer -> [Integer] sucesionesDeGrim :: [Integer] -> [[Integer]]

tales que

(compuestos n) es la mayor lista de números enteros consecutivos empezando en n. Por ejemplo,

     compuestos 24  ==  [24,25,26,27,28]
     compuestos  8  ==  [8,9,10]
     compuestos 15  ==  [15,16]
     compuestos 16  ==  [16]
     compuestos 17  ==  []

compuestos 24 == [24,25,26,27,28]

compuestos 8 == [8,9,10]

compuestos 15 == [15,16]

compuestos 16 == [16]

compuestos 17 == []

(sucesionesDeGrim xs) es la lista de las sucesiones de Grim de xs. Por ejemplo,

     sucesionesDeGrim [15,16]          == [[3,2],[5,2]]
     sucesionesDeGrim [8,9,10]         == [[2,3,5]]
     sucesionesDeGrim [9,10]           == [[3,2],[3,5]]
     sucesionesDeGrim [24,25,26,27,28] == [[2,5,13,3,7]]
     sucesionesDeGrim [25,26,27,28]    == [[5,2,3,7],[5,13,3,2],[5,13,3,7]]

sucesionesDeGrim [15,16] == [[3,2],[5,2]]

sucesionesDeGrim [8,9,10] == [[2,3,5]]

sucesionesDeGrim [9,10] == [[3,2],[3,5]]

sucesionesDeGrim [24,25,26,27,28] == [[2,5,13,3,7]]

sucesionesDeGrim [25,26,27,28] == [[5,2,3,7],[5,13,3,2],[5,13,3,7]]

Comprobar con QuickCheck la conjetura de Grim; es decir, para todo número n > 1, (sucesionesDeGrim (compuestos n)) es una lista no vacía.

Soluciones

import Data.List (nub)
import Data.Numbers.Primes (isPrime, primeFactors)
import Test.QuickCheck

compuestos :: Integer -> [Integer]
compuestos n = takeWhile (not . isPrime) [n..]

sucesionesDeGrim :: [Integer] -> [[Integer]]
sucesionesDeGrim [] = [[]]
sucesionesDeGrim (x:xs) =
  [y:ys | y <- divisoresPrimos x
        , ys <- sucesionesDeGrim xs
        , y `notElem` ys]

-- (divisoresPrimos n) es la lista de los divisores primos de n. Por
-- ejemplo, 
--    divisoresPrimos 60  ==  [2,3,5]
divisoresPrimos :: Integer -> [Integer]
divisoresPrimos = nub . primeFactors

-- La propiedad es
conjeturaDeGrim :: Integer -> Property
conjeturaDeGrim n =
  n > 1 ==> not (null (sucesionesDeGrim (compuestos n))) 

-- La comprobación es
--    λ> quickCheck conjeturaDeGrim
--    +++ OK, passed 100 tests.

import Data.List (nub)

import Data.Numbers.Primes (isPrime, primeFactors)

import Test.QuickCheck

compuestos :: Integer -> [Integer]

compuestos n = takeWhile (not . isPrime) [n..]

sucesionesDeGrim :: [Integer] -> [[Integer]]

sucesionesDeGrim [] = [[]]

sucesionesDeGrim (x:xs) =

[y:ys | y <- divisoresPrimos x

, ys <- sucesionesDeGrim xs

, y `notElem` ys]

-- (divisoresPrimos n) es la lista de los divisores primos de n. Por

-- ejemplo,

-- divisoresPrimos 60 == [2,3,5]

divisoresPrimos :: Integer -> [Integer]

divisoresPrimos = nub . primeFactors

-- La propiedad es

conjeturaDeGrim :: Integer -> Property

conjeturaDeGrim n =

n > 1 ==> not (null (sucesionesDeGrim (compuestos n)))

-- La comprobación es

-- λ> quickCheck conjeturaDeGrim

-- +++ OK, passed 100 tests.

Pensamiento

De encinar en encinar
se va fatigando el día.

Antonio Machado

Reducción de SAT a Clique

Soluciones

Otras soluciones

Pensamiento

Nodos y conexiones de un grafo

Otras soluciones

Soluciones

Pensamiento

Átomos de FNC (fórmulas en forma normal conjuntiva)

Soluciones

Otras soluciones

Pensamiento

Teorema de la amistad

Soluciones

Referencia

Pensamiento

Conjetura de Grimm

Soluciones

Pensamiento

Entradas recientes

Buscar

Correo electrónico