notElem – Exercitium

Diferencia simétrica

PorJosé A. Alonso 29-marzo-20225-abril-2022

La diferencia simétrica de dos conjuntos es el conjunto cuyos elementos son aquellos que pertenecen a alguno de los conjuntos iniciales, sin pertenecer a ambos a la vez. Por ejemplo, la diferencia simétrica de {2,5,3} y {4,2,3,7} es {5,4,7}.

Definir la función

   diferenciaSimetrica :: Ord a => [a] -> [a] -> [a]

1	diferenciaSimetrica :: Ord a => [a] -> [a] -> [a]

tal que (diferenciaSimetrica xs ys) es la diferencia simétrica de xs e ys. Por ejemplo,

   diferenciaSimetrica [2,5,3] [4,2,3,7]    ==  [4,5,7]
   diferenciaSimetrica [2,5,3] [5,2,3]      ==  []
   diferenciaSimetrica [2,5,2] [4,2,3,7]    ==  [3,4,5,7]
   diferenciaSimetrica [2,5,2] [4,2,4,7]    ==  [4,5,7]
   diferenciaSimetrica [2,5,2,4] [4,2,4,7]  ==  [5,7]

diferenciaSimetrica [2,5,3] [4,2,3,7] == [4,5,7]

diferenciaSimetrica [2,5,3] [5,2,3] == []

diferenciaSimetrica [2,5,2] [4,2,3,7] == [3,4,5,7]

diferenciaSimetrica [2,5,2] [4,2,4,7] == [4,5,7]

diferenciaSimetrica [2,5,2,4] [4,2,4,7] == [5,7]

Soluciones

import Test.QuickCheck
import Data.List ((\\), intersect, nub, sort, union)
import qualified Data.Set as S

-- 1ª solución
-- ===========

diferenciaSimetrica1 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica1 xs ys =
  sort (nub ([x | x <- xs, x `notElem` ys] ++ [y | y <- ys, y `notElem` xs]))

-- 2ª solución
-- ===========

diferenciaSimetrica2 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica2 xs ys =
  sort (nub (filter (`notElem` ys) xs ++ filter (`notElem` xs) ys))

-- 3ª solución
-- ===========

diferenciaSimetrica3 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica3 xs ys =
  sort (nub (union xs ys \\ intersect xs ys))

-- 4ª solución
-- ===========

diferenciaSimetrica4 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica4 xs ys =
  [x | x <- sort (nub (xs ++ ys))
     , x `notElem` xs || x `notElem` ys]

-- 5ª solución
-- ===========

diferenciaSimetrica5 :: Ord a => [a] -> [a] -> [a]
diferenciaSimetrica5 xs ys =
  S.elems ((xs' `S.union` ys') `S.difference` (xs' `S.intersection` ys'))
  where xs' = S.fromList xs
        ys' = S.fromList ys

-- Comprobación de equivalencia
-- ============================

-- La propiedad es
prop_diferenciaSimetrica :: [Int] -> [Int] -> Bool
prop_diferenciaSimetrica xs ys =
  all (== diferenciaSimetrica1 xs ys)
      [diferenciaSimetrica2 xs ys,
       diferenciaSimetrica3 xs ys,
       diferenciaSimetrica4 xs ys,
       diferenciaSimetrica5 xs ys]

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

-- Comparación de eficiencia
-- =========================

