Ejercicio

Problema del dominó

PorJosé A. Alonso 16-mayo-201726-marzo-2022

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

[schedule expon=’2017-05-23′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 23 de mayo.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2017-05-23′ at=»06:00″]

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)

[/schedule]

El algoritmo de Damm

PorJosé A. Alonso 15-mayo-20172-agosto-2023

El algoritmo de Damm se usa en la detección de errores en códigos numéricos. Es un procedimiento para obtener un dígito de control, usando la siguiente matriz, como describimos en los ejemplos

     |  0   1   2   3   4   5   6   7   8   9
   --+---------------------------------------
   0 |  0   3   1   7   5   9   8   6   4   2
   1 |  7   0   9   2   1   5   4   8   6   3
   2 |  4   2   0   6   8   7   1   3   5   9
   3 |  1   7   5   0   9   8   3   4   2   6
   4 |  6   1   2   3   0   4   5   9   7   8
   5 |  3   6   7   4   2   0   9   5   8   1
   6 |  5   8   6   9   7   2   0   1   3   4
   7 |  8   9   4   5   3   6   2   0   1   7
   8 |  9   4   3   8   6   1   7   2   0   5
   9 |  2   5   8   1   4   3   6   7   9   0

| 0 1 2 3 4 5 6 7 8 9

--+---------------------------------------

0 | 0 3 1 7 5 9 8 6 4 2

1 | 7 0 9 2 1 5 4 8 6 3

2 | 4 2 0 6 8 7 1 3 5 9

3 | 1 7 5 0 9 8 3 4 2 6

4 | 6 1 2 3 0 4 5 9 7 8

5 | 3 6 7 4 2 0 9 5 8 1

6 | 5 8 6 9 7 2 0 1 3 4

7 | 8 9 4 5 3 6 2 0 1 7

8 | 9 4 3 8 6 1 7 2 0 5

9 | 2 5 8 1 4 3 6 7 9 0

Ejemplo 1: cálculo del dígito de control de 572

se comienza con la fila 0 y columna 5 de la matriz -> 9
a continuación, la fila 9 y columna 7 de la matriz -> 7
a continuación, la fila 7 y columna 2 de la matriz -> 4

con lo que se llega al final del proceso. Entonces, el dígito de control de 572 es 4.

Ejemplo 2: cálculo del dígito de control de 57260

se comienza con la fila 0 y columna 5 de la matriz -> 9
a continuación, la fila 9 y columna 7 de la matriz -> 7
a continuación, la fila 9 y columna 2 de la matriz -> 4
a continuación, la fila 6 y columna 4 de la matriz -> 5
a continuación, la fila 5 y columna 0 de la matriz -> 3

con lo que se llega al final del proceso. Entonces, el dígito de control de 57260 es 3.

Representamos las matrices como tablas cuyos índices son pares de números naturales.

   type Matriz a = Array (Int,Int) a

1	type Matriz a = Array (Int,Int) a

Definimos la matriz:

   mDamm :: Matriz Int
   mDamm = listArray ((0,0),(9,9)) [0,3,1,7,5,9,8,6,4,2,
                                    7,0,9,2,1,5,4,8,6,3,
                                    4,2,0,6,8,7,1,3,5,9,
                                    1,7,5,0,9,8,3,4,2,6,
                                    6,1,2,3,0,4,5,9,7,8,
                                    3,6,7,4,2,0,9,5,8,1,
                                    5,8,6,9,7,2,0,1,3,4,
                                    8,9,4,5,3,6,2,0,1,7,
                                    9,4,3,8,6,1,7,2,0,5,
                                    2,5,8,1,4,3,6,7,9,0]

mDamm :: Matriz Int

mDamm = listArray ((0,0),(9,9)) [0,3,1,7,5,9,8,6,4,2,

7,0,9,2,1,5,4,8,6,3,

4,2,0,6,8,7,1,3,5,9,

1,7,5,0,9,8,3,4,2,6,

6,1,2,3,0,4,5,9,7,8,

3,6,7,4,2,0,9,5,8,1,

5,8,6,9,7,2,0,1,3,4,

8,9,4,5,3,6,2,0,1,7,

9,4,3,8,6,1,7,2,0,5,

2,5,8,1,4,3,6,7,9,0]

