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

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

1 2	λ> 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.

(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

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

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)

2 Comentarios

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)

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)

Responder

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

-- Suponiendo que a > b

jarras (a,b,c) | s == xs = Nothing

| length s > length rs = Just rs

| otherwise = Just s

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

Problema de las jarras

Soluciones

2 Comentarios

Leave a Reply to albcercidCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Se puede imprimir o compartir con

2 Comentarios

Leave a Reply to albcercidCancel reply

Entradas recientes

Buscar

Correo electrónico