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

2 soluciones de “Problema de las jarras

  1. albcercid
    jarras :: (Int,Int,Int) -> Maybe [(Int,Int)]
    jarras (a,b,c) | mod c (gcd a b) /= 0 || c > max a b = Nothing
                   | otherwise = Just (f3 (aux a b 0 0) (map f (aux b a 0 0)))
                       where f3 xs ys | length xs > length ys = ys
                                      | otherwise = xs
                             f (x,y) = (y,x)
                             aux x y i d | i == c || d == c = [(i,d)]
                                         | i == 0 = (i,d):aux x y x d
                                         | d == y = (i,d):aux x y i 0
                                         | otherwise = (i,d):aux x y t f
                                 where (t,f) | i-(y-d) >= 0 = (i-(y-d),y)
                                             | otherwise = (0,i+d)
  2. enrnarbej
    -- Suponiendo que a > b
     
    jarras  :: (Int,Int,Int) -> Maybe [(Int,Int)]
    jarras  (a,b,c) | s == xs = Nothing
                    | length s > length rs = Just rs
                    | otherwise  = Just s
                    where
                     xs = (0,0) : tail (cadena (a,b) (a,b))
                     s  = takeWhile' ((x,y) -> x /= c && y /= c) xs
                     rs = takeWhile' ((x,y) -> x /= c && y /= c) (reverse xs)
     
    cadena :: (Int,Int) -> (Int,Int) -> [(Int,Int)]
    cadena p@(a,b) q@(a',b') | a == 0  && b == b' = p : (0 ,0) : []
                             | b /= b'            = p : (a',b) : cadena ((a'-b'+b), b') q
                             | a < b              = p : (a, 0) : cadena (0,a)           q
                             | otherwise          = p : (a, 0) : cadena ((a-b'),b')     q
     
    takeWhile' f []     = []
    takeWhile' f (x:xs) | (not . f) x = x : []
                        | otherwise   = x : takeWhile' f xs

Escribe tu solución

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