Definir la función

   digitoControl :: Int -> Int

1	digitoControl :: Int -> Int

tal que (digitoControl n) es el dígito de control de n. Por ejemplo:

   digitoControl 572          == 4
   digitoControl 57260        == 3
   digitoControl 12345689012  == 6
   digitoControl 5724         == 0
   digitoControl 572603       == 0
   digitoControl 123456890126 == 0

digitoControl 572 == 4

digitoControl 57260 == 3

digitoControl 12345689012 == 6

digitoControl 5724 == 0

digitoControl 572603 == 0

digitoControl 123456890126 == 0

Comprobar con QuickCheck que si añadimos al final de un número n su dígito de control, el dígito de control del número que resulta siempre es 0.

Soluciones

[schedule expon=’2017-05-22′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 22 de mayo.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2017-05-22′ at=»06:00″]

import Data.Array
import Test.QuickCheck

type Matriz a = Array (Int,Int) a

mDamm :: Matriz Int
mDamm = listArray ((0,0),(9,9)) [0,3,1,7,5,9,8,6,4,2,
                                 7,0,9,2,1,5,4,8,6,3,
                                 4,2,0,6,8,7,1,3,5,9,
                                 1,7,5,0,9,8,3,4,2,6,
                                 6,1,2,3,0,4,5,9,7,8,
                                 3,6,7,4,2,0,9,5,8,1,
                                 5,8,6,9,7,2,0,1,3,4,
                                 8,9,4,5,3,6,2,0,1,7,
                                 9,4,3,8,6,1,7,2,0,5,
                                 2,5,8,1,4,3,6,7,9,0]

-- 1ª solución
digitoControl :: Int -> Int
digitoControl n = aux (digitos n) 0
    where aux [] d = d
          aux (x:xs) d = aux xs (mDamm ! (d,x))

digitos :: Int -> [Int]
digitos n = [read [x] | x <- show n]

-- 2ª solución:
digitoControl2 :: Int -> Int
digitoControl2 n = last (scanl f 0 (digitos n))
    where f d x = mDamm ! (d,x)

-- La propiedad es
prop_DC :: Int -> Property
prop_DC n = n >= 0 ==> digitoControl m == 0
    where m = read (show n ++ show (digitoControl n))

-- La comprobación es
--    ghci> quickCheck prop_DC
--    +++ OK, passed 100 tests.

-- 2ª expresión de la propiedad
prop_DC2 :: Int -> Bool
prop_DC2 n = digitoControl m == 0
    where m = read (show (abs n) ++ show (digitoControl (abs n)))

-- La comprobación es
--    ghci> quickCheck prop_DC2
--    +++ OK, passed 100 tests.

-- 3ª expresión de la propiedad
prop_DC3 :: Int -> Bool
prop_DC3 n = digitoControl (10 * n1 + digitoControl n1) == 0
    where n1 = abs n

-- La comprobación es
--    ghci> quickCheck prop_DC3
--    +++ OK, passed 100 tests.

-- 4ª expresión de la propiedad
prop_DC4 :: (Positive Int) -> Bool
prop_DC4 (Positive n) = 
    digitoControl2 (10 * n + digitoControl2 n) == 0

-- La comprobación es
--    ghci > quickCheck prop_DC4
--    +++ OK, passed 100 tests.

import Data.Array

import Test.QuickCheck

type Matriz a = Array (Int,Int) a

mDamm :: Matriz Int

mDamm = listArray ((0,0),(9,9)) [0,3,1,7,5,9,8,6,4,2,

7,0,9,2,1,5,4,8,6,3,

4,2,0,6,8,7,1,3,5,9,

1,7,5,0,9,8,3,4,2,6,

6,1,2,3,0,4,5,9,7,8,

3,6,7,4,2,0,9,5,8,1,

5,8,6,9,7,2,0,1,3,4,

8,9,4,5,3,6,2,0,1,7,

9,4,3,8,6,1,7,2,0,5,

2,5,8,1,4,3,6,7,9,0]

-- 1ª solución

digitoControl :: Int -> Int

digitoControl n = aux (digitos n) 0

where aux [] d = d

aux (x:xs) d = aux xs (mDamm ! (d,x))

digitos :: Int -> [Int]

digitos n = [read [x] | x <- show n]

-- 2ª solución:

digitoControl2 :: Int -> Int

digitoControl2 n = last (scanl f 0 (digitos n))

where f d x = mDamm ! (d,x)

-- La propiedad es

prop_DC :: Int -> Property

prop_DC n = n >= 0 ==> digitoControl m == 0

where m = read (show n ++ show (digitoControl n))

-- La comprobación es

-- ghci> quickCheck prop_DC

-- +++ OK, passed 100 tests.

-- 2ª expresión de la propiedad

prop_DC2 :: Int -> Bool

prop_DC2 n = digitoControl m == 0

where m = read (show (abs n) ++ show (digitoControl (abs n)))

-- La comprobación es

-- ghci> quickCheck prop_DC2

-- +++ OK, passed 100 tests.

-- 3ª expresión de la propiedad

prop_DC3 :: Int -> Bool

prop_DC3 n = digitoControl (10 * n1 + digitoControl n1) == 0

where n1 = abs n

-- La comprobación es

-- ghci> quickCheck prop_DC3

-- +++ OK, passed 100 tests.

-- 4ª expresión de la propiedad

prop_DC4 :: (Positive Int) -> Bool

prop_DC4 (Positive n) =

digitoControl2 (10 * n + digitoControl2 n) == 0

-- La comprobación es

-- ghci > quickCheck prop_DC4

-- +++ OK, passed 100 tests.

[/schedule]

El problema de la bicicleta de Turing

PorJosé A. Alonso 12-mayo-201711-mayo-2017

Cuentan que Alan Turing tenía una bicicleta vieja, que tenía una cadena con un eslabón débil y además uno de los radios de la rueda estaba doblado. Cuando el radio doblado coincidía con el eslabón débil, entonces la cadena se rompía.

La bicicleta se identifica por los parámetros (i,d,n) donde

i es el número del eslabón que coincide con el radio doblado al empezar a andar,
d es el número de eslabones que se desplaza la cadena en cada vuelta de la rueda y
n es el número de eslabones de la cadena (el número n es el débil).