-- La comparación es
--    λ> length (diferenciaSimetrica1 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (2.34 secs, 10,014,360 bytes)
--    λ> length (diferenciaSimetrica2 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (2.41 secs, 8,174,264 bytes)
--    λ> length (diferenciaSimetrica3 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (5.84 secs, 10,232,006,288 bytes)
--    λ> length (diferenciaSimetrica4 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (5.83 secs, 14,814,184 bytes)
--    λ> length (diferenciaSimetrica5 [1..2*10^4] [2,4..2*10^4])
--    10000
--    (0.02 secs, 7,253,496 bytes)

import Test.QuickCheck

import Data.List ((\\), intersect, nub, sort, union)

import qualified Data.Set as S

-- 1ª solución

-- ===========

diferenciaSimetrica1 :: Ord a => [a] -> [a] -> [a]

diferenciaSimetrica1 xs ys =

sort (nub ([x | x <- xs, x `notElem` ys] ++ [y | y <- ys, y `notElem` xs]))

-- 2ª solución

-- ===========

diferenciaSimetrica2 :: Ord a => [a] -> [a] -> [a]

diferenciaSimetrica2 xs ys =

sort (nub (filter (`notElem` ys) xs ++ filter (`notElem` xs) ys))

-- 3ª solución

-- ===========

diferenciaSimetrica3 :: Ord a => [a] -> [a] -> [a]

diferenciaSimetrica3 xs ys =

sort (nub (union xs ys \\ intersect xs ys))

-- 4ª solución

-- ===========

diferenciaSimetrica4 :: Ord a => [a] -> [a] -> [a]

diferenciaSimetrica4 xs ys =

[x | x <- sort (nub (xs ++ ys))

, x `notElem` xs || x `notElem` ys]

-- 5ª solución

-- ===========

diferenciaSimetrica5 :: Ord a => [a] -> [a] -> [a]

diferenciaSimetrica5 xs ys =

S.elems ((xs' `S.union` ys') `S.difference` (xs' `S.intersection` ys'))

where xs' = S.fromList xs

ys' = S.fromList ys

-- Comprobación de equivalencia

-- ============================

-- La propiedad es

prop_diferenciaSimetrica :: [Int] -> [Int] -> Bool

prop_diferenciaSimetrica xs ys =

all (== diferenciaSimetrica1 xs ys)

[diferenciaSimetrica2 xs ys,

diferenciaSimetrica3 xs ys,

diferenciaSimetrica4 xs ys,

diferenciaSimetrica5 xs ys]

-- La comprobación es

-- λ> quickCheck prop_diferenciaSimetrica

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

-- =========================

-- La comparación es

-- λ> length (diferenciaSimetrica1 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (2.34 secs, 10,014,360 bytes)

-- λ> length (diferenciaSimetrica2 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (2.41 secs, 8,174,264 bytes)

-- λ> length (diferenciaSimetrica3 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (5.84 secs, 10,232,006,288 bytes)

-- λ> length (diferenciaSimetrica4 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (5.83 secs, 14,814,184 bytes)

-- λ> length (diferenciaSimetrica5 [1..2*10^4] [2,4..2*10^4])

-- 10000

-- (0.02 secs, 7,253,496 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Nuevas soluciones

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

Caminos en un grafo

PorJosé A. Alonso 28-mayo-20204-junio-2020

Definir las funciones

   grafo   :: [(Int,Int)] -> Grafo Int Int
   caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

1 2	grafo :: [(Int,Int)] -> Grafo Int Int caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

tales que

(grafo as) es el grafo no dirigido definido cuyas aristas son as. Por ejemplo,

     ghci> grafo [(2,4),(4,5)]
     G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

1 2	ghci> grafo [(2,4),(4,5)] G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

(caminos g a b) es la lista los caminos en el grafo g desde a hasta b sin pasar dos veces por el mismo nodo. Por ejemplo,

     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)
     [[1,3,5,7],[1,3,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)
     [[2,5,3,7],[2,5,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)
     [[1,3,5,2],[1,3,7,5,2]]
     ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4
     []
     ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
     109601

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)

[[1,3,5,7],[1,3,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)

[[2,5,3,7],[2,5,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)

[[1,3,5,2],[1,3,7,5,2]]

ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4

[]

ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

109601

Soluciones

import Data.List (sort)
import I1M.Grafo
import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int
grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]
  where ns = map fst as ++ map snd as
        m  = minimum ns
        n  = maximum ns

-- 1ª solución
-- ===========

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g a b = aux [[b]] where 
  aux [] = []
  aux ((x:xs):yss)
    | x == a    = (x:xs) : aux yss
    | otherwise = aux ([z:x:xs | z <- adyacentes g x
                               , z `notElem` (x:xs)] 
                       ++ yss) 

-- 2ª solución (mediante espacio de estados)
-- =========================================

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos2 g a b = buscaEE sucesores esFinal inicial
  where inicial          = [b]
        sucesores (x:xs) = [z:x:xs | z <- adyacentes g x
                                   , z `notElem` (x:xs)] 
        esFinal (x:xs)   = x == a

-- Comparación de eficiencia
-- =========================

--    ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.57 secs, 500533816 bytes)
--    ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.53 secs, 470814096 bytes)

import Data.List (sort)

import I1M.Grafo

import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int

grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]

where ns = map fst as ++ map snd as

m = minimum ns

n = maximum ns

-- 1ª solución

-- ===========

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos g a b = aux [[b]] where

aux [] = []

aux ((x:xs):yss)

| x == a = (x:xs) : aux yss

| otherwise = aux ([z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

++ yss)

-- 2ª solución (mediante espacio de estados)

-- =========================================

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos2 g a b = buscaEE sucesores esFinal inicial

where inicial = [b]

sucesores (x:xs) = [z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

esFinal (x:xs) = x == a

-- Comparación de eficiencia

-- =========================

-- ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.57 secs, 500533816 bytes)

-- ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.53 secs, 470814096 bytes)

Menor no expresable como suma

PorJosé A. Alonso 15-abril-202029-abril-2020

Definir la función

   menorNoSuma :: [Integer] -> Integer

1	menorNoSuma :: [Integer] -> Integer

tal que (menorNoSuma xs) es el menor número que no se puede escribir como suma de un subconjunto de xs, donde se supone que xs es un conjunto de números enteros positivos. Por ejemplo,

   menorNoSuma [6,1,2]    ==  4
   menorNoSuma [1,2,3,9]  ==  7
   menorNoSuma [5]        ==  1
   menorNoSuma [1..20]    ==  211
   menorNoSuma [1..10^6]  ==  500000500001

menorNoSuma [6,1,2] == 4

menorNoSuma [1,2,3,9] == 7

menorNoSuma [5] == 1

menorNoSuma [1..20] == 211

menorNoSuma [1..10^6] == 500000500001

Comprobar con QuickCheck que para todo n,

   menorNoSuma [1..n] == 1 + sum [1..n]

1	menorNoSuma [1..n] == 1 + sum [1..n]

Soluciones

-- 1ª definición
-- =============

import Data.List (sort, subsequences)
import Test.QuickCheck
    
menorNoSuma1 :: [Integer] -> Integer
menorNoSuma1 xs =
  head [n | n <- [1..], n `notElem` sumas xs]

-- (sumas xs) es la lista de las sumas de los subconjuntos de xs. Por ejemplo,
--    sumas [1,2,6]  ==  [0,1,2,3,6,7,8,9]
--    sumas [6,1,2]  ==  [0,6,1,7,2,8,3,9]
sumas :: [Integer] -> [Integer]
sumas xs = map sum (subsequences xs)

-- 2ª definición
-- =============

menorNoSuma2 :: [Integer] -> Integer
menorNoSuma2  = menorNoSumaOrd . reverse . sort 

-- (menorNoSumaOrd xs) es el menor número que no se puede escribir como
-- suma de un subconjunto de xs, donde xs es una lista de números
-- naturales ordenada de mayor a menor. Por ejemplo,
--    menorNoSumaOrd [6,2,1]  ==  4
menorNoSumaOrd [] = 1
menorNoSumaOrd (x:xs) | x > y     = y
                      | otherwise = y+x
  where y = menorNoSumaOrd xs

-- Comparación de eficiencia
-- =========================

--    λ> menorNoSuma1 [1..20]
--    211
--    (20.40 secs, 28,268,746,320 bytes)
--    λ> menorNoSuma2 [1..20]
--    211
--    (0.01 secs, 0 bytes)
           
-- Propiedad
-- =========

-- La propiedad es
prop_menorNoSuma :: (Positive Integer) -> Bool
prop_menorNoSuma (Positive n) =
  menorNoSuma2 [1..n] == 1 + sum [1..n]

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=7}) prop_menorNoSuma
--    +++ OK, passed 100 tests.

-- 1ª definición

-- =============

import Data.List (sort, subsequences)

import Test.QuickCheck

menorNoSuma1 :: [Integer] -> Integer

menorNoSuma1 xs =

head [n | n <- [1..], n `notElem` sumas xs]

-- (sumas xs) es la lista de las sumas de los subconjuntos de xs. Por ejemplo,

-- sumas [1,2,6] == [0,1,2,3,6,7,8,9]

-- sumas [6,1,2] == [0,6,1,7,2,8,3,9]

sumas :: [Integer] -> [Integer]

sumas xs = map sum (subsequences xs)

-- 2ª definición

-- =============

menorNoSuma2 :: [Integer] -> Integer

menorNoSuma2 = menorNoSumaOrd . reverse . sort

-- (menorNoSumaOrd xs) es el menor número que no se puede escribir como

-- suma de un subconjunto de xs, donde xs es una lista de números

-- naturales ordenada de mayor a menor. Por ejemplo,

-- menorNoSumaOrd [6,2,1] == 4

menorNoSumaOrd [] = 1

menorNoSumaOrd (x:xs) | x > y = y

| otherwise = y+x

where y = menorNoSumaOrd xs

-- Comparación de eficiencia

-- =========================

-- λ> menorNoSuma1 [1..20]

-- 211

-- (20.40 secs, 28,268,746,320 bytes)

-- λ> menorNoSuma2 [1..20]

-- 211

-- (0.01 secs, 0 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_menorNoSuma :: (Positive Integer) -> Bool

prop_menorNoSuma (Positive n) =

menorNoSuma2 [1..n] == 1 + sum [1..n]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=7}) prop_menorNoSuma

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

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.

Modelos de FNC (fórmulas en forma normal conjuntiva)

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

Nota: En este ejercicio usaremos las mismas notaciones que en anterior importando los módulos Interpretaciones_de_FNC y Evaluacion_de_FNC

Una interpretación I es un modelo de un literal L si el valor de L en I es verdadero. Por ejemplo, la interpretación [2,5]

es modelo del literal x(2) (porque 2 ∈ [2,5])
no es modelo del literal x(3) (porque 3 ∉ [2,5])
es modelo del literal -x(4) (porque 4 ∉ [2,5])

Una interpretación I es un modelo de una cláusula C si el valor de C en I es verdadero. Por ejemplo, la interpretación [2,5]

es modelo de la cláusula (x(2) v x(3)) (porque x(2) es verdadero)
no es modelo de la cláusula (x(3) v x(4)) (porque x(3) y x(4) son falsos)

Una interpretación I es un modelo de una FNC F si el valor de F en I es verdadero. Por ejemplo, la interpretación [2,5]

es modelo de la FNC ((x(2) v x(5)) & (-x(4) v x(3)) porque lo es de sus dos cláusulas.

Definir las siguientes funciones

   esModeloLiteral  :: Interpretacion -> Literal -> Bool
   esModeloClausula :: Interpretacion -> Clausula -> Bool
   esModelo         :: Interpretacion -> FNC -> Bool
   modelosClausula  :: Clausula -> [Interpretacion]
   modelos          :: FNC -> [Interpretacion]

esModeloLiteral :: Interpretacion -> Literal -> Bool

esModeloClausula :: Interpretacion -> Clausula -> Bool

esModelo :: Interpretacion -> FNC -> Bool

modelosClausula :: Clausula -> [Interpretacion]

modelos :: FNC -> [Interpretacion]

tales que

(esModeloLiteral i l) se verifica si i es modelo del literal l. Por ejemplo,

     esModeloLiteral [3,5] 3     ==  True
     esModeloLiteral [3,5] 4     ==  False
     esModeloLiteral [3,5] (-3)  ==  False
     esModeloLiteral [3,5] (-4)  ==  True

esModeloLiteral [3,5] 3 == True

esModeloLiteral [3,5] 4 == False

esModeloLiteral [3,5] (-3) == False

esModeloLiteral [3,5] (-4) == True

(esModeloClausula i c) se verifica si i es modelo de la cláusula c. Por ejemplo,

     esModeloClausula [3,5] [2,3,-5]  ==  True
     esModeloClausula [3,5] [2,4,-1]  ==  True
     esModeloClausula [3,5] [2,4,1]   ==  False

esModeloClausula [3,5] [2,3,-5] == True

esModeloClausula [3,5] [2,4,-1] == True

esModeloClausula [3,5] [2,4,1] == False

(esModelo i f) se verifica si i es modelo de la fórmula f. Por ejemplo,

     esModelo [1,3] [[1,-2],[3]]  ==  True
     esModelo [1]   [[1,-2],[3]]  ==  False
     esModelo [1]   []            ==  True

esModelo [1,3] [[1,-2],[3]] == True

esModelo [1] [[1,-2],[3]] == False

esModelo [1] [] == True

(modelosClausula c) es la lista de los modelos de la cláusula c. Por ejemplo,

     modelosClausula [-1,2]  ==  [[],[2],[1,2]]
     modelosClausula [-1,1]  ==  [[],[1]]
     modelosClausula []      ==  []

modelosClausula [-1,2] == [[],[2],[1,2]]

modelosClausula [-1,1] == [[],[1]]

modelosClausula [] == []

(modelos f) es la lista de los modelos de la fórmula f. Por ejemplo,

     modelos [[-1,2],[-2,1]]    ==  [[],[1,2]]
     modelos [[-1,2],[-2],[1]]  ==  []
     modelos [[1,-1,2]]         ==  [[],[1],[2],[1,2]]

modelos [[-1,2],[-2,1]] == [[],[1,2]]

modelos [[-1,2],[-2],[1]] == []

modelos [[1,-1,2]] == [[],[1],[2],[1,2]]

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

Soluciones

module Modelos_de_FNC where

import Interpretaciones_de_FNC 
import Evaluacion_de_FNC

esModeloLiteral :: Interpretacion -> Literal -> Bool
esModeloLiteral i l
  | l > 0     = l `elem` i
  | otherwise = negate l `notElem` i

esModeloClausula :: Interpretacion -> Clausula -> Bool
esModeloClausula i = any (esModeloLiteral i)

esModelo :: Interpretacion -> FNC -> Bool
esModelo i = all (esModeloClausula i)

modelosClausula :: Clausula -> [Interpretacion]
modelosClausula c =
  [i | i <- interpretacionesClausula c,
       esModeloClausula i c]

modelos :: FNC -> [Interpretacion]
modelos f =
  [i | i <- interpretaciones f,
       esModelo i f]

module Modelos_de_FNC where

import Interpretaciones_de_FNC

import Evaluacion_de_FNC

esModeloLiteral :: Interpretacion -> Literal -> Bool

esModeloLiteral i l

| l > 0 = l `elem` i

| otherwise = negate l `notElem` i

esModeloClausula :: Interpretacion -> Clausula -> Bool

esModeloClausula i = any (esModeloLiteral i)

esModelo :: Interpretacion -> FNC -> Bool

esModelo i = all (esModeloClausula i)

modelosClausula :: Clausula -> [Interpretacion]

modelosClausula c =

[i | i <- interpretacionesClausula c,

esModeloClausula i c]

modelos :: FNC -> [Interpretacion]

modelos f =

[i | i <- interpretaciones f,

esModelo i f]

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

«Por muy correcto que parezca un teorema matemático, nunca hay que conformarse con que no haya algo imperfecto en él hasta obtener la impresión de qie es bello.»

George Boole.

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

PorJosé A. Alonso 12-febrero-202019-febrero-2020

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

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

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

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

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

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

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)

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.

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

Reconocimiento de particiones

PorJosé A. Alonso 21-noviembre-201819-enero-2019

Una partición de un conjunto es una división del mismo en subconjuntos disjuntos no vacíos.

Definir la función

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

1	esParticion :: Eq a => [[a]] -> Bool

tal que (esParticion xss) se verifica si xss es una partición; es decir sus elementos son listas no vacías disjuntas. Por ejemplo.

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

esParticion [[1,3],[2],[9,5,7]] == True

esParticion [[1,3],[2],[9,5,1]] == False

esParticion [[1,3],[],[9,5,7]] == False

esParticion [[2,3,2],[4]] == True

Soluciones

import Data.List ((\\), intersect)

-- 1ª definición
-- =============

esParticion :: Eq a => [[a]] -> Bool
esParticion xss =
  [] `notElem` xss &&
  and [disjuntos xs ys | xs <- xss, ys <- xss \\ [xs]] 

disjuntos :: Eq a => [a] -> [a] -> Bool
disjuntos xs ys = null (xs `intersect` ys)

-- 2ª definición
-- =============

esParticion2 :: Eq a => [[a]] -> Bool
esParticion2 []       = True
esParticion2 (xs:xss) =
  not (null xs) &&
  and [disjuntos xs ys | ys <- xss] &&
  esParticion2 xss

-- 3ª definición
-- =============

esParticion3 :: Eq a => [[a]] -> Bool
esParticion3 []       = True
esParticion3 (xs:xss) =
  not (null xs) &&
  all (disjuntos xs) xss &&
  esParticion3 xss

-- Equivalencia
prop_equiv :: [[Int]] -> Bool
prop_equiv xss =
  and [esParticion xss == f xss | f <- [ esParticion2
                                       , esParticion3]]

-- Comprobación
--    λ> quickCheck prop_equiv
--    +++ OK, passed 100 tests.

-- Comparación de eficiencia:
--    λ> esParticion [[x] | x <- [1..3000]]
--    True
--    (4.37 secs, 3,527,956,400 bytes)
--    λ> esParticion2 [[x] | x <- [1..3000]]
--    True
--    (1.26 secs, 1,045,792,552 bytes)
--    λ> esParticion3 [[x] | x <- [1..3000]]
--    True
--    (1.30 secs, 1,045,795,272 bytes)
--    λ> esParticion3 [[x] | x <- [1..3000]]
--    True
--    (1.30 secs, 1,045,795,272 bytes)

import Data.List ((\\), intersect)

-- 1ª definición

-- =============

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

esParticion xss =

[] `notElem` xss &&

and [disjuntos xs ys | xs <- xss, ys <- xss \\ [xs]]

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

disjuntos xs ys = null (xs `intersect` ys)

-- 2ª definición

-- =============

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

esParticion2 [] = True

esParticion2 (xs:xss) =

not (null xs) &&

and [disjuntos xs ys | ys <- xss] &&

esParticion2 xss

-- 3ª definición

-- =============

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

esParticion3 [] = True

esParticion3 (xs:xss) =

not (null xs) &&

all (disjuntos xs) xss &&

esParticion3 xss

-- Equivalencia

prop_equiv :: [[Int]] -> Bool

prop_equiv xss =

and [esParticion xss == f xss | f <- [ esParticion2

, esParticion3]]

-- Comprobación

-- λ> quickCheck prop_equiv

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia:

-- λ> esParticion [[x] | x <- [1..3000]]

-- True

-- (4.37 secs, 3,527,956,400 bytes)

-- λ> esParticion2 [[x] | x <- [1..3000]]

-- True

-- (1.26 secs, 1,045,792,552 bytes)

-- λ> esParticion3 [[x] | x <- [1..3000]]

-- True

-- (1.30 secs, 1,045,795,272 bytes)

-- λ> esParticion3 [[x] | x <- [1..3000]]

-- True

-- (1.30 secs, 1,045,795,272 bytes)

Pensamiento

Sentía los cuatro vientos,
en la encrucijada
de su pensamiento.

Antonio Machado

Problema de las 3 jarras

PorJosé A. Alonso 23-mayo-201830-mayo-2018

En el problema de las tres jarras (A,B,C) se dispone de tres jarras de capacidades A, B y C litros con A > B > C y A par. Inicialmente la jarra mayor está llena y las otras dos vacías. Queremos, trasvasando adecuadamente el líquido entre las jarras, repartir por igual el contenido inicial entre las dos jarras mayores. Por ejemplo, para el problema (8,5,3) el contenido inicial es (8,0,0) y el final es (4,4,0).

Definir las funciones

   solucionesTresJarras :: Problema -> [[Estado]]
   tresJarras :: Problema -> Maybe [Estado]

1 2	solucionesTresJarras :: Problema -> [[Estado]] tresJarras :: Problema -> Maybe [Estado]

tales que

(solucionesTresJarras p) es la lista de soluciones del problema de las tres jarras p. Por ejemplo,

     λ> mapM_ print (solucionesTresJarras (4,2,1))
     [(4,0,0),(2,2,0)]
     [(4,0,0),(3,0,1),(1,2,1),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,1,1),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,1,1),(1,2,1),(2,2,0)]
     λ> mapM_ print (solucionesTresJarras (8,6,2))
     [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(6,0,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(2,6,0),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(2,6,0),(2,4,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(2,6,0),(2,4,2),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(4,2,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]
     λ> length (solucionesTresJarras (8,5,3))
     16
     λ> head (solucionesTresJarras (8,5,3))
     [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]
     λ> length (solucionesTresJarras (8,6,5))
     0

λ> mapM_ print (solucionesTresJarras (4,2,1))

[(4,0,0),(2,2,0)]

[(4,0,0),(3,0,1),(1,2,1),(2,2,0)]

[(4,0,0),(3,0,1),(3,1,0),(2,2,0)]

[(4,0,0),(3,0,1),(3,1,0),(2,1,1),(2,2,0)]

[(4,0,0),(3,0,1),(3,1,0),(2,1,1),(1,2,1),(2,2,0)]

λ> mapM_ print (solucionesTresJarras (8,6,2))

[(8,0,0),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(6,0,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(2,6,0),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(2,6,0),(2,4,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(2,6,0),(2,4,2),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(4,2,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]

λ> length (solucionesTresJarras (8,5,3))

λ> head (solucionesTresJarras (8,5,3))

[(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]

λ> length (solucionesTresJarras (8,6,5))

(tresJarras p) es una solución del problema de las tres jarras p con el mínimo mínimo número de trasvase, si p tiene solución y Nothing, en caso contrario. Por ejemplo,

     λ> tresJarras (4,2,1)
     Just [(4,0,0),(2,2,0)]
     λ> tresJarras (8,6,2)
     Just [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]
     λ> tresJarras (8,5,3)
     Just [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]
     λ> tresJarras (8,6,5)
     Nothing

λ> tresJarras (4,2,1)

Just [(4,0,0),(2,2,0)]

λ> tresJarras (8,6,2)

Just [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]

λ> tresJarras (8,5,3)

Just [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]

λ> tresJarras (8,6,5)

Nothing

Soluciones

import Data.Maybe (listToMaybe)

-- Para simplificar la notación se definen los tipos Problema y Estado
-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la
-- primera jarra, el segundo el de la segunda y el tercero el de la
-- tercera.
type Problema = (Int,Int,Int)

-- Un estado es una terna de números. El primero es el contenido de la
-- jarra de A litros, el segundo el de la de B litros y el tercero el de
-- la de C litros.
type Estado = (Int,Int,Int)

solucionesTresJarras :: Problema -> [[Estado]]
solucionesTresJarras p = busca [[inicial p]]
  where
    busca []        = []
    busca ((e:es):ns)  
      | esFinal p e = reverse (e:es) : busca ns
      | otherwise   = busca (ns ++ [e1:e:es | e1 <- sucesores p e
                                            , e1 `notElem` es])

-- (inicial p) es el estado inicial del problema p. Por ejemplo, 
--    inicial (8,5,3)  ==  (8,0,0)
inicial :: Problema -> Estado
inicial (a,_,_) = (a,0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las
-- tres jarras p. Por ejemplo,
--    esFinal (8,5,3) (4,4,0)  ==  True
--    esFinal (8,5,3) (4,0,4)  ==  False
esFinal :: Problema -> Estado -> Bool
esFinal (a,_,_) (x,y,z) =
  x == y && x + y == a

-- (sucesores p e) es la lista de los sucesores del estado e en el
-- problema de las tres jarras p. Por ejemplo, 
--    sucesores (8,5,3) (8,0,0)  ==  [(3,5,0),(5,0,3)]
--    sucesores (8,5,3) (3,5,0)  ==  [(0,5,3),(8,0,0),(3,2,3)]
sucesores :: Problema -> Estado -> [Estado]
sucesores (a,b,c) (x,y,z) =
     [(x-ab,y+ab,z)    | let ab = min x (b-y), ab > 0]
  ++ [(x-ac,y   ,z+ac) | let ac = min x (c-z), ac > 0]
  ++ [(x+ba,y-ba,z)    | let ba = min y (a-x), ba > 0]
  ++ [(x   ,y-bc,z+bc) | let bc = min y (c-z), bc > 0]
  ++ [(x+ca,y   ,z-ca) | let ca = min z (a-x), ca > 0]
  ++ [(x   ,y+cb,z-cb) | let cb = min z (b-y), cb > 0]
  
tresJarras :: Problema -> Maybe [Estado]
tresJarras p = listToMaybe (solucionesTresJarras p)

import Data.Maybe (listToMaybe)

-- Para simplificar la notación se definen los tipos Problema y Estado

-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la

-- primera jarra, el segundo el de la segunda y el tercero el de la

-- tercera.

type Problema = (Int,Int,Int)

-- Un estado es una terna de números. El primero es el contenido de la

-- jarra de A litros, el segundo el de la de B litros y el tercero el de

-- la de C litros.

type Estado = (Int,Int,Int)

solucionesTresJarras :: Problema -> [[Estado]]

solucionesTresJarras p = busca [[inicial p]]

where

busca [] = []

busca ((e:es):ns)

| esFinal p e = reverse (e:es) : busca ns

| otherwise = busca (ns ++ [e1:e:es | e1 <- sucesores p e

, e1 `notElem` es])

-- (inicial p) es el estado inicial del problema p. Por ejemplo,

-- inicial (8,5,3) == (8,0,0)

inicial :: Problema -> Estado

inicial (a,_,_) = (a,0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las

-- tres jarras p. Por ejemplo,

-- esFinal (8,5,3) (4,4,0) == True

-- esFinal (8,5,3) (4,0,4) == False

esFinal :: Problema -> Estado -> Bool

esFinal (a,_,_) (x,y,z) =

x == y && x + y == a

-- (sucesores p e) es la lista de los sucesores del estado e en el

-- problema de las tres jarras p. Por ejemplo,

-- sucesores (8,5,3) (8,0,0) == [(3,5,0),(5,0,3)]

-- sucesores (8,5,3) (3,5,0) == [(0,5,3),(8,0,0),(3,2,3)]

sucesores :: Problema -> Estado -> [Estado]

sucesores (a,b,c) (x,y,z) =

[(x-ab,y+ab,z) | let ab = min x (b-y), ab > 0]

++ [(x-ac,y ,z+ac) | let ac = min x (c-z), ac > 0]

++ [(x+ba,y-ba,z) | let ba = min y (a-x), ba > 0]

++ [(x ,y-bc,z+bc) | let bc = min y (c-z), bc > 0]

++ [(x+ca,y ,z-ca) | let ca = min z (a-x), ca > 0]

++ [(x ,y+cb,z-cb) | let cb = min z (b-y), cb > 0]

tresJarras :: Problema -> Maybe [Estado]

tresJarras p = listToMaybe (solucionesTresJarras p)

Caminos en un grafo

PorJosé A. Alonso 18-mayo-201825-abril-2021

Definir las funciones

   grafo   :: [(Int,Int)] -> Grafo Int Int
   caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

1 2	grafo :: [(Int,Int)] -> Grafo Int Int caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

tales que

(grafo as) es el grafo no dirigido definido cuyas aristas son as. Por ejemplo,

     ghci> grafo [(2,4),(4,5)]
     G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

1 2	ghci> grafo [(2,4),(4,5)] G ND (array (2,5) [(2,[(4,0)]),(3,[]),(4,[(2,0),(5,0)]),(5,[(4,0)])])

(caminos g a b) es la lista los caminos en el grafo g desde a hasta b sin pasar dos veces por el mismo nodo. Por ejemplo,

     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)
     [[1,3,5,7],[1,3,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)
     [[2,5,3,7],[2,5,7]]
     ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)
     [[1,3,5,2],[1,3,7,5,2]]
     ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4
     []
     ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
     109601

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 7)

[[1,3,5,7],[1,3,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 2 7)

[[2,5,3,7],[2,5,7]]

ghci> sort (caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 2)

[[1,3,5,2],[1,3,7,5,2]]

ghci> caminos (grafo [(1,3),(2,5),(3,5),(3,7),(5,7)]) 1 4

[]

ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

109601

Soluciones

import Data.List (sort)
import I1M.Grafo
import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int
grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]
    where ns = map fst as ++ map snd as
          m  = minimum ns
          n  = maximum ns

-- 1ª solución
-- ===========

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos g a b = aux [[b]] where 
    aux [] = []
    aux ((x:xs):yss)
        | x == a    = (x:xs) : aux yss
        | otherwise = aux ([z:x:xs | z <- adyacentes g x
                                   , z `notElem` (x:xs)] 
                           ++ yss) 

-- 2ª solución (mediante espacio de estados)
-- =========================================

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]
caminos2 g a b = buscaEE sucesores esFinal inicial
    where inicial          = [b]
          sucesores (x:xs) = [z:x:xs | z <- adyacentes g x
                                     , z `notElem` (x:xs)] 
          esFinal (x:xs)   = x == a

-- Comparación de eficiencia
-- =========================

--    ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.57 secs, 500533816 bytes)
--    ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)
--    109601
--    (3.53 secs, 470814096 bytes)

import Data.List (sort)

import I1M.Grafo

import I1M.BusquedaEnEspaciosDeEstados

grafo :: [(Int,Int)] -> Grafo Int Int

grafo as = creaGrafo ND (m,n) [(x,y,0) | (x,y) <- as]

where ns = map fst as ++ map snd as

m = minimum ns

n = maximum ns

-- 1ª solución

-- ===========

caminos :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos g a b = aux [[b]] where

aux [] = []

aux ((x:xs):yss)

| x == a = (x:xs) : aux yss

| otherwise = aux ([z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

++ yss)

-- 2ª solución (mediante espacio de estados)

-- =========================================

caminos2 :: Grafo Int Int -> Int -> Int -> [[Int]]

caminos2 g a b = buscaEE sucesores esFinal inicial

where inicial = [b]

sucesores (x:xs) = [z:x:xs | z <- adyacentes g x

, z `notElem` (x:xs)]

esFinal (x:xs) = x == a

-- Comparación de eficiencia

-- =========================

-- ghci> length (caminos (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.57 secs, 500533816 bytes)

-- ghci> length (caminos2 (grafo [(i,j) | i <- [1..10], j <- [i..10]]) 1 10)

-- 109601

-- (3.53 secs, 470814096 bytes)

Problema del dominó

PorJosé A. Alonso 16-mayo-201823-mayo-2018

Las fichas del dominó se pueden representar por pares de números enteros. El problema del dominó consiste en colocar todas las fichas de una lista dada de forma que el segundo número de cada ficha coincida con el primero de la siguiente.

Definir la función

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

1	domino :: [(Int,Int)] -> [[(Int,Int)]]

tal que (domino fs) es la lista de las soluciones del problema del dominó correspondiente a las fichas fs. Por ejemplo,

   λ> domino [(1,2),(2,3),(1,4)]
   [[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]
   λ> domino [(1,2),(1,1),(1,4)]
   [[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]
   λ> domino [(1,2),(3,4),(2,3)]
   [[(1,2),(2,3),(3,4)]]
   λ> domino [(1,2),(2,3),(5,4)]
   []
   λ> domino [(x,y) | x <- [1..2], y <- [x..2]]
   [[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]
   λ> [(x,y) | x <- [1..3], y <- [x..3]]
   [(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]
   λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])
   [(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]
   [(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]
   [(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]
   [(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]
   [(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]
   [(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]
   [(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]
   [(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]
   [(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]
   λ> length (domino [(x,y) | x <- [1..3], y <- [x..3]])
   9
   λ> length (domino [(x,y) | x <- [1..4], y <- [x..4]])
   0
   λ> length (domino [(x,y) | x <- [1..5], y <- [x..5]])
   84480

λ> domino [(1,2),(2,3),(1,4)]

[[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]

λ> domino [(1,2),(1,1),(1,4)]

[[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]

λ> domino [(1,2),(3,4),(2,3)]

[[(1,2),(2,3),(3,4)]]

λ> domino [(1,2),(2,3),(5,4)]

[]

λ> domino [(x,y) | x <- [1..2], y <- [x..2]]

[[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]

λ> [(x,y) | x <- [1..3], y <- [x..3]]

[(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]

λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])

[(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]

[(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]

[(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]

[(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]

[(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]

[(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]

[(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]

[(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]

[(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]

λ> length (domino [(x,y) | x <- [1..3], y <- [x..3]])

λ> length (domino [(x,y) | x <- [1..4], y <- [x..4]])

λ> length (domino [(x,y) | x <- [1..5], y <- [x..5]])

84480

Soluciones

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)
import Data.List (delete)

-- 1ª solución (por búsqueda en anchura)
-- =====================================

-- Las fichas son pares de números enteros.
type Ficha  = (Int,Int)

-- Un problema está definido por la lista de fichas que hay que colocar
type Problema = [Ficha]

-- Los estados son los pares formados por la listas sin colocar y las
-- colocadas. 
type Estado = ([Ficha],[Ficha])

-- (inicial p) es el estado inicial del problema p.
inicial :: Problema -> Estado
inicial p = (p,[])

-- (es final e) se verifica si e es un estado final.
esFinal :: Estado -> Bool
esFinal (fs,_) = null fs 

sucesores :: Estado -> [Estado]
sucesores (fs,[]) =
  [(delete f fs, [f]) | f <- fs]
sucesores (fs,n@((x,y):qs)) =
  [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++
  [(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++
  [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x] 

soluciones :: Problema -> [Estado]
soluciones p = busca [(inicial p)]
  where
    busca []        = []
    busca (e:es)  
      | esFinal e = e : busca es
      | otherwise = busca (es ++ sucesores e)

domino :: Problema -> [[Ficha]]
domino ps = map snd (soluciones ps)
      
-- 2ª solución (por búsqueda en profundidad)
-- =========================================

soluciones2 :: Problema -> [Estado]
soluciones2 p = busca [(inicial p)]
  where
    busca []        = []
    busca (e:es)  
      | esFinal e = e : busca es
      | otherwise = busca (sucesores e ++ es)

domino2 :: Problema -> [[Ficha]]
domino2 ps = map snd (soluciones2 ps)
      
-- 3ª solución (con I1M.BusquedaEnEspaciosDeEstados)
-- =================================================

domino3 :: Problema -> [[Ficha]]
domino3 ps = map snd (soluciones3 ps)

soluciones3 :: Problema -> [Estado]
soluciones3 ps = buscaEE sucesores
                         esFinal         
                         (inicial ps)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

import Data.List (delete)

-- 1ª solución (por búsqueda en anchura)

-- =====================================

-- Las fichas son pares de números enteros.

type Ficha = (Int,Int)

-- Un problema está definido por la lista de fichas que hay que colocar

type Problema = [Ficha]

-- Los estados son los pares formados por la listas sin colocar y las

-- colocadas.

type Estado = ([Ficha],[Ficha])

-- (inicial p) es el estado inicial del problema p.

inicial :: Problema -> Estado

inicial p = (p,[])

-- (es final e) se verifica si e es un estado final.

esFinal :: Estado -> Bool

esFinal (fs,_) = null fs

sucesores :: Estado -> [Estado]

sucesores (fs,[]) =

[(delete f fs, [f]) | f <- fs]

sucesores (fs,n@((x,y):qs)) =

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++

[(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x]

soluciones :: Problema -> [Estado]

soluciones p = busca [(inicial p)]

where

busca [] = []

busca (e:es)

| esFinal e = e : busca es

| otherwise = busca (es ++ sucesores e)

domino :: Problema -> [[Ficha]]

domino ps = map snd (soluciones ps)

-- 2ª solución (por búsqueda en profundidad)

-- =========================================

soluciones2 :: Problema -> [Estado]

soluciones2 p = busca [(inicial p)]

where

busca [] = []

busca (e:es)

| esFinal e = e : busca es

| otherwise = busca (sucesores e ++ es)

domino2 :: Problema -> [[Ficha]]

domino2 ps = map snd (soluciones2 ps)

-- 3ª solución (con I1M.BusquedaEnEspaciosDeEstados)

-- =================================================

domino3 :: Problema -> [[Ficha]]

domino3 ps = map snd (soluciones3 ps)

soluciones3 :: Problema -> [Estado]

soluciones3 ps = buscaEE sucesores

esFinal

(inicial ps)

Sucesión de Recamán

PorJosé A. Alonso 11-mayo-201826-marzo-2022

La sucesión de Recamán está definida como sigue:

   a(0) = 0
   a(n) = a(n-1) - n, si a(n-1) > n y no figura ya en la sucesión
   a(n) = a(n-1) + n, en caso contrario.

a(0) = 0

a(n) = a(n-1) - n, si a(n-1) > n y no figura ya en la sucesión

a(n) = a(n-1) + n, en caso contrario.

Definir las funciones

   sucRecaman :: [Int]
   invRecaman :: Int -> Int
   graficaSucRecaman :: Int -> IO ()
   graficaInvRecaman :: Int -> IO ()

sucRecaman :: [Int]

invRecaman :: Int -> Int

graficaSucRecaman :: Int -> IO ()

graficaInvRecaman :: Int -> IO ()

tales que

sucRecaman es la lista de los términos de la sucesión de Recamám. Por ejemplo,

      λ> take 25 sucRecaman3
      [0,1,3,6,2,7,13,20,12,21,11,22,10,23,9,24,8,25,43,62,42,63,41,18,42]
      λ> sucRecaman !! 1000
      3686
      λ> sucRecaman !! 1000001
      1057163

λ> take 25 sucRecaman3

[0,1,3,6,2,7,13,20,12,21,11,22,10,23,9,24,8,25,43,62,42,63,41,18,42]

λ> sucRecaman !! 1000

3686

λ> sucRecaman !! 1000001

1057163

(invRecaman n) es la primera posición de n en la sucesión de Recamán. Por ejemplo,

      invRecaman 10       ==  12
      invRecaman 3686     ==  1000
      invRecaman 1057163  ==  1000001

invRecaman 10 == 12

invRecaman 3686 == 1000

invRecaman 1057163 == 1000001

(graficaSucRecaman n) dibuja los n primeros términos de la sucesión de Recamán. Por ejemplo, (graficaSucRecaman 300) dibuja
(graficaInvRecaman n) dibuja los valores de (invRecaman k) para k entre 0 y n. Por ejemplo, (graficaInvRecaman 17) dibuja

y (graficaInvRecaman 100) dibuja

Soluciones

import qualified Data.Set as S

-- 1ª solución
-- ===========

sucRecaman1 :: [Int]
sucRecaman1 = map suc1 [0..]

suc1 :: Int -> Int
suc1 0 = 0
suc1 n | y > n && y - n `notElem` ys = y - n
       | otherwise                   = y + n
  where y  = suc1 (n - 1)
        ys = [suc1 k | k <- [0..n - 1]]

-- 2ª solución
-- ===========

sucRecaman2 :: [Int]
sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)
  where f y n ys | y > n && y - n `notElem` take n ys = y - n
                 | otherwise                          = y + n

-- 3ª solución
-- ===========

sucRecaman3 :: [Int]
sucRecaman3 = 0 : recaman (S.singleton 0) 1 0

recaman :: S.Set Int -> Int -> Int -> [Int]
recaman s n x
  | x > n && (x-n) `S.notMember` s =
    (x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)
  | otherwise =
    (x+n):recaman (S.insert (x+n) s) (n+1) (x+n) 

-- Comparación de eficiencia:
--    λ> sucRecaman1 !! 25
--    17
--    (3.76 secs, 2,394,593,952 bytes)
--    λ> sucRecaman2 !! 25
--    17
--    (0.00 secs, 0 bytes)
--    λ> sucRecaman3 !! 25
--    17
--    (0.00 secs, 0 bytes)
--
--    λ> sucRecaman2 !! (2*10^4)
--    14358
--    (2.69 secs, 6,927,559,784 bytes)
--    λ> sucRecaman3 !! (2*10^4)
--    14358
--    (0.04 secs, 0 bytes)

-- Definición de invRecaman
invRecaman :: Int -> Int
invRecaman n =
  length (takeWhile (/=n) sucRecaman3)

graficaSucRecaman :: Int -> IO ()
graficaSucRecaman n =
  plotList [Key Nothing]
           (take n sucRecaman3)

graficaInvRecaman :: Int -> IO ()
graficaInvRecaman n =
  plotList [Key Nothing]
           [invRecaman k | k <- [0..n]]

import qualified Data.Set as S

-- 1ª solución

-- ===========

sucRecaman1 :: [Int]

sucRecaman1 = map suc1 [0..]

suc1 :: Int -> Int

suc1 0 = 0

suc1 n | y > n && y - n `notElem` ys = y - n

| otherwise = y + n

where y = suc1 (n - 1)

ys = [suc1 k | k <- [0..n - 1]]

-- 2ª solución

-- ===========

sucRecaman2 :: [Int]

sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)

where f y n ys | y > n && y - n `notElem` take n ys = y - n

| otherwise = y + n

-- 3ª solución

-- ===========

sucRecaman3 :: [Int]

sucRecaman3 = 0 : recaman (S.singleton 0) 1 0

recaman :: S.Set Int -> Int -> Int -> [Int]

recaman s n x

| x > n && (x-n) `S.notMember` s =

(x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)

| otherwise =

(x+n):recaman (S.insert (x+n) s) (n+1) (x+n)

-- Comparación de eficiencia:

-- λ> sucRecaman1 !! 25

-- 17

-- (3.76 secs, 2,394,593,952 bytes)

-- λ> sucRecaman2 !! 25

-- 17

-- (0.00 secs, 0 bytes)

-- λ> sucRecaman3 !! 25

-- 17

-- (0.00 secs, 0 bytes)

-- λ> sucRecaman2 !! (2*10^4)

-- 14358

-- (2.69 secs, 6,927,559,784 bytes)

-- λ> sucRecaman3 !! (2*10^4)

-- 14358

-- (0.04 secs, 0 bytes)

-- Definición de invRecaman

invRecaman :: Int -> Int

invRecaman n =

length (takeWhile (/=n) sucRecaman3)

graficaSucRecaman :: Int -> IO ()

graficaSucRecaman n =

plotList [Key Nothing]

(take n sucRecaman3)

graficaInvRecaman :: Int -> IO ()

graficaInvRecaman n =

plotList [Key Nothing]

[invRecaman k | k <- [0..n]]

Problema de las jarras

PorJosé A. Alonso 10-mayo-201817-mayo-2018

En el problema de las jarras (A,B,C) se tienen dos jarras sin marcas de medición, una de A litros de capacidad y otra de B. También se dispone de una bomba que permite llenar las jarras de agua.

El problema de las jarras (A,B,C) consiste en determinar cómo se puede lograr tener exactamente C litros de agua en alguna de las dos jarras.

Definir la función

   jarras :: (Int,Int,Int) -> Maybe [(Int,Int)]

1	jarras :: (Int,Int,Int) -> Maybe [(Int,Int)]

tal (jarras (a,b,c)) es una solución del problema de las jarras (a,b,c) con el mínimo número de movimientos, si el problema tiene solución y Nothing, en caso contrario. Por ejemplo,

   λ> jarras (5,3,4)
   Just [(0,0),(5,0),(2,3),(2,0),(0,2),(5,2),(4,3)]

1 2	λ> jarras (5,3,4) Just [(0,0),(5,0),(2,3),(2,0),(0,2),(5,2),(4,3)]

La interpretación de la solución anterior es

   (0,0) se inicia con las dos jarras vacías,
   (5,0) se llena la jarra de 5 con el grifo,
   (2,3) se llena la de 3 con la de 5,
   (2,0) se vacía la de 3,
   (0,2) se pasa el contenido de la primera a la segunda,
   (5,2) se llena la primera con el grifo,
   (4,3) se llena la segunda con la primera.

(0,0) se inicia con las dos jarras vacías,

(5,0) se llena la jarra de 5 con el grifo,

(2,3) se llena la de 3 con la de 5,

(2,0) se vacía la de 3,

(0,2) se pasa el contenido de la primera a la segunda,

(5,2) se llena la primera con el grifo,

(4,3) se llena la segunda con la primera.

Otros ejemplos:

   λ> jarras (3,5,4)
   Just [(0,0),(0,5),(3,2),(0,2),(2,0),(2,5),(3,4)]
   λ> jarras (15,10,5)
   Just [(0,0),(15,0),(5,10)]
   λ> jarras (15,10,4)
   Nothing
   λ> length <$> jarras (181,179,100)
   Just 199

λ> jarras (3,5,4)

Just [(0,0),(0,5),(3,2),(0,2),(2,0),(2,5),(3,4)]

λ> jarras (15,10,5)

Just [(0,0),(15,0),(5,10)]

λ> jarras (15,10,4)

Nothing

λ> length <$> jarras (181,179,100)

Just 199

Soluciones

import Data.Maybe (listToMaybe, isJust)

-- Para simplificar la notación se definen los tipos Problema y Estado
-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la
-- primera jarra, el segundo el de la segunda y el tercero es el número
-- de litros que hay que obtener.
type Problema = (Int,Int,Int)

-- Un estado es un par de números. El primero es el contenido de la
-- jarra de A litros y el segundo el de la de B litros.  
type Estado = (Int,Int)

jarras :: Problema -> Maybe [Estado]
jarras p | null ns   = Nothing
         | otherwise = Just (head ns)
  where ns = soluciones p

-- (soluciones p) es la lista de soluciones del problema p. Por ejemplo, 
--    λ> take 2 (soluciones (15,10,5))
--    [[(0,0),(15,0),(5,10)],[(0,0),(0,10),(15,10),(15,0),(5,10)]]
--    λ> length (soluciones (15,10,5))
--    6
--    λ> soluciones (15,10,4)
--    []
soluciones :: Problema -> [[Estado]]
soluciones p = busca [[inicial]]
  where
    busca []        = []
    busca ((e:es):ns)  
      | esFinal p e = (reverse (e:es)) : busca ns
      | otherwise   = busca (ns ++ [e1:e:es | e1 <- sucesores p e
                                            , e1 `notElem` es])

-- inicial es el estado inicial
inicial :: Estado
inicial = (0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las
-- jarras p. Por ejemplo,
--    esFinal (5,4,3) (3,2)  ==  True
--    esFinal (5,4,3) (2,3)  ==  True
--    esFinal (5,4,1) (2,3)  ==  False
esFinal :: Problema -> Estado -> Bool
esFinal (_,_,c) (x,y) = x == c || y == c

-- (sucesores p e) es la lista de los sucesores del estado e. Por
-- ejemplo, 
--    λ> sucesores (7,4,3) (1,2)
--    [(7,2),(1,4),(0,2),(1,0),(3,0),(0,3)]
--    λ> sucesores (7,4,3) (6,3)
--    [(7,3),(6,4),(0,3),(6,0),(7,2),(5,4)]
sucesores :: Problema -> Estado -> [Estado]
sucesores (a,b,_) (x,y) =
    [(a,y) | x < a] ++
    [(x,b) | y < b] ++
    [(0,y) | x > 0] ++
    [(x,0) | y > 0] ++
    [(a,y-(a-x)) | x < a, y > a - x] ++
    [(x-(b-y),b) | y < b, x > b - y] ++
    [(x+y,0) | y > 0, x + y <= a] ++ 
    [(0,x+y) | x > 0, x + y <= b]

-- La definición de jarras se puede simplificar usando listToMaybe
jarras2 :: Problema -> Maybe [Estado]
jarras2 p = listToMaybe (soluciones p)

import Data.Maybe (listToMaybe, isJust)

-- Para simplificar la notación se definen los tipos Problema y Estado

-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la

-- primera jarra, el segundo el de la segunda y el tercero es el número

-- de litros que hay que obtener.

type Problema = (Int,Int,Int)

-- Un estado es un par de números. El primero es el contenido de la

-- jarra de A litros y el segundo el de la de B litros.

type Estado = (Int,Int)

jarras :: Problema -> Maybe [Estado]

jarras p | null ns = Nothing

| otherwise = Just (head ns)

where ns = soluciones p

-- (soluciones p) es la lista de soluciones del problema p. Por ejemplo,

-- λ> take 2 (soluciones (15,10,5))

-- [[(0,0),(15,0),(5,10)],[(0,0),(0,10),(15,10),(15,0),(5,10)]]

-- λ> length (soluciones (15,10,5))

-- 6

-- λ> soluciones (15,10,4)

-- []

soluciones :: Problema -> [[Estado]]

soluciones p = busca [[inicial]]

where

busca [] = []

busca ((e:es):ns)

| esFinal p e = (reverse (e:es)) : busca ns

| otherwise = busca (ns ++ [e1:e:es | e1 <- sucesores p e

, e1 `notElem` es])

-- inicial es el estado inicial

inicial :: Estado

inicial = (0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las

-- jarras p. Por ejemplo,

-- esFinal (5,4,3) (3,2) == True

-- esFinal (5,4,3) (2,3) == True

-- esFinal (5,4,1) (2,3) == False

esFinal :: Problema -> Estado -> Bool

esFinal (_,_,c) (x,y) = x == c || y == c

-- (sucesores p e) es la lista de los sucesores del estado e. Por

-- ejemplo,

-- λ> sucesores (7,4,3) (1,2)

-- [(7,2),(1,4),(0,2),(1,0),(3,0),(0,3)]

-- λ> sucesores (7,4,3) (6,3)

-- [(7,3),(6,4),(0,3),(6,0),(7,2),(5,4)]

sucesores :: Problema -> Estado -> [Estado]

sucesores (a,b,_) (x,y) =

[(a,y) | x < a] ++

[(x,b) | y < b] ++

[(0,y) | x > 0] ++

[(x,0) | y > 0] ++

[(a,y-(a-x)) | x < a, y > a - x] ++

[(x-(b-y),b) | y < b, x > b - y] ++

[(x+y,0) | y > 0, x + y <= a] ++

[(0,x+y) | x > 0, x + y <= b]

-- La definición de jarras se puede simplificar usando listToMaybe

jarras2 :: Problema -> Maybe [Estado]

jarras2 p = listToMaybe (soluciones p)

Problema de las 3 jarras

PorJosé A. Alonso 28-abril-201725-abril-2021

Definir las funciones

   solucionesTresJarras :: Problema -> [[Estado]]
   tresJarras :: Problema -> Maybe [Estado]

1 2	solucionesTresJarras :: Problema -> [[Estado]] tresJarras :: Problema -> Maybe [Estado]

tales que

(solucionesTresJarras p) es la lista de soluciones del problema de las tres jarras p. Por ejemplo,

     λ> mapM_ print (solucionesTresJarras (4,2,1))
     [(4,0,0),(2,2,0)]
     [(4,0,0),(3,0,1),(1,2,1),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,1,1),(2,2,0)]
     [(4,0,0),(3,0,1),(3,1,0),(2,1,1),(1,2,1),(2,2,0)]
     λ> mapM_ print (solucionesTresJarras (8,6,2))
     [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(6,0,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(2,6,0),(2,4,2),(4,4,0)]
     [(8,0,0),(2,6,0),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(2,6,0),(2,4,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(2,6,0),(2,4,2),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]
     [(8,0,0),(6,0,2),(6,2,0),(4,2,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]
     λ> length (solucionesTresJarras (8,5,3))
     16
     λ> head (solucionesTresJarras (8,5,3))
     [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]
     λ> length (solucionesTresJarras (8,6,5))
     0

λ> mapM_ print (solucionesTresJarras (4,2,1))

[(4,0,0),(2,2,0)]

[(4,0,0),(3,0,1),(1,2,1),(2,2,0)]

[(4,0,0),(3,0,1),(3,1,0),(2,2,0)]

[(4,0,0),(3,0,1),(3,1,0),(2,1,1),(2,2,0)]

[(4,0,0),(3,0,1),(3,1,0),(2,1,1),(1,2,1),(2,2,0)]

λ> mapM_ print (solucionesTresJarras (8,6,2))

[(8,0,0),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(6,0,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(2,6,0),(2,4,2),(4,4,0)]

[(8,0,0),(2,6,0),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(2,6,0),(2,4,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(2,6,0),(2,4,2),(0,6,2),(6,0,2),(6,2,0),(4,2,2),(4,4,0)]

[(8,0,0),(6,0,2),(6,2,0),(4,2,2),(0,6,2),(2,6,0),(2,4,2),(4,4,0)]

λ> length (solucionesTresJarras (8,5,3))

λ> head (solucionesTresJarras (8,5,3))

[(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]

λ> length (solucionesTresJarras (8,6,5))

(tresJarras p) es una solución del problema de las tres jarras p con el mínimo mínimo número de trasvase, si p tiene solución y Nothing, en caso contrario. Por ejemplo,

     λ> tresJarras (4,2,1)
     Just [(4,0,0),(2,2,0)]
     λ> tresJarras (8,6,2)
     Just [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]
     λ> tresJarras (8,5,3)
     Just [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]
     λ> tresJarras (8,6,5)
     Nothing

λ> tresJarras (4,2,1)

Just [(4,0,0),(2,2,0)]

λ> tresJarras (8,6,2)

Just [(8,0,0),(2,6,0),(2,4,2),(4,4,0)]

λ> tresJarras (8,5,3)

Just [(8,0,0),(3,5,0),(3,2,3),(6,2,0),(6,0,2),(1,5,2),(1,4,3),(4,4,0)]

λ> tresJarras (8,6,5)

Nothing

Soluciones

import Data.Maybe (listToMaybe)

-- Para simplificar la notación se definen los tipos Problema y Estado
-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la
-- primera jarra, el segundo el de la segunda y el tercero el de la
-- tercera.
type Problema = (Int,Int,Int)

-- Un estado es una terna de números. El primero es el contenido de la
-- jarra de A litros, el segundo el de la de B litros y el tercero el de
-- la de C litros.
type Estado = (Int,Int,Int)

solucionesTresJarras :: Problema -> [[Estado]]
solucionesTresJarras p = busca [[inicial p]]
  where
    busca []        = []
    busca ((e:es):ns)  
      | esFinal p e = reverse (e:es) : busca ns
      | otherwise   = busca (ns ++ [e1:e:es | e1 <- sucesores p e
                                            , e1 `notElem` es])

-- (inicial p) es el estado inicial del problema p. Por ejemplo, 
--    inicial (8,5,3)  ==  (8,0,0)
inicial :: Problema -> Estado
inicial (a,_,_) = (a,0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las
-- tres jarras p. Por ejemplo,
--    esFinal (8,5,3) (4,4,0)  ==  True
--    esFinal (8,5,3) (4,0,4)  ==  False
esFinal :: Problema -> Estado -> Bool
esFinal (a,_,_) (x,y,z) =
  x == y && x + y == a

-- (sucesores p e) es la lista de los sucesores del estado e en el
-- problema de las tres jarras p. Por ejemplo, 
--    sucesores (8,5,3) (8,0,0)  ==  [(3,5,0),(5,0,3)]
--    sucesores (8,5,3) (3,5,0)  ==  [(0,5,3),(8,0,0),(3,2,3)]
sucesores :: Problema -> Estado -> [Estado]
sucesores (a,b,c) (x,y,z) =
     [(x-ab,y+ab,z)    | let ab = min x (b-y), ab > 0]
  ++ [(x-ac,y   ,z+ac) | let ac = min x (c-z), ac > 0]
  ++ [(x+ba,y-ba,z)    | let ba = min y (a-x), ba > 0]
  ++ [(x   ,y-bc,z+bc) | let bc = min y (c-z), bc > 0]
  ++ [(x+ca,y   ,z-ca) | let ca = min z (a-x), ca > 0]
  ++ [(x   ,y+cb,z-cb) | let cb = min z (b-y), cb > 0]
  
tresJarras :: Problema -> Maybe [Estado]
tresJarras p = listToMaybe (solucionesTresJarras p)

import Data.Maybe (listToMaybe)

-- Para simplificar la notación se definen los tipos Problema y Estado

-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la

-- primera jarra, el segundo el de la segunda y el tercero el de la

-- tercera.

type Problema = (Int,Int,Int)

-- Un estado es una terna de números. El primero es el contenido de la

-- jarra de A litros, el segundo el de la de B litros y el tercero el de

-- la de C litros.

type Estado = (Int,Int,Int)

solucionesTresJarras :: Problema -> [[Estado]]

solucionesTresJarras p = busca [[inicial p]]

where

busca [] = []

busca ((e:es):ns)

| esFinal p e = reverse (e:es) : busca ns

| otherwise = busca (ns ++ [e1:e:es | e1 <- sucesores p e

, e1 `notElem` es])

-- (inicial p) es el estado inicial del problema p. Por ejemplo,

-- inicial (8,5,3) == (8,0,0)

inicial :: Problema -> Estado

inicial (a,_,_) = (a,0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las

-- tres jarras p. Por ejemplo,

-- esFinal (8,5,3) (4,4,0) == True

-- esFinal (8,5,3) (4,0,4) == False

esFinal :: Problema -> Estado -> Bool

esFinal (a,_,_) (x,y,z) =

x == y && x + y == a

-- (sucesores p e) es la lista de los sucesores del estado e en el

-- problema de las tres jarras p. Por ejemplo,

-- sucesores (8,5,3) (8,0,0) == [(3,5,0),(5,0,3)]

-- sucesores (8,5,3) (3,5,0) == [(0,5,3),(8,0,0),(3,2,3)]

sucesores :: Problema -> Estado -> [Estado]

sucesores (a,b,c) (x,y,z) =

[(x-ab,y+ab,z) | let ab = min x (b-y), ab > 0]

++ [(x-ac,y ,z+ac) | let ac = min x (c-z), ac > 0]

++ [(x+ba,y-ba,z) | let ba = min y (a-x), ba > 0]

++ [(x ,y-bc,z+bc) | let bc = min y (c-z), bc > 0]

++ [(x+ca,y ,z-ca) | let ca = min z (a-x), ca > 0]

++ [(x ,y+cb,z-cb) | let cb = min z (b-y), cb > 0]

tresJarras :: Problema -> Maybe [Estado]

tresJarras p = listToMaybe (solucionesTresJarras p)

Sucesión de Recamán

PorJosé A. Alonso 24-abril-201726-marzo-2022

La sucesión de Recamán está definida como sigue:

   a(0) = 0
   a(n) = a(n-1) - n, si a(n-1) > n y no figura ya en la sucesión
   a(n) = a(n-1) + n, en caso contrario.

a(0) = 0

a(n) = a(n-1) - n, si a(n-1) > n y no figura ya en la sucesión

a(n) = a(n-1) + n, en caso contrario.

Definir las funciones

   sucRecaman :: [Int]
   invRecaman :: Int -> Int
   graficaSucRecaman :: Int -> IO ()
   graficaInvRecaman :: Int -> IO ()

sucRecaman :: [Int]

invRecaman :: Int -> Int

graficaSucRecaman :: Int -> IO ()

graficaInvRecaman :: Int -> IO ()

tales que

sucRecaman es la lista de los términos de la sucesión de Recamám. Por ejemplo,

      λ> take 25 sucRecaman3
      [0,1,3,6,2,7,13,20,12,21,11,22,10,23,9,24,8,25,43,62,42,63,41,18,42]
      λ> sucRecaman !! 1000
      3686
      λ> sucRecaman !! 1000001
      1057163

λ> take 25 sucRecaman3

[0,1,3,6,2,7,13,20,12,21,11,22,10,23,9,24,8,25,43,62,42,63,41,18,42]

λ> sucRecaman !! 1000

3686

λ> sucRecaman !! 1000001

1057163

(invRecaman n) es la primera posición de n en la sucesión de Recamán. Por ejemplo,

      invRecaman 10       ==  12
      invRecaman 3686     ==  1000
      invRecaman 1057163  ==  1000001

invRecaman 10 == 12

invRecaman 3686 == 1000

invRecaman 1057163 == 1000001

(graficaSucRecaman n) dibuja los n primeros términos de la sucesión de Recamán. Por ejemplo, (graficaSucRecaman 300) dibuja
(graficaInvRecaman n) dibuja los valores de (invRecaman k) para k entre 0 y n. Por ejemplo, (graficaInvRecaman 17) dibuja

y (graficaInvRecaman 100) dibuja

Soluciones

import qualified Data.Set as S

-- 1ª solución
-- ===========

sucRecaman1 :: [Int]
sucRecaman1 = map suc1 [0..]

suc1 :: Int -> Int
suc1 0 = 0
suc1 n | y > n && y - n `notElem` ys = y - n
       | otherwise                   = y + n
  where y  = suc1 (n - 1)
        ys = [suc1 k | k <- [0..n - 1]]

-- 2ª solución
-- ===========

sucRecaman2 :: [Int]
sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)
  where f y n ys | y > n && y - n `notElem` take n ys = y - n
                 | otherwise                          = y + n

-- 3ª solución
-- ===========

sucRecaman3 :: [Int]
sucRecaman3 = 0 : recaman (S.singleton 0) 1 0

recaman :: S.Set Int -> Int -> Int -> [Int]
recaman s n x
  | x > n && (x-n) `S.notMember` s =
    (x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)
  | otherwise =
    (x+n):recaman (S.insert (x+n) s) (n+1) (x+n) 

-- Comparación de eficiencia:
--    λ> sucRecaman1 !! 25
--    17
--    (3.76 secs, 2,394,593,952 bytes)
--    λ> sucRecaman2 !! 25
--    17
--    (0.00 secs, 0 bytes)
--    λ> sucRecaman3 !! 25
--    17
--    (0.00 secs, 0 bytes)
--
--    λ> sucRecaman2 !! (2*10^4)
--    14358
--    (2.69 secs, 6,927,559,784 bytes)
--    λ> sucRecaman3 !! (2*10^4)
--    14358
--    (0.04 secs, 0 bytes)

-- Definición de invRecaman
invRecaman :: Int -> Int
invRecaman n =
  length (takeWhile (/=n) sucRecaman3)

graficaSucRecaman :: Int -> IO ()
graficaSucRecaman n =
  plotList [Key Nothing]
           (take n sucRecaman3)

graficaInvRecaman :: Int -> IO ()
graficaInvRecaman n =
  plotList [Key Nothing]
           [invRecaman k | k <- [0..n]]

import qualified Data.Set as S

-- 1ª solución

-- ===========

sucRecaman1 :: [Int]

sucRecaman1 = map suc1 [0..]

suc1 :: Int -> Int

suc1 0 = 0

suc1 n | y > n && y - n `notElem` ys = y - n

| otherwise = y + n

where y = suc1 (n - 1)

ys = [suc1 k | k <- [0..n - 1]]

-- 2ª solución

-- ===========

sucRecaman2 :: [Int]

sucRecaman2 = 0:zipWith3 f sucRecaman2 [1..] (repeat sucRecaman2)

where f y n ys | y > n && y - n `notElem` take n ys = y - n

| otherwise = y + n

-- 3ª solución

-- ===========

sucRecaman3 :: [Int]

sucRecaman3 = 0 : recaman (S.singleton 0) 1 0

recaman :: S.Set Int -> Int -> Int -> [Int]

recaman s n x

| x > n && (x-n) `S.notMember` s =

(x-n) : recaman (S.insert (x-n) s) (n+1) (x-n)

| otherwise =

(x+n):recaman (S.insert (x+n) s) (n+1) (x+n)

-- Comparación de eficiencia:

-- λ> sucRecaman1 !! 25

-- 17

-- (3.76 secs, 2,394,593,952 bytes)

-- λ> sucRecaman2 !! 25

-- 17

-- (0.00 secs, 0 bytes)

-- λ> sucRecaman3 !! 25

-- 17

-- (0.00 secs, 0 bytes)

-- λ> sucRecaman2 !! (2*10^4)

-- 14358

-- (2.69 secs, 6,927,559,784 bytes)

-- λ> sucRecaman3 !! (2*10^4)

-- 14358

-- (0.04 secs, 0 bytes)

-- Definición de invRecaman

invRecaman :: Int -> Int

invRecaman n =

length (takeWhile (/=n) sucRecaman3)

graficaSucRecaman :: Int -> IO ()

graficaSucRecaman n =

plotList [Key Nothing]

(take n sucRecaman3)

graficaInvRecaman :: Int -> IO ()

graficaInvRecaman n =

plotList [Key Nothing]

[invRecaman k | k <- [0..n]]

Problema de las jarras

PorJosé A. Alonso 11-abril-201725-abril-2021

En el problema de las jarras (A,B,C) se tienen dos jarras sin marcas de medición, una de A litros de capacidad y otra de B. También se dispone de una bomba que permite llenar las jarras de agua.

El problema de las jarras (A,B,C) consiste en determinar cómo se puede lograr tener exactamente C litros de agua en alguna de las dos jarras.

Definir la función

   jarras :: (Int,Int,Int) -> Maybe [(Int,Int)]

1	jarras :: (Int,Int,Int) -> Maybe [(Int,Int)]

tal (jarras (a,b,c)) es una solución del problema de las jarras (a,b,c) con el mínimo número de movimientos, si el problema tiene solución y Nothing, en caso contrario. Por ejemplo,

   λ> jarras (5,3,4)
   Just [(0,0),(5,0),(2,3),(2,0),(0,2),(5,2),(4,3)]

1 2	λ> jarras (5,3,4) Just [(0,0),(5,0),(2,3),(2,0),(0,2),(5,2),(4,3)]

La interpretación de la solución anterior es

   (0,0) se inicia con las dos jarras vacías,
   (5,0) se llena la jarra de 5 con el grifo,
   (2,3) se llena la de 3 con la de 5,
   (2,0) se vacía la de 3,
   (0,2) se pasa el contenido de la primera a la segunda,
   (5,2) se llena la primera con el grifo,
   (4,3) se llena la segunda con la primera.

(0,0) se inicia con las dos jarras vacías,

(5,0) se llena la jarra de 5 con el grifo,

(2,3) se llena la de 3 con la de 5,

(2,0) se vacía la de 3,

(0,2) se pasa el contenido de la primera a la segunda,

(5,2) se llena la primera con el grifo,

(4,3) se llena la segunda con la primera.

Otros ejemplos:

   λ> jarras (3,5,4)
   Just [(0,0),(0,5),(3,2),(0,2),(2,0),(2,5),(3,4)]
   λ> jarras (15,10,5)
   Just [(0,0),(15,0),(5,10)]
   λ> jarras (15,10,4)
   Nothing
   λ> length <$> jarras (181,179,100)
   Just 199

λ> jarras (3,5,4)

Just [(0,0),(0,5),(3,2),(0,2),(2,0),(2,5),(3,4)]

λ> jarras (15,10,5)

Just [(0,0),(15,0),(5,10)]

λ> jarras (15,10,4)

Nothing

λ> length <$> jarras (181,179,100)

Just 199

Soluciones

import Data.Maybe (listToMaybe, isJust)

-- Para simplificar la notación se definen los tipos Problema y Estado
-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la
-- primera jarra, el segundo el de la segunda y el tercero es el número
-- de litros que hay que obtener.
type Problema = (Int,Int,Int)

-- Un estado es un par de números. El primero es el contenido de la
-- jarra de A litros y el segundo el de la de B litros.  
type Estado = (Int,Int)

jarras :: Problema -> Maybe [Estado]
jarras p | null ns   = Nothing
         | otherwise = Just (head ns)
  where ns = soluciones p

-- (soluciones p) es la lista de soluciones del problema p. Por ejemplo, 
--    λ> take 2 (soluciones (15,10,5))
--    [[(0,0),(15,0),(5,10)],[(0,0),(0,10),(15,10),(15,0),(5,10)]]
--    λ> length (soluciones (15,10,5))
--    6
--    λ> soluciones (15,10,4)
--    []
soluciones :: Problema -> [[Estado]]
soluciones p = busca [[inicial]]
  where
    busca []        = []
    busca ((e:es):ns)  
      | esFinal p e = (reverse (e:es)) : busca ns
      | otherwise   = busca (ns ++ [e1:e:es | e1 <- sucesores p e
                                            , e1 `notElem` es])

-- inicial es el estado inicial
inicial :: Estado
inicial = (0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las
-- jarras p. Por ejemplo,
--    esFinal (5,4,3) (3,2)  ==  True
--    esFinal (5,4,3) (2,3)  ==  True
--    esFinal (5,4,1) (2,3)  ==  False
esFinal :: Problema -> Estado -> Bool
esFinal (_,_,c) (x,y) = x == c || y == c

-- (sucesores p e) es la lista de los sucesores del estado e. Por
-- ejemplo, 
--    λ> sucesores (7,4,3) (1,2)
--    [(7,2),(1,4),(0,2),(1,0),(3,0),(0,3)]
--    λ> sucesores (7,4,3) (6,3)
--    [(7,3),(6,4),(0,3),(6,0),(7,2),(5,4)]
sucesores :: Problema -> Estado -> [Estado]
sucesores (a,b,_) (x,y) =
    [(a,y) | x < a] ++
    [(x,b) | y < b] ++
    [(0,y) | x > 0] ++
    [(x,0) | y > 0] ++
    [(a,y-(a-x)) | x < a, y > a - x] ++
    [(x-(b-y),b) | y < b, x > b - y] ++
    [(x+y,0) | y > 0, x + y <= a] ++ 
    [(0,x+y) | x > 0, x + y <= b]

-- La definición de jarras se puede simplificar usando listToMaybe
jarras2 :: Problema -> Maybe [Estado]
jarras2 p = listToMaybe (soluciones p)

import Data.Maybe (listToMaybe, isJust)

-- Para simplificar la notación se definen los tipos Problema y Estado

-- como sigue.

-- Un problema es una terna de números. El primero es la capacidad de la

-- primera jarra, el segundo el de la segunda y el tercero es el número

-- de litros que hay que obtener.

type Problema = (Int,Int,Int)

-- Un estado es un par de números. El primero es el contenido de la

-- jarra de A litros y el segundo el de la de B litros.

type Estado = (Int,Int)

jarras :: Problema -> Maybe [Estado]

jarras p | null ns = Nothing

| otherwise = Just (head ns)

where ns = soluciones p

-- (soluciones p) es la lista de soluciones del problema p. Por ejemplo,

-- λ> take 2 (soluciones (15,10,5))

-- [[(0,0),(15,0),(5,10)],[(0,0),(0,10),(15,10),(15,0),(5,10)]]

-- λ> length (soluciones (15,10,5))

-- 6

-- λ> soluciones (15,10,4)

-- []

soluciones :: Problema -> [[Estado]]

soluciones p = busca [[inicial]]

where

busca [] = []

busca ((e:es):ns)

| esFinal p e = (reverse (e:es)) : busca ns

| otherwise = busca (ns ++ [e1:e:es | e1 <- sucesores p e

, e1 `notElem` es])

-- inicial es el estado inicial

inicial :: Estado

inicial = (0,0)

-- (esFinal p e) es verifica si e es un estado final del problema de las

-- jarras p. Por ejemplo,

-- esFinal (5,4,3) (3,2) == True

-- esFinal (5,4,3) (2,3) == True

-- esFinal (5,4,1) (2,3) == False

esFinal :: Problema -> Estado -> Bool

esFinal (_,_,c) (x,y) = x == c || y == c

-- (sucesores p e) es la lista de los sucesores del estado e. Por

-- ejemplo,

-- λ> sucesores (7,4,3) (1,2)

-- [(7,2),(1,4),(0,2),(1,0),(3,0),(0,3)]

-- λ> sucesores (7,4,3) (6,3)

-- [(7,3),(6,4),(0,3),(6,0),(7,2),(5,4)]

sucesores :: Problema -> Estado -> [Estado]

sucesores (a,b,_) (x,y) =

[(a,y) | x < a] ++

[(x,b) | y < b] ++

[(0,y) | x > 0] ++

[(x,0) | y > 0] ++

[(a,y-(a-x)) | x < a, y > a - x] ++

[(x-(b-y),b) | y < b, x > b - y] ++

[(x+y,0) | y > 0, x + y <= a] ++

[(0,x+y) | x > 0, x + y <= b]

-- La definición de jarras se puede simplificar usando listToMaybe

jarras2 :: Problema -> Maybe [Estado]

jarras2 p = listToMaybe (soluciones p)

Distancia a Erdős

PorJosé A. Alonso 14-diciembre-201621-diciembre-2016

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

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]

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

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

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

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

Problema de las jarras

PorJosé A. Alonso 18-mayo-201626-marzo-2022

En el problema de las jarras (A,B,C) se tienen dos jarras sin marcas de medición, una de A litros de capacidad y otra de B. También se dispone de una bomba que permite llenar las jarras de agua.

El problema de las jarras (A,B,C) consiste en determinar cómo se puede lograr tener exactamente C litros de agua en la jarra de A litros de capacidad.

Definir, mediante búsqueda en espacio de estados, la función

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

1	jarras :: (Int,Int,Int) -> [[(Int,Int)]]

tal (jarras (a,b,c)) es la lista de las soluciones del problema de las
jarras (a,b,c). Por ejemplo,

   λ> take 2 (map snd (sort [(length xs,xs) | xs <- jarras (4,3,2)]))
   [[(0,0),(0,3),(3,0),(3,3),(4,2),(0,2),(2,0)],
    [(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)]]

λ> take 2 (map snd (sort [(length xs,xs) | xs <- jarras (4,3,2)]))

[[(0,0),(0,3),(3,0),(3,3),(4,2),(0,2),(2,0)],

[(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)]]

La interpretación [(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)] es:

(0,0) se inicia con las dos jarras vacías,
(4,0) se llena la jarra de 4 con el grifo,
(1,3) se llena la de 3 con la de 4,
(1,0) se vacía la de 3,
(0,1) se pasa el contenido de la primera a la segunda,
(4,1) se llena la primera con el grifo,
(2,3) se llena la segunda con la primera.

Otros ejemplos

   λ> (snd . head . sort) [(length xs,xs) | xs <- jarras (15,10,5)]
   [(0,0),(15,0),(5,10)]
   λ> jarras (15,10,4)
   []

λ> (snd . head . sort) [(length xs,xs) | xs <- jarras (15,10,5)]

[(0,0),(15,0),(5,10)]

λ> jarras (15,10,4)

[]

Nota: Las librerías necesarias se encuentran en la página de códigos.

Soluciones

import I1M.BusquedaEnEspaciosDeEstados

-- Un problema queda determinado por las capacidades de las dos jarras y
-- el contenido que se desea lograr 

-- Un estado es una lista de dos números. El primero es el contenido de
-- la jarra de 4 litros y el segundo el de la de 3 litros. 
type EstadoJarras = (Int,Int)

inicialJarras :: EstadoJarras
inicialJarras = (0,0)

esFinalJarras :: (Int,Int,Int) -> EstadoJarras -> Bool
esFinalJarras (_,_,c) (x,_) = x == c

sucesoresEjarras :: (Int,Int,Int) -> EstadoJarras -> [EstadoJarras]
sucesoresEjarras (a,b,_) (x,y) =
    [(a,y) | x < a] ++
    [(x,b) | y < b] ++
    [(0,y) | x > 0] ++
    [(x,0) | y > 0] ++
    [(a,y-(a-x)) | x < a, y > 0, x + y > a] ++
    [(x-(b-y),b) | x > 0, y < b, x + y > b] ++
    [(x+y,0) | y > 0, x + y <= a] ++ 
    [(0,x+y) | x > 0, x + y <= b]

-- Los nodos son las soluciones parciales
type NodoJarras = [EstadoJarras]

inicialNjarras :: NodoJarras
inicialNjarras = [inicialJarras]

esFinalNjarras :: (Int,Int,Int) -> NodoJarras -> Bool
esFinalNjarras p (e:_) = esFinalJarras p e

sucesoresNjarras :: (Int,Int,Int) -> NodoJarras -> [NodoJarras]
sucesoresNjarras p n@(e:es) =
    [e':n | e' <- sucesoresEjarras p e,
            e' `notElem` n]

solucionesJarras :: (Int,Int,Int) -> [NodoJarras]
solucionesJarras p = buscaEE (sucesoresNjarras p)
                             (esFinalNjarras p)
                             inicialNjarras

jarras :: (Int,Int,Int) -> [[(Int,Int)]]
jarras p = map reverse (solucionesJarras p)

import I1M.BusquedaEnEspaciosDeEstados

-- Un problema queda determinado por las capacidades de las dos jarras y

-- el contenido que se desea lograr

-- Un estado es una lista de dos números. El primero es el contenido de

-- la jarra de 4 litros y el segundo el de la de 3 litros.

type EstadoJarras = (Int,Int)

inicialJarras :: EstadoJarras

inicialJarras = (0,0)

esFinalJarras :: (Int,Int,Int) -> EstadoJarras -> Bool

esFinalJarras (_,_,c) (x,_) = x == c

sucesoresEjarras :: (Int,Int,Int) -> EstadoJarras -> [EstadoJarras]

sucesoresEjarras (a,b,_) (x,y) =

[(a,y) | x < a] ++

[(x,b) | y < b] ++

[(0,y) | x > 0] ++

[(x,0) | y > 0] ++

[(a,y-(a-x)) | x < a, y > 0, x + y > a] ++

[(x-(b-y),b) | x > 0, y < b, x + y > b] ++

[(x+y,0) | y > 0, x + y <= a] ++

[(0,x+y) | x > 0, x + y <= b]

-- Los nodos son las soluciones parciales

type NodoJarras = [EstadoJarras]

inicialNjarras :: NodoJarras

inicialNjarras = [inicialJarras]

esFinalNjarras :: (Int,Int,Int) -> NodoJarras -> Bool

esFinalNjarras p (e:_) = esFinalJarras p e

sucesoresNjarras :: (Int,Int,Int) -> NodoJarras -> [NodoJarras]

sucesoresNjarras p n@(e:es) =

[e':n | e' <- sucesoresEjarras p e,

e' `notElem` n]

solucionesJarras :: (Int,Int,Int) -> [NodoJarras]

solucionesJarras p = buscaEE (sucesoresNjarras p)

(esFinalNjarras p)

inicialNjarras

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

jarras p = map reverse (solucionesJarras p)

Problema del dominó

PorJosé A. Alonso 17-mayo-201626-marzo-2022

Definir, mediante búsqueda en espacio de estados, la función

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

1	domino :: [(Int,Int)] -> [[(Int,Int)]]

tal que (domino fs) es la lista de las soluciones del problema del dominó correspondiente a las fichas fs. Por ejemplo,

   ghci> domino [(1,2),(2,3),(1,4)]
   [[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]
   ghci> domino [(1,2),(1,1),(1,4)]
   [[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]
   ghci> domino [(1,2),(3,4),(2,3)]
   [[(1,2),(2,3),(3,4)]]
   ghci> domino [(1,2),(2,3),(5,4)]
   []
   ghci> domino [(x,y) | x <- [1..2], y <- [x..2]]
   [[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]
   λ> [(x,y) | x <- [1..3], y <- [x..3]]
   [(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]
   λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])
   [(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]
   [(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]
   [(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]
   [(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]
   [(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]
   [(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]
   [(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]
   [(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]
   [(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]
   ghci> length (domino [(x,y) | x <- [1..4], y <- [x..4]])
   0

ghci> domino [(1,2),(2,3),(1,4)]

[[(4,1),(1,2),(2,3)],[(3,2),(2,1),(1,4)]]

ghci> domino [(1,2),(1,1),(1,4)]

[[(4,1),(1,1),(1,2)],[(2,1),(1,1),(1,4)]]

ghci> domino [(1,2),(3,4),(2,3)]

[[(1,2),(2,3),(3,4)]]

ghci> domino [(1,2),(2,3),(5,4)]

[]

ghci> domino [(x,y) | x <- [1..2], y <- [x..2]]

[[(2,2),(2,1),(1,1)],[(1,1),(1,2),(2,2)]]

λ> [(x,y) | x <- [1..3], y <- [x..3]]

[(1,1),(1,2),(1,3),(2,2),(2,3),(3,3)]

λ> mapM_ print (domino [(x,y) | x <- [1..3], y <- [x..3]])

[(1,3),(3,3),(3,2),(2,2),(2,1),(1,1)]

[(1,2),(2,2),(2,3),(3,3),(3,1),(1,1)]

[(2,2),(2,3),(3,3),(3,1),(1,1),(1,2)]

[(3,3),(3,2),(2,2),(2,1),(1,1),(1,3)]

[(2,3),(3,3),(3,1),(1,1),(1,2),(2,2)]

[(2,1),(1,1),(1,3),(3,3),(3,2),(2,2)]

[(3,3),(3,1),(1,1),(1,2),(2,2),(2,3)]

[(3,2),(2,2),(2,1),(1,1),(1,3),(3,3)]

[(3,1),(1,1),(1,2),(2,2),(2,3),(3,3)]

ghci> length (domino [(x,y) | x <- [1..4], y <- [x..4]])

Nota: Las librerías necesarias se encuentran en la página de códigos.

Soluciones

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)
import Data.List (delete)

type Ficha  = (Int,Int)

-- Los estados son los pares formados por la listas sin colocar y las
-- colocadas. 
type EstadoDomino = ([Ficha],[Ficha])

inicialDomino :: [Ficha] -> EstadoDomino
inicialDomino fs = (fs,[])

esFinalDomino :: EstadoDomino -> Bool
esFinalDomino (fs,_) = null fs 

sucesoresDomino :: EstadoDomino -> [EstadoDomino]
sucesoresDomino (fs,[]) = [(delete f fs, [f]) | f <- fs]
sucesoresDomino (fs,n@((x,y):qs)) =
    [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++
    [(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++
    [(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x] 

solucionesDomino :: [Ficha] -> [EstadoDomino]
solucionesDomino ps = buscaEE sucesoresDomino
                              esFinalDomino         
                              (inicialDomino ps)

domino :: [(Int,Int)] -> [[(Int,Int)]]
domino ps = map snd (solucionesDomino ps)

import I1M.BusquedaEnEspaciosDeEstados (buscaEE)

import Data.List (delete)

type Ficha = (Int,Int)

-- Los estados son los pares formados por la listas sin colocar y las

-- colocadas.

type EstadoDomino = ([Ficha],[Ficha])

inicialDomino :: [Ficha] -> EstadoDomino

inicialDomino fs = (fs,[])

esFinalDomino :: EstadoDomino -> Bool

esFinalDomino (fs,_) = null fs

sucesoresDomino :: EstadoDomino -> [EstadoDomino]

sucesoresDomino (fs,[]) = [(delete f fs, [f]) | f <- fs]

sucesoresDomino (fs,n@((x,y):qs)) =

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u /= v, v == x] ++

[(delete (u,v) fs,(v,u):n) | (u,v) <- fs, u /= v, u == x] ++

[(delete (u,v) fs,(u,v):n) | (u,v) <- fs, u == v, u == x]

solucionesDomino :: [Ficha] -> [EstadoDomino]

solucionesDomino ps = buscaEE sucesoresDomino

esFinalDomino

(inicialDomino ps)

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

domino ps = map snd (solucionesDomino ps)

Elemento ausente

PorJosé A. Alonso 8-marzo-20162-mayo-2016

Sea xs una lista y n su longitud. Se dice que xs es casi completa si sus elementos son los números enteros entre 0 y n excepto uno. Por ejemplo, la lista [3,0,1] es casi completa.

Definir la función

   ausente :: [Integer] -> Integer

1	ausente :: [Integer] -> Integer

tal que (ausente xs) es el único entero (entre 0 y la longitud de xs) que no pertenece a la lista casi completa xs. Por ejemplo,

   ausente [3,0,1]               ==  2
   ausente [1,2,0]               ==  3
   ausente (1+10^7:[0..10^7-1])  ==  10000000

ausente [3,0,1] == 2

ausente [1,2,0] == 3

ausente (1+10^7:[0..10^7-1]) == 10000000

Soluciones

import Data.List (foldl', genericLength)
import Data.Set (fromList, notMember)
    
-- 1ª definición
ausente1 :: [Integer] -> Integer
ausente1 xs =
    head [n | n <- [0..], n `notElem` xs]

-- 2ª definición
ausente2 :: [Integer] -> Integer
ausente2 xs =
    head [n | n <- [0..], n `notMember` ys]
    where ys = fromList xs
         
-- 3ª definición (lineal)
ausente3 :: [Integer] -> Integer
ausente3 xs =
    ((n * (n+1)) `div` 2) - sum xs
    where n = genericLength xs  

-- 4ª definición
ausente4 :: [Integer] -> Integer
ausente4 xs =
    ((n * (n+1)) `div` 2) - foldl' (+) 0 xs
    where n = genericLength xs  

-- Comparación de eficiencia
-- =========================

--    λ> let n = 10^5 in ausente1 (n+1:[0..n-1])
--    100000
--    (68.51 secs, 25,967,840 bytes)
--    λ> let n = 10^5 in ausente2 (n+1:[0..n-1])
--    100000
--    (0.12 secs, 123,488,144 bytes)
--    λ> let n = 10^5 in ausente3 (n+1:[0..n-1])
--    100000
--    (0.07 secs, 30,928,384 bytes)
--    λ> let n = 10^5 in ausente4 (n+1:[0..n-1])
--    100000
--    (0.02 secs, 23,039,904 bytes)
--    
--    λ> let n = 10^7 in ausente2 (n+1:[0..n-1])
--    10000000
--    (14.32 secs, 15,358,509,280 bytes)
--    λ> let n = 10^7 in ausente3 (n+1:[0..n-1])
--    10000000
--    (5.57 secs, 2,670,214,936 bytes)
--    λ> let n = 10^7 in ausente4 (n+1:[0..n-1])
--    10000000
--    (3.36 secs, 2,074,919,184 bytes)

import Data.List (foldl', genericLength)

import Data.Set (fromList, notMember)

-- 1ª definición

ausente1 :: [Integer] -> Integer

ausente1 xs =

head [n | n <- [0..], n `notElem` xs]

-- 2ª definición

ausente2 :: [Integer] -> Integer

ausente2 xs =

head [n | n <- [0..], n `notMember` ys]

where ys = fromList xs

-- 3ª definición (lineal)

ausente3 :: [Integer] -> Integer

ausente3 xs =

((n * (n+1)) `div` 2) - sum xs

where n = genericLength xs

-- 4ª definición

ausente4 :: [Integer] -> Integer

ausente4 xs =

((n * (n+1)) `div` 2) - foldl' (+) 0 xs

where n = genericLength xs

-- Comparación de eficiencia

-- =========================

-- λ> let n = 10^5 in ausente1 (n+1:[0..n-1])

-- 100000

-- (68.51 secs, 25,967,840 bytes)

-- λ> let n = 10^5 in ausente2 (n+1:[0..n-1])

-- 100000

-- (0.12 secs, 123,488,144 bytes)

-- λ> let n = 10^5 in ausente3 (n+1:[0..n-1])

-- 100000

-- (0.07 secs, 30,928,384 bytes)

-- λ> let n = 10^5 in ausente4 (n+1:[0..n-1])

-- 100000

-- (0.02 secs, 23,039,904 bytes)

-- λ> let n = 10^7 in ausente2 (n+1:[0..n-1])

-- 10000000

-- (14.32 secs, 15,358,509,280 bytes)

-- λ> let n = 10^7 in ausente3 (n+1:[0..n-1])

-- 10000000

-- (5.57 secs, 2,670,214,936 bytes)

-- λ> let n = 10^7 in ausente4 (n+1:[0..n-1])

-- 10000000

-- (3.36 secs, 2,074,919,184 bytes)

Menor no expresable como suma

PorJosé A. Alonso 7-marzo-201625-abril-2021

Definir la función

   menorNoSuma :: [Integer] -> Integer

1	menorNoSuma :: [Integer] -> Integer

tal que (menorNoSuma xs) es el menor número que no se puede escribir como suma de un subconjunto de xs, donde se supone que xs es un conjunto de números enteros positivos. Por ejemplo,

   menorNoSuma [6,1,2]    ==  4
   menorNoSuma [1,2,3,9]  ==  7
   menorNoSuma [5]        ==  1
   menorNoSuma [1..20]    ==  211
   menorNoSuma [1..10^6]  ==  500000500001

menorNoSuma [6,1,2] == 4

menorNoSuma [1,2,3,9] == 7

menorNoSuma [5] == 1

menorNoSuma [1..20] == 211

menorNoSuma [1..10^6] == 500000500001

Comprobar con QuickCheck que para todo n,

   menorNoSuma [1..n] == 1 + sum [1..n]

1	menorNoSuma [1..n] == 1 + sum [1..n]

Soluciones

-- 1ª definición
-- =============

import Data.List (sort, subsequences)
import Test.QuickCheck
    
menorNoSuma1 :: [Integer] -> Integer
menorNoSuma1 xs =
  head [n | n <- [1..], n `notElem` sumas xs]

-- (sumas xs) es la lista de las sumas de los subconjuntos de xs. Por ejemplo,
--    sumas [1,2,6]  ==  [0,1,2,3,6,7,8,9]
--    sumas [6,1,2]  ==  [0,6,1,7,2,8,3,9]
sumas :: [Integer] -> [Integer]
sumas xs = map sum (subsequences xs)

-- 2ª definición
-- =============

menorNoSuma2 :: [Integer] -> Integer
menorNoSuma2  = menorNoSumaOrd . reverse . sort 

-- (menorNoSumaOrd xs) es el menor número que no se puede escribir como
-- suma de un subconjunto de xs, donde xs es una lista de números
-- naturales ordenada de mayor a menor. Por ejemplo,
--    menorNoSumaOrd [6,2,1]  ==  4
menorNoSumaOrd [] = 1
menorNoSumaOrd (x:xs) | x > y     = y
                      | otherwise = y+x
    where y = menorNoSumaOrd xs

-- Comparación de eficiencia
-- =========================

--    λ> menorNoSuma1 [1..20]
--    211
--    (20.40 secs, 28,268,746,320 bytes)
--    λ> menorNoSuma2 [1..20]
--    211
--    (0.01 secs, 0 bytes)
           
-- Propiedad
-- =========

-- La propiedad es
prop_menorNoSuma :: (Positive Integer) -> Bool
prop_menorNoSuma (Positive n) =
    menorNoSuma2 [1..n] == 1 + sum [1..n]

-- La comprobación es
--    λ> quickCheckWith (stdArgs {maxSize=7}) prop_menorNoSuma
--    +++ OK, passed 100 tests.

-- 1ª definición

-- =============

import Data.List (sort, subsequences)

import Test.QuickCheck

menorNoSuma1 :: [Integer] -> Integer

menorNoSuma1 xs =

head [n | n <- [1..], n `notElem` sumas xs]

-- (sumas xs) es la lista de las sumas de los subconjuntos de xs. Por ejemplo,

-- sumas [1,2,6] == [0,1,2,3,6,7,8,9]

-- sumas [6,1,2] == [0,6,1,7,2,8,3,9]

sumas :: [Integer] -> [Integer]

sumas xs = map sum (subsequences xs)

-- 2ª definición

-- =============

menorNoSuma2 :: [Integer] -> Integer

menorNoSuma2 = menorNoSumaOrd . reverse . sort

-- (menorNoSumaOrd xs) es el menor número que no se puede escribir como

-- suma de un subconjunto de xs, donde xs es una lista de números

-- naturales ordenada de mayor a menor. Por ejemplo,

-- menorNoSumaOrd [6,2,1] == 4

menorNoSumaOrd [] = 1

menorNoSumaOrd (x:xs) | x > y = y

| otherwise = y+x

where y = menorNoSumaOrd xs

-- Comparación de eficiencia

-- =========================

-- λ> menorNoSuma1 [1..20]

-- 211

-- (20.40 secs, 28,268,746,320 bytes)

-- λ> menorNoSuma2 [1..20]

-- 211

-- (0.01 secs, 0 bytes)

-- Propiedad

-- =========

-- La propiedad es

prop_menorNoSuma :: (Positive Integer) -> Bool

prop_menorNoSuma (Positive n) =

menorNoSuma2 [1..n] == 1 + sum [1..n]

-- La comprobación es

-- λ> quickCheckWith (stdArgs {maxSize=7}) prop_menorNoSuma

-- +++ OK, passed 100 tests.

Reconocimiento de anterior

PorJosé A. Alonso 29-diciembre-20151-mayo-2016

Definir la función

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

1	esAnterior :: Eq a => [a] -> a -> a -> Bool

tal que (esAnterior xs y z) se verifica si y ocurre en xs antes que z (que puede no pertenecer a xs). Por ejemplo,

   esAnterior [1,3,7,2] 3 2  ==  True
   esAnterior [1,3,7,2] 3 1  ==  False
   esAnterior [1,3,7,2] 3 5  ==  True
   esAnterior [1,3,7,2] 5 3  ==  False

esAnterior [1,3,7,2] 3 2 == True

esAnterior [1,3,7,2] 3 1 == False

esAnterior [1,3,7,2] 3 5 == True

esAnterior [1,3,7,2] 5 3 == False

Soluciones

-- 1ª definición (por recursión)
esAnterior1 :: Eq a => [a] -> a -> a -> Bool
esAnterior1 [] _ _     = False
esAnterior1 (x:xs) y z = x /= z && (x == y || esAnterior1 xs y z) 

-- 2ª definición
esAnterior2 :: Eq a => [a] -> a -> a -> Bool
esAnterior2 xs y z = z `notElem` (takeWhile (/=y) xs)

-- Comparación de eficiencia
--    λ> let n = 1000000 in esAnterior1 [1..n] (n-1) n
--    True
--    (2.19 secs, 384,717,008 bytes)
--    λ> let n = 1000000 in esAnterior2 [1..n] (n-1) n
--    True
--    (0.34 secs, 135,479,936 bytes)

-- 1ª definición (por recursión)

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

esAnterior1 [] _ _ = False

esAnterior1 (x:xs) y z = x /= z && (x == y || esAnterior1 xs y z)

-- 2ª definición

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

esAnterior2 xs y z = z `notElem` (takeWhile (/=y) xs)

-- Comparación de eficiencia

-- λ> let n = 1000000 in esAnterior1 [1..n] (n-1) n

-- True

-- (2.19 secs, 384,717,008 bytes)

-- λ> let n = 1000000 in esAnterior2 [1..n] (n-1) n

-- True

-- (0.34 secs, 135,479,936 bytes)

Entero positivo con ciertas propiedades

PorJosé A. Alonso 23-octubre-201530-octubre-2015

El 6 de octubre, se propuso en el blog Gaussianos el siguiente problema

Demostrar que para todo entero positivo n, existe otro entero positivo que tiene las siguientes propiedades:

Tiene exactamente n dígitos.

Ninguno de sus dígitos es 0.

Es divisible por la suma de sus dígitos.

Definir la función

   especiales :: Integer -> [Integer]

1	especiales :: Integer -> [Integer]

tal que (especiales n) es la lista de los números enteros que cumplen las 3 propiedades anteriores para n. Por ejemplo,

   take 3 (especiales 2)  ==  [12,18,21]
   take 3 (especiales 3)  ==  [111,112,114]
   head (especiales 30)   ==  111111111111111111111111111125
   length (especiales 3)  ==  108
   null (especiales 1000) ==  False

take 3 (especiales 2) == [12,18,21]

take 3 (especiales 3) == [111,112,114]

head (especiales 30) == 111111111111111111111111111125

length (especiales 3) == 108

null (especiales 1000) == False

En el primer ejemplo, 12 es un número especial para 2 ya que tiene exactamente 2 dígitos, ninguno de sus dígitos es 0 y 12 es divisible por la suma de sus dígitos.

Soluciones

especiales :: Integer -> [Integer]
especiales n = [x | x <- [(10^n-1) `div` 9..10^n-1]
                  , esEspecial x]

esEspecial :: Integer -> Bool
esEspecial x = 
    notElem 0 digitos &&
    x `mod` sum digitos == 0        
    where digitos = [read [d] | d <- show x]

especiales :: Integer -> [Integer]

especiales n = [x | x <- [(10^n-1) `div` 9..10^n-1]

, esEspecial x]

esEspecial :: Integer -> Bool

esEspecial x =

notElem 0 digitos &&

x `mod` sum digitos == 0

where digitos = [read [d] | d <- show x]

Extensión de un fichero

PorJosé A. Alonso 10-noviembre-20141-mayo-2016

Enunciado

-- La extensión de un fichero es la palabra a continuación del último
-- punto en el nombre del fichero. Por ejemplo, la extensión de
-- "documento.txt" es "txt" 
-- 
-- Definir la función
--    extension :: String -> String
-- tal que (extension cs) es la extensión del fichero cs. Por ejemplo,
--    extension "ejercicio.hs"       ==  "hs"
--    extension "documento.txt"      ==  "txt"
--    extension "documento.txt.pdf"  ==  "pdf"
--    extension "resumen"            ==  ""

-- La extensión de un fichero es la palabra a continuación del último

-- punto en el nombre del fichero. Por ejemplo, la extensión de

-- "documento.txt" es "txt"

-- Definir la función

-- extension :: String -> String

-- tal que (extension cs) es la extensión del fichero cs. Por ejemplo,

-- extension "ejercicio.hs" == "hs"

-- extension "documento.txt" == "txt"

-- extension "documento.txt.pdf" == "pdf"

-- extension "resumen" == ""

Soluciones

-- 1ª definición (por recursión):
extension1 :: String -> String
extension1 cs | elem '.' cs = reverse (aux (reverse cs))
              | otherwise   = ""
    where aux []       = []
          aux ('.':cs) = []
          aux (c:cs)   = c : aux cs

-- 2ª definición (con takeWhile):
extension2 :: String -> String
extension2 cs
    | notElem '.' cs = ""
    | otherwise      = reverse (takeWhile (/= '.') (reverse cs))

-- 1ª definición (por recursión):

extension1 :: String -> String

extension1 cs | elem '.' cs = reverse (aux (reverse cs))

| otherwise = ""

where aux [] = []

aux ('.':cs) = []

aux (c:cs) = c : aux cs

-- 2ª definición (con takeWhile):

extension2 :: String -> String

extension2 cs

| notElem '.' cs = ""

| otherwise = reverse (takeWhile (/= '.') (reverse cs))

Soluciones

Nuevas soluciones

Soluciones

Soluciones

Otras soluciones

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Otras soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Pensamiento

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico