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

3 soluciones de “Problema del dominó

  1. albcercid
     
    domino :: [(Int,Int)] -> [[(Int,Int)]]
    domino xs = concatMap (caminos (M.fromListWith (++) (map f3 t))) t
        where t = f2 xs
    f3 (x,y) = (x,[y])
    f2 [] = []
    f2 ((x,y):ys) | x == y = (x,y):f2 ys
                  | otherwise = (x,y):(y,x):f2 ys
     
    caminos :: M.Map Int [Int] -> (Int,Int)-> [[(Int,Int)]]
    caminos t (a,b) | M.null f = [[(a,b)]]
                    | not $ M.member b f = []
                    | otherwise = map ((a,b):) $ concatMap (caminos f) d
                 where f = M.filter (not.null) $ M.adjust (delete b) a g
                       g = M.adjust (delete a) b t
                       q = f M.! b
                       d = map ( x -> (b,x)) q
     
    -- Obtengo más soluciones que en los ejemplos, aunque son correctas.
  2. enrnarbej
    import Data.List
    import qualified Data.Map as M
     
    type Ficha = (Int,Int)
    type Estado = ([Ficha],Ficha,[Ficha])
     
    domino :: [Ficha] -> [[Ficha]]
    domino ((x,y):xs) =
      nub $ solucionDomino [(xs,(x,y),[(x,y)]), (xs,(y,x),[(y,x)])]
     
    solucionDomino :: [Estado] -> [[Ficha]]
    solucionDomino [] = []
    solucionDomino ((x@(ys,y,ab):xs))
      | esFinal x = ab : solucionDomino xs
      | otherwise   = solucionDomino (xs ++ [s | s <- sucesores x
                                                 , s `notElem` xs])
     
    esFinal :: Estado -> Bool
    esFinal (xs,(a,b),ab) = null xs
     
    sucesores :: Estado -> [Estado]
    sucesores (xs, (a,b), ab) =
         [(delete (y,x) xs, (x,b), (x,y):ab)    | (x,y) <- x1]
      ++ [(delete (x,y) xs, (x,b), (x,y):ab)    | (x,y) <- x2] 
      ++ [(delete (x,y) xs, (a,y), ab++[(x,y)]) | (x,y) <- y1]
      ++ [(delete (y,x) xs, (a,y), ab++[(x,y)]) | (x,y) <- y2]
      where
        x1 = [(y,x) | (x,y) <- xs, x == a]
        x2 = filter ((a==).snd) xs
        y1 = filter ((b==).fst) xs
        y2 = [(y,x) | (x,y) <- xs, y == b]
  3. paumacpar
    import I1M.BusquedaEnEspaciosDeEstados
     
    type Ficha = (Int,Int)
    type SolD = [Ficha]
     
    movValido :: SolD -> Ficha -> Bool
    movValido ((i,j):_) (x,y) = y==i || x == i
     
    type NodoD = (Ficha, [Ficha], SolD)
     
     
    sucesoresD :: NodoD -> [NodoD]
    sucesoresD (f,xs,s:solp)
      =[(actua s ficha,(delete ficha xs),(actua s ficha):s:solp) | ficha <- filtrado xs (s:solp)]
     
    actua :: Ficha -> Ficha -> Ficha
    actua (x,y) (j,k) | k == x = (j,k)
                      | otherwise = (k,j)
     
    filtrado :: [Ficha] -> SolD -> SolD
    filtrado ys xs = filter (movValido xs) ys
     
    esFinalD :: [Ficha] -> NodoD -> Bool
    esFinalD ks (f,xs,ys) = null xs && (length ys == length ks)  
     
    buscaEE_NR :: [Ficha] -> [SolD]
    buscaEE_NR [] = []
    buscaEE_NR xs = (concatMap f xs)
      where g (x,y,z) = z
            f x =  map g ((buscaEE sucesoresD (esFinalD xs) (x, delete x xs, [x])))
     
    domino :: [(Int,Int)] -> [[(Int,Int)]]
    domino xs = buscaEE_NR xs

Escribe tu solución

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