Menu Close

Problema de las jarras

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

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

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.

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

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

5 soluciones de “Problema de las jarras

  1. guigornun

    Una primera solución algo elaborada, larga y mejorable que toma en cuenta muchos casos.

    import Data.Maybe
     
    jarras :: (Int,Int,Int) -> Maybe [(Int,Int)]
    jarras (a,b,c) | a>b && b>c = aux 0 0 [(0,0)]
                   | a<b && a>c = Just (map (f) (fromJust (jarras (b,a,c))))
                   | abs(a-c) == abs(b-c) && a>b = aux 0 0 [(0,0)]
                   | abs(a-c) < abs(b-c) = aux 0 0 [(0,0)]
                   | otherwise = Just (map (f) (fromJust (jarras (b,a,c))))
     where aux i j xs | (i,j) `elem` (init xs) = Nothing
                      | i == c || j == c = Just xs
                      | i == 0 = aux a j (xs++[(a,j)])
                      | j == 0 && i>b = aux (i-b) b (xs++[(i-b,b)])
                      | j == b = aux i 0 (xs++[(i,0)])
                      | j == 0 && i<=b = aux 0 i (xs++[(0,i)])
                      | i+j >= b = aux (i-(b-j)) b (xs++[(i-(b-j),b)])
                      | otherwise = aux 0 (i+j) (xs++[(0,i+j)])
           f (a,b) = (b,a)
    • jaibengue
      --------
      -- WA --
      -------- 
       
      -- Input:
      -- (4,5,3)
       
      -- Output:
      -- Just [(0,0),(0,5),(4,1),(0,1),(1,0),(1,5),(4,2),(0,2),(2,0),(2,5),(4,3)]
       
      -- Answer: 
      -- Just [(0,0),(4,0),(0,4),(4,4),(3,5)]
  2. jaibengue
    import Data.Maybe
    import Data.List
    import qualified Data.Array as A
    import qualified I1M.Cola as Q
     
    jarras :: (Int,Int,Int) -> Maybe [(Int,Int)]
    jarras = listToMaybe.map reverse.dropWhile (==[]).sortBy (xs ys -> compare (length xs) (length ys)).jarrasAux
     
    jarrasAux :: (Int,Int,Int) -> [[(Int,Int)]]
    jarrasAux (a,b,c) | c>a && c>b = []
                      | c>a        = [sol A.! (i,c) | i <- [0..a]]
                      | c>b        = [sol A.! (c,j) | j <- [0..b]]
                      | otherwise  = [sol A.! (i,c) | i <- [0..a]] ++ [sol A.! (c,j) | j <- [0..b]]
      where sol = dpSol(a,b)
     
    initSol ::(Int,Int) ->  A.Array (Int,Int) [(Int,Int)]
    initSol (m,n) = (A.array ((0,0),(m,n)) [((i,j),[]) | i<-[0..m], j<-[0..n]]) A.// [((0,0),[(0,0)])]
     
    initUsed :: (Int,Int) -> A.Array (Int,Int) Bool
    initUsed (m,n) = (A.array ((0,0),(m,n)) [((i,j),False)| i<-[0..m], j<-[0..n]]) A.// [((0,0),True)]
     
    dpSol :: (Int,Int) -> A.Array (Int,Int) [(Int,Int)]
    dpSol size = updateArr size (initSol size) (initUsed size) (Q.inserta (0,0) Q.vacia)
     
    updateArr :: (Int,Int) -> A.Array (Int,Int) [(Int,Int)] -> A.Array (Int,Int) Bool -> Q.Cola (Int,Int) -> A.Array (Int,Int) [(Int,Int)]
    updateArr size@(cap1,cap2) arr b q | Q.esVacia q = arr
                                       | otherwise   = updateArr
                                         size
                                         (arr A.// [(p, p:arr A.! festQ) | p <- niceFriends festQ])
                                         (plega1 updateB b (niceFriends festQ))
                                         (plega2 Q.inserta restQ (niceFriends festQ))
     
      where festQ = Q.primero q
            restQ = Q.resto q
            friends (hF,hS) = [(0,hS),(min (hF+hS) cap1, max 0 (hF+hS-cap1)), (hF,cap2), (hF,0) ,(max 0 (hF+hS-cap2) , min (hF+hS) cap2), (cap1, hS)]
            niceFriends hP = nub $ filter (pos -> not(b A.! pos)) $ friends hP
     
     
     
    updateB :: A.Array (Int,Int) Bool -> (Int,Int) -> A.Array (Int,Int) Bool
    updateB arr p = arr A.// [(p,True)]
     
    plega1 :: (a -> b -> a) -> a -> [b] -> a
    plega1 f a [] = a
    plega1 f a (x:xs) = plega1 f (f a x) xs
     
    plega2 :: (b -> a -> a) -> a -> [b] -> a
    plega2 f a [] = a
    plega2 f a (x:xs) = plega2 f (f x a) xs
  3. angruicam1

    Una primera solución usando programación lógica con Prolog y recorriendo el árbol en anchura para asegurar que la primera solución encontrada sea la más corta:

    :- use_module(library(clpfd)).
     
    jarras(J1,J2,S,Sol) :-
            sol_aux([[0-0]],J1,J2,S,[0-0],L),
            reverse(L,Sol).
     
    sol_aux([[S-JB|Estado]|_],_,_,S,_,[S-JB|Estado]).
    sol_aux([[JA-S|Estado]|_],_,_,S,_,[JA-S|Estado]).
    sol_aux([Estado|Estados],J1,J2,S,Visitados,L) :-
            extender(Estado,J1,J2,Visitados,NuevosEstados),
            append(Estados,NuevosEstados,Estados1),
            maplist(nth0(0),NuevosEstados,NuevosVisitados),
            append(Visitados,NuevosVisitados,Visitados1),
            sol_aux(Estados1,J1,J2,S,Visitados1,L).
     
    extender([E1|Estado],J1,J2,Visitados,NuevosEstados) :-
            bagof([E2,E1|Estado],
                  (movimiento(E1,J1,J2,E2), not(member(E2,Visitados))),
                  NuevosEstados),
            !.
    extender(_,_,_,_,[]).
     
    movimiento(JA-JB,_,_,0-JB) :- %vacía la jarra A.
              JA #> 0.
    movimiento(JA-JB,_,_,JA-0) :- %vacía la jarra B.
              JB #> 0.
    movimiento(JA-JB,J1,_,J1-JB) :- %llena la jarra A.
              JA #< J1.
    movimiento(JA-JB,_,J2,JA-J2) :- %llena la jarra B.
              JB #< J2.
    movimiento(JA-JB,_,J2,0-JD) :- %vacía la jarra A en la B.
              JA #> 0, JD is JA + JB, JD #=< J2.
    movimiento(JA-JB,J1,_,JC-0) :- %vacía la jarra B en la A.
              JB #> 0, JC is JA + JB, JC #=< J1.
    movimiento(JA-JB,J1,_,J1-JD) :- %llena la jarra A con la B.
              JB #> 0, JD is JB - J1 + JA, JD #> 0.
    movimiento(JA-JB,_,J2,JC-J2) :- %llena la jarra B con la A.
              JA #> 0, JC is JA - J2 + JB, JC #> 0.
     
    % Comprobaciones:
     
    % ?- jarras(3,5,4,Sol).
    % Sol = [0-0, 0-5, 3-2, 0-2, 2-0, 2-5, 3-4] .
     
    % ?- jarras(15,10,5,Sol).
    % Sol = [0-0, 15-0, 5-10] .
     
    % ?- jarras(15,10,4,Sol).
    % false.
     
    % ?- length(L,Sol), jarras(181,179,100,L).
    % L = [0-0, 181-0, 2-179, 2-0, 0-2, 181-2, 4-179, 4-0, ... - ...|...],
    % Sol = 199 .

    Y traducimos esta solución casi literalmente a Haskell:

    type Estado   = (Int,Int)
    type Problema = (Int,Int,Int)
     
    jarras :: Problema -> Maybe [Estado]
    jarras (ja,jb,s) = reverse <$> sol_aux [[(0,0)]] (ja,jb,s) [(0,0)]
     
    sol_aux :: [[Estado]] -> Problema -> [Estado] -> Maybe [(Int,Int)]
    sol_aux (((ja,jb):estado):estados) (j1,j2,s) visitados
      | ja == s || jb == s = Just ((ja,jb):estado)
      | otherwise          = sol_aux estados1 (j1,j2,s) visitados1
      where nuevosEstados   = extender ((ja,jb):estado) (j1,j2) visitados
            estados1        = estados ++ nuevosEstados
            nuevosVisitados = map head nuevosEstados
            visitados1      = visitados ++ nuevosVisitados
    sol_aux [] (_,_,_) _ = Nothing
     
    -- (extender (e1:estado) (j1,j2) visitados) añade los sucesores del
    -- estado e1 que no pertenecen a los estados visitados a la posible
    -- solución. Por ejemplo,
    --    λ> extender [(0,0)] (3,5) [(0,0)]
    --    [[(3,0),(0,0)],[(0,5),(0,0)]]
    extender :: [Estado] -> Estado -> [Estado] -> [[Estado]]
    extender (e1:estado) (j1,j2) visitados =
      [e2:e1:estado | e2 <- xs]
      where xs = filter (`notElem` visitados) (movimiento e1 (j1,j2))
     
    -- (movimiento (ja,jb) (j1,j2)) es la lista de los estados sucesores de
    -- las jarras ja y jb que tiene un máximo de capacidad de j1 y j2
    -- respectivamente. Por ejemplo,
    --    λ> movimiento (0,0) (3,5)
    --    [(3,0),(0,5)]
    movimiento :: Estado -> Estado -> [Estado]
    movimiento (ja,jb) (j1,j2) =
         [(0 ,jb) | ja >  0] -- vacía la jarra A.
      ++ [(ja, 0) | jb >  0] -- vacía la jarra B.
      ++ [(j1,jb) | ja < j1] -- llena la jarra A.
      ++ [(ja,j2) | jb < j2] -- llena la jarra B.
      ++ [(0 ,jd) | let jd = ja+jb, ja > 0, jd <= j2] -- vacía la A en B.
      ++ [(jc, 0) | let jc = ja+jb, jb > 0, jc <= j1] -- vacía la B en A.
      ++ [(j1,jd) | let jd = jb-j1+ja, jb > 0, jd > 0] -- llena la A con B.
      ++ [(jc,j2) | let jc = ja-j2+jb, ja > 0, jc > 0] -- llena la B con A.

Escribe tu solución

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