Menu Close

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 la función

   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

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)

Una solución de “Problema del dominó

  1. agumaragu1
     
    import I1M.BusquedaEnEspaciosDeEstados
    import Data.List ((\), nub)
     
    domino :: [(Int,Int)] -> [[(Int,Int)]]
    domino fs = map reverse $ map fst $ buscaEE sucesoresR terminado (inicial fs)
     
    type Ficha = (Int,Int)
    type Recorrido = ([Ficha],[Ficha])
     
    sucesoresR :: Recorrido -> [Recorrido]
    sucesoresR ((e:es),fs) = [((e':e:es),fs') | (e',fs') <- sucesoresF e fs]
    sucesoresR ([],fs) = nub [([f],fs') | f <- fss, let fs' = fs \ [f, o f]]
      where fss = fs ++ map o fs
            o (x,y) = (y,x)
     
    sucesoresF :: Ficha -> [Ficha] -> [(Ficha, [Ficha])]
    sucesoresF f fs = nub [(f',fs') | f' <- fss, sigue f f', let fs' = fs \ [f', o f']]
      where sigue (a,b) (c,d) = b == c
            fss = fs ++ map o fs
            o (x,y) = (y,x)
     
    terminado :: Recorrido -> Bool
    terminado (_,fs) = null fs
     
    inicial :: [Ficha] -> Recorrido
    inicial fs = ([],fs)

Escribe tu solución

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.