Si i = 2, d = 7 y n = 25, entonces la lista con el número de eslabón que toca el radio doblado en cada vuelta es

   [2,9,16,23,5,12,19,1,8,15,22,4,11,18,0,7,14,21,3,10,17,24,6,...

1	[2,9,16,23,5,12,19,1,8,15,22,4,11,18,0,7,14,21,3,10,17,24,6,...

Con lo que la cadena se rompe en la vuelta número 14.

Definir las funciones

   eslabones :: Int -> Int -> Int -> [Int]
   numeroVueltas :: Int -> Int -> Int -> Int

1 2	eslabones :: Int -> Int -> Int -> [Int] numeroVueltas :: Int -> Int -> Int -> Int

tales que

(eslabones i d n) es la lista con los números de eslabones que tocan el radio doblado en cada vuelta en una bicicleta de tipo (i,d,n). Por ejemplo,

     take 10 (eslabones 2 7 25)  ==  [2,9,16,23,5,12,19,1,8,15]

1	take 10 (eslabones 2 7 25) == [2,9,16,23,5,12,19,1,8,15]

(numeroVueltas i d n) es el número de vueltas que pasarán hasta que la cadena se rompa en una bicicleta de tipo (i,d,n). Por ejemplo,

     numeroVueltas 2 7 25  ==  14

1	numeroVueltas 2 7 25 == 14

Soluciones

[schedule expon=’2017-05-19′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 19 de mayo.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2017-05-19′ at=»06:00″]

-- 1ª definición
eslabones :: Int -> Int -> Int -> [Int]
eslabones i d n = [(i+d*j) `mod` n | j <- [0..]]

-- 2ª definición (con iterate):
eslabones2 :: Int -> Int -> Int -> [Int]
eslabones2 i d n = map (\x-> mod x n) (iterate (+d) i)

numeroVueltas :: Int -> Int -> Int -> Int
numeroVueltas i d n = length (takeWhile (/=0) (eslabones i d n))

-- 1ª definición

eslabones :: Int -> Int -> Int -> [Int]

eslabones i d n = [(i+d*j) `mod` n | j <- [0..]]

-- 2ª definición (con iterate):

eslabones2 :: Int -> Int -> Int -> [Int]

eslabones2 i d n = map (\x-> mod x n) (iterate (+d) i)

numeroVueltas :: Int -> Int -> Int -> Int

numeroVueltas i d n = length (takeWhile (/=0) (eslabones i d n))

[/schedule]

Grafo de divisibilidad

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

El grafo de divisibilidad de orden n es el grafo cuyos nodos son los números naturales entre 1 y n, cuyas aristas son los pares (x,y) tales que x divide a y o y divide a x y el coste de cada arista es el cociente entre su mayos y menor elemento.

Definir las siguientes funciones:

   grafoDivisibilidad :: Int -> Grafo Int Int
   coste :: Int -> Int

1 2	grafoDivisibilidad :: Int -> Grafo Int Int coste :: Int -> Int

tales que

(grafoDivisibilidad n) es el grafo de divisibilidad de orden n. Por ejemplo,

      λ> grafoDivisibilidad 12
      G ND (array (1,12)
                  [(1,[(2,2),(3,3),(4,4),(5,5),(6,6),(7,7),
                       (8,8),(9,9),(10,10),(11,11),(12,12)]),
                   (2,[(1,2),(4,2),(6,3),(8,4),(10,5),(12,6)]),
                   (3,[(1,3),(6,2),(9,3),(12,4)]),
                   (4,[(1,4),(2,2),(8,2),(12,3)]),
                   (5,[(1,5),(10,2)]),
                   (6,[(1,6),(2,3),(3,2),(12,2)]),
                   (7,[(1,7)]),
                   (8,[(1,8),(2,4),(4,2)]),
                   (9,[(1,9),(3,3)]),
                   (10,[(1,10),(2,5),(5,2)]),
                   (11,[(1,11)]),
                   (12,[(1,12),(2,6),(3,4),(4,3),(6,2)])])

λ> grafoDivisibilidad 12

G ND (array (1,12)

[(1,[(2,2),(3,3),(4,4),(5,5),(6,6),(7,7),

(8,8),(9,9),(10,10),(11,11),(12,12)]),

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

(3,[(1,3),(6,2),(9,3),(12,4)]),

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

(5,[(1,5),(10,2)]),

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

(7,[(1,7)]),

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

(9,[(1,9),(3,3)]),

(10,[(1,10),(2,5),(5,2)]),

(11,[(1,11)]),

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

(coste n) es el coste del árbol de expansión mínimo del grafo de divisibilidad de orden n. Por ejemplo,

      coste 12    ==  41
      coste 3000  ==  605305

1 2	coste 12 == 41 coste 3000 == 605305

Soluciones

[schedule expon=’2017-05-18′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 18 de mayo.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2017-05-18′ at=»06:00″]

import Data.Ix
import Data.List (delete, sort)
import qualified Data.Set as S
import I1M.Grafo
import I1M.Tabla

grafoDivisibilidad :: Int -> Grafo Int Int
grafoDivisibilidad n =
  creaGrafo ND (1,n) [(x,y,y `div` x) | y <- [1..n]
                                      , x <- [1..y-1]
                                      , y `mod` x == 0]


-- 1ª solución (con el algoritmo de Kruskal)
-- =========================================

coste1 :: Int -> Int
coste1 n = sum [p | (p,x,y) <- kruskal (grafoDivisibilidad n)]

-- (kruskal g) es el árbol de expansión mínimo del grafo g calculado
-- mediante el algoritmo de Kruskal. Por ejemplo,
--    λ> kruskal (grafoDivisibilidad 12)
--    [(11,1,11),(7,1,7),(5,1,5),(3,3,9),(3,1,3),(2,6,12),(2,5,10),
--     (2,4,8),(2,3,6),(2,2,4),(2,1,2)]
kruskal :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
kruskal g = kruskal' cola                           -- Cola ordenada
                     (tabla [(x,x) | x <- nodos g]) -- Tabla de raices
                     []                             -- Árbol de expansión
                     ((length (nodos g)) - 1)       -- Aristas por
                                                    -- colocar
    where cola = sort [(p,x,y) | (x,y,p) <- aristas g]

kruskal' ((p,x,y):as) t ae n 
  | n==0        = ae
  | actualizado = kruskal' as t' ((p,x,y):ae) (n-1)
  | otherwise   = kruskal' as t  ae           n
  where (actualizado,t') = buscaActualiza (x,y) t

-- (raiz t n) es la raíz de n en la tabla t. Por ejemplo,
--    raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 5  == 1
--    raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 2  == 6
raiz:: Eq n => Tabla n n -> n -> n
raiz t x | v == x    = v
         | otherwise = raiz t v
         where v = valor t x

-- (buscaActualiza a t) es el par formado por False y la tabla t, si los
-- dos vértices de la arista a tienen la misma raíz en t y el par
-- formado por True y la tabla obtenida añadiéndole a t la arista
-- formada por el vértice de a de mayor raíz y la raíz del vértice de
-- a de menor raíz. Por ejemplo,
--    ghci> let t = crea [(1,1),(2,2),(3,1),(4,1)]
--    ghci> buscaActualiza (2,3) t
--    (True,Tbl [(1,1),(2,1),(3,1),(4,1)])
--    ghci> buscaActualiza (3,4) t
--    (False,Tbl [(1,1),(2,2),(3,1),(4,1)])
buscaActualiza :: (Eq n, Ord n) => (n,n) -> Tabla n n -> (Bool,Tabla n n)
buscaActualiza (x,y) t 
  | x' == y'  = (False, t) 
  | y' <  x'  = (True, modifica (x,y') t)
  | otherwise = (True, modifica (y,x') t)
  where x' = raiz t x 
        y' = raiz t y

-- 2ª solución (con el algoritmo de Prim)
-- ======================================

coste2 :: Int -> Int
coste2 n = sum [p | (p,x,y) <- prim (grafoDivisibilidad n)]

-- (prim g) es el árbol de expansión mínimo del grafo g calculado
-- mediante el algoritmo de Prim. Por ejemplo,
--    λ> prim (grafoDivisibilidad 12)
--    [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),
--     (3,1,3),(2,4,8),(2,2,4),(2,1,2)]
prim :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
prim g = prim' [n]              -- Nodos colocados
               ns               -- Nodos por colocar 
               []               -- Árbol de expansión
               (aristas g)      -- Aristas del grafo
         where (n:ns) = nodos g

prim' t [] ae as = ae
prim' t r  ae as = prim' (v':t) (delete v' r) (e:ae) as
  where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,
                                         elem u t, 
                                         elem v r]

-- 3ª solución (con el algoritmo de Prim con conjuntos)
-- ====================================================

coste3 :: Int -> Int
coste3 n = sum [p | (p,x,y) <- prim2 (grafoDivisibilidad n)]

-- (prim2 g) es el árbol de expansión mínimo del grafo g calculado
-- mediante el algoritmo de Prim. Por ejemplo,
--    λ> prim2 (grafoDivisibilidad 12)
--    [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),
--     (3,1,3),(2,4,8),(2,2,4),(2,1,2)]
prim2 :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]
prim2 g = prim2' (S.singleton n)  -- Nodos colocados
                 (S.fromList ns)  -- Nodos por colocar 
                 []               -- Árbol de expansión
                 (aristas g)      -- Aristas del grafo
  where (n:ns) = nodos g

prim2' t r ae as
  | S.null r  = ae
  | otherwise = prim2' (S.insert v' t)
                       (S.delete v' r)
                       (e:ae)
                       as
  where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,
                                         S.member u t, 
                                         S.member v r]

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

--    λ> coste1 400
--    14923
--    (0.08 secs, 31,336,440 bytes)
--    λ> coste2 400
--    14923
--    (4.54 secs, 220,745,608 bytes)
--    λ> coste3 400
--    14923
--    (0.69 secs, 217,031,144 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

import Data.Ix

import Data.List (delete, sort)

import qualified Data.Set as S

import I1M.Grafo

import I1M.Tabla

grafoDivisibilidad :: Int -> Grafo Int Int

grafoDivisibilidad n =

creaGrafo ND (1,n) [(x,y,y `div` x) | y <- [1..n]

, x <- [1..y-1]

, y `mod` x == 0]

-- 1ª solución (con el algoritmo de Kruskal)

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

coste1 :: Int -> Int

coste1 n = sum [p | (p,x,y) <- kruskal (grafoDivisibilidad n)]

-- (kruskal g) es el árbol de expansión mínimo del grafo g calculado

-- mediante el algoritmo de Kruskal. Por ejemplo,

-- λ> kruskal (grafoDivisibilidad 12)

-- [(11,1,11),(7,1,7),(5,1,5),(3,3,9),(3,1,3),(2,6,12),(2,5,10),

-- (2,4,8),(2,3,6),(2,2,4),(2,1,2)]

kruskal :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]

kruskal g = kruskal' cola -- Cola ordenada

(tabla [(x,x) | x <- nodos g]) -- Tabla de raices

[] -- Árbol de expansión

((length (nodos g)) - 1) -- Aristas por

-- colocar

where cola = sort [(p,x,y) | (x,y,p) <- aristas g]

kruskal' ((p,x,y):as) t ae n

| n==0 = ae

| actualizado = kruskal' as t' ((p,x,y):ae) (n-1)

| otherwise = kruskal' as t ae n

where (actualizado,t') = buscaActualiza (x,y) t

-- (raiz t n) es la raíz de n en la tabla t. Por ejemplo,

-- raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 5 == 1

-- raiz (crea [(1,1),(3,1),(4,3),(5,4),(2,6),(6,6)]) 2 == 6

raiz:: Eq n => Tabla n n -> n -> n

raiz t x | v == x = v

| otherwise = raiz t v

where v = valor t x

-- (buscaActualiza a t) es el par formado por False y la tabla t, si los

-- dos vértices de la arista a tienen la misma raíz en t y el par

-- formado por True y la tabla obtenida añadiéndole a t la arista

-- formada por el vértice de a de mayor raíz y la raíz del vértice de

-- a de menor raíz. Por ejemplo,

-- ghci> let t = crea [(1,1),(2,2),(3,1),(4,1)]

-- ghci> buscaActualiza (2,3) t

-- (True,Tbl [(1,1),(2,1),(3,1),(4,1)])

-- ghci> buscaActualiza (3,4) t

-- (False,Tbl [(1,1),(2,2),(3,1),(4,1)])

buscaActualiza :: (Eq n, Ord n) => (n,n) -> Tabla n n -> (Bool,Tabla n n)

buscaActualiza (x,y) t

| x' == y' = (False, t)

| y' < x' = (True, modifica (x,y') t)

| otherwise = (True, modifica (y,x') t)

where x' = raiz t x

y' = raiz t y

-- 2ª solución (con el algoritmo de Prim)

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

coste2 :: Int -> Int

coste2 n = sum [p | (p,x,y) <- prim (grafoDivisibilidad n)]

-- (prim g) es el árbol de expansión mínimo del grafo g calculado

-- mediante el algoritmo de Prim. Por ejemplo,

-- λ> prim (grafoDivisibilidad 12)

-- [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),

-- (3,1,3),(2,4,8),(2,2,4),(2,1,2)]

prim :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]

prim g = prim' [n] -- Nodos colocados

ns -- Nodos por colocar

[] -- Árbol de expansión

(aristas g) -- Aristas del grafo

where (n:ns) = nodos g

prim' t [] ae as = ae

prim' t r ae as = prim' (v':t) (delete v' r) (e:ae) as

where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,

elem u t,

elem v r]

-- 3ª solución (con el algoritmo de Prim con conjuntos)

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

coste3 :: Int -> Int

coste3 n = sum [p | (p,x,y) <- prim2 (grafoDivisibilidad n)]

-- (prim2 g) es el árbol de expansión mínimo del grafo g calculado

-- mediante el algoritmo de Prim. Por ejemplo,

-- λ> prim2 (grafoDivisibilidad 12)

-- [(11,1,11),(7,1,7),(2,5,10),(5,1,5),(3,3,9),(2,6,12),(2,3,6),

-- (3,1,3),(2,4,8),(2,2,4),(2,1,2)]

prim2 :: (Ix v, Num p, Ord p) => Grafo v p -> [(p,v,v)]

prim2 g = prim2' (S.singleton n) -- Nodos colocados

(S.fromList ns) -- Nodos por colocar

[] -- Árbol de expansión

(aristas g) -- Aristas del grafo

where (n:ns) = nodos g

prim2' t r ae as

| S.null r = ae

| otherwise = prim2' (S.insert v' t)

(S.delete v' r)

(e:ae)

where e@(c,u', v') = minimum [(c,u,v)| (u,v,c) <- as,

S.member u t,

S.member v r]

-- Comparación de eficiencia

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

-- λ> coste1 400

-- 14923

-- (0.08 secs, 31,336,440 bytes)

-- λ> coste2 400

-- 14923

-- (4.54 secs, 220,745,608 bytes)

-- λ> coste3 400

-- 14923

-- (0.69 secs, 217,031,144 bytes)

[/schedule]

Grafo complemenario

PorJosé A. Alonso 10-mayo-201726-marzo-2022

El complementario del grafo G es un grafo G’ del mismo tipo que G (dirigido o no dirigido), con el mismo conjunto de nodos y tal que dos nodos de G’ son adyacentes si y sólo si no son adyacentes en G. Los pesos de todas las aristas del complementario es igual a 0.

Definir la función

   complementario :: Grafo Int Int -> Grafo Int Int

1	complementario :: Grafo Int Int -> Grafo Int Int

tal que (complementario g) es el complementario de g. Por ejemplo,

   λ> complementario (creaGrafo D (1,3) [(1,3,0),(3,2,0),(2,2,0),(2,1,0)])
   G D (array (1,3) [(1,[(1,0),(2,0)]),(2,[(3,0)]),(3,[(1,0),(3,0)])])
   λ> complementario (creaGrafo D (1,3) [(3,2,0),(2,2,0),(2,1,0)])
   G D (array (1,3) [(1,[(1,0),(2,0),(3,0)]),(2,[(3,0)]),(3,[(1,0),(3,0)])])

λ> complementario (creaGrafo D (1,3) [(1,3,0),(3,2,0),(2,2,0),(2,1,0)])

G D (array (1,3) [(1,[(1,0),(2,0)]),(2,[(3,0)]),(3,[(1,0),(3,0)])])

λ> complementario (creaGrafo D (1,3) [(3,2,0),(2,2,0),(2,1,0)])

G D (array (1,3) [(1,[(1,0),(2,0),(3,0)]),(2,[(3,0)]),(3,[(1,0),(3,0)])])

Nota: Se usa el módulo Grafo de la librería de I1M o cualquiera de las implementaciones de grafos (GrafoConVectorDeAdyacencia o GrafoConMatrizDeAdyacencia).

Soluciones

[schedule expon=’2017-05-17′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 17 de mayo.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2017-05-17′ at=»06:00″]

import I1M.Grafo

complementario :: Grafo Int Int -> Grafo Int Int
complementario g = 
    creaGrafo d (1,n) [(x,y,0) | x <- xs, y <- xs, not (aristaEn g (x,y))]
    where d  = if dirigido g then D else ND
          xs = nodos g
          n  = length xs

import I1M.Grafo

complementario :: Grafo Int Int -> Grafo Int Int

complementario g =

creaGrafo d (1,n) [(x,y,0) | x <- xs, y <- xs, not (aristaEn g (x,y))]

where d = if dirigido g then D else ND

xs = nodos g

n = length xs

[/schedule]

Problema del dominó

Soluciones

El algoritmo de Damm

Soluciones

El problema de la bicicleta de Turing

Soluciones

Grafo de divisibilidad

Soluciones

Grafo complemenario

Soluciones

Entradas recientes

Buscar

Correo electrónico