Problema del dominó

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

2 Comentarios

Diría que del penúltimo ejemplo falta el «reverse».

import Control.Monad
import Data.List (nub, permutations)
import Data.Tuple (swap)

rotaciones :: [(Int, Int)] -> [[(Int, Int)]]
rotaciones (x:xs) = [(x:), (swap x:)] >>= (`map` rotaciones xs) 
rotaciones    []  = [[]]

domino :: [(Int, Int)] -> [[(Int, Int)]]
domino = nub
       . filter (and . ap (zipWith ((.fst) . (==) . snd)) tail)
       . concatMap permutations
       . rotaciones

import Control.Monad

import Data.List (nub, permutations)

import Data.Tuple (swap)

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

rotaciones (x:xs) = [(x:), (swap x:)] >>= (`map` rotaciones xs)

rotaciones [] = [[]]

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

domino = nub

. filter (and . ap (zipWith ((.fst) . (==) . snd)) tail)

. concatMap permutations

. rotaciones

Responder

import Data.List
import I1M.BusquedaEnEspaciosDeEstados 

-- Definimos el estado inicial donde tenemos la lista de fichas:

inicio :: [(Int,Int)] -> ([(Int,Int)],[(Int,Int)])
inicio fs = (fs,[])

-- El objetivo final es cuando la lista de fichas del principio se nos
-- quede vacía.

esFinal :: ([(Int,Int)],[(Int,Int)]) -> Bool
esFinal (fs,_) = null fs

-- La lista de sucesores del par formado, es una lista de pares que se
-- obtiene borrando la primera vez que aparece la ficha y
-- concatenándola a la otra lista final bajo las condiciones del
-- problema; y distinguiendo los distintos casos con las listas:

sucesores :: ([(Int,Int)],[(Int,Int)]) -> [([(Int,Int)],[(Int,Int)])]
sucesores (fs,[]) = [ (delete x fs, [x]) | x <- fs]
sucesores (fs, m@((x,y):cs)) = xs ++ ys ++ zs
 where xs = [ (delete (v,w) fs, (v,w):m) | (v,w) <- ps, v/=w, w == x]
       ys = [ (delete (v,w) fs, (v,w):m) | (v,w) <- ps, v == w, w == x]
       zs = [ (delete (v,w) fs, (w,v):m) | (v,w) <- ps, v/=w, v == x]
       ps = [ (v,w) | (v,w) <- fs, notElem (v,w) m, notElem (w,v) m]

-- Usamos la libreria de espacios de estado con la funcion buscaEE:

solucion :: [(Int, Int)] -> [([(Int, Int)], [(Int, Int)])]
solucion fs = buscaEE sucesores esFinal (inicio fs)

-- Ya tendriamos el problema resuelto:

domino :: [(Int, Int)] -> [[(Int, Int)]]
domino fs = map snd $ solucion fs

import Data.List

import I1M.BusquedaEnEspaciosDeEstados

-- Definimos el estado inicial donde tenemos la lista de fichas:

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

inicio fs = (fs,[])

-- El objetivo final es cuando la lista de fichas del principio se nos

-- quede vacía.

esFinal :: ([(Int,Int)],[(Int,Int)]) -> Bool

esFinal (fs,_) = null fs

-- La lista de sucesores del par formado, es una lista de pares que se

-- obtiene borrando la primera vez que aparece la ficha y

-- concatenándola a la otra lista final bajo las condiciones del

-- problema; y distinguiendo los distintos casos con las listas:

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

sucesores (fs,[]) = [ (delete x fs, [x]) | x <- fs]

sucesores (fs, m@((x,y):cs)) = xs ++ ys ++ zs

where xs = [ (delete (v,w) fs, (v,w):m) | (v,w) <- ps, v/=w, w == x]

ys = [ (delete (v,w) fs, (v,w):m) | (v,w) <- ps, v == w, w == x]

zs = [ (delete (v,w) fs, (w,v):m) | (v,w) <- ps, v/=w, v == x]

ps = [ (v,w) | (v,w) <- fs, notElem (v,w) m, notElem (w,v) m]

-- Usamos la libreria de espacios de estado con la funcion buscaEE:

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

solucion fs = buscaEE sucesores esFinal (inicio fs)

-- Ya tendriamos el problema resuelto:

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

domino fs = map snd $ solucion fs

Responder

Problema del dominó

Soluciones

2 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Se puede imprimir o compartir con

2 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico