Problema de las jarras

PorJosé A. Alonso 18-mayo-201626-marzo-2022

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 la jarra de A litros de capacidad.

Definir, mediante búsqueda en espacio de estados, la función

   jarras :: (Int,Int,Int) -> [[(Int,Int)]]

1	jarras :: (Int,Int,Int) -> [[(Int,Int)]]

tal (jarras (a,b,c)) es la lista de las soluciones del problema de las
jarras (a,b,c). Por ejemplo,

   λ> take 2 (map snd (sort [(length xs,xs) | xs <- jarras (4,3,2)]))
   [[(0,0),(0,3),(3,0),(3,3),(4,2),(0,2),(2,0)],
    [(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)]]

λ> take 2 (map snd (sort [(length xs,xs) | xs <- jarras (4,3,2)]))

[[(0,0),(0,3),(3,0),(3,3),(4,2),(0,2),(2,0)],

[(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)]]

La interpretación [(0,0),(4,0),(1,3),(1,0),(0,1),(4,1),(2,3)] es:

(0,0) se inicia con las dos jarras vacías,
(4,0) se llena la jarra de 4 con el grifo,
(1,3) se llena la de 3 con la de 4,
(1,0) se vacía la de 3,
(0,1) se pasa el contenido de la primera a la segunda,
(4,1) se llena la primera con el grifo,
(2,3) se llena la segunda con la primera.

Otros ejemplos

   λ> (snd . head . sort) [(length xs,xs) | xs <- jarras (15,10,5)]
   [(0,0),(15,0),(5,10)]
   λ> jarras (15,10,4)
   []

λ> (snd . head . sort) [(length xs,xs) | xs <- jarras (15,10,5)]

[(0,0),(15,0),(5,10)]

λ> jarras (15,10,4)

[]

Nota: Las librerías necesarias se encuentran en la página de códigos.

Soluciones

import I1M.BusquedaEnEspaciosDeEstados

-- Un problema queda determinado por las capacidades de las dos jarras y
-- el contenido que se desea lograr 

-- Un estado es una lista de dos números. El primero es el contenido de
-- la jarra de 4 litros y el segundo el de la de 3 litros. 
type EstadoJarras = (Int,Int)

inicialJarras :: EstadoJarras
inicialJarras = (0,0)

esFinalJarras :: (Int,Int,Int) -> EstadoJarras -> Bool
esFinalJarras (_,_,c) (x,_) = x == c

sucesoresEjarras :: (Int,Int,Int) -> EstadoJarras -> [EstadoJarras]
sucesoresEjarras (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 > 0, x + y > a] ++
    [(x-(b-y),b) | x > 0, y < b, x + y > b] ++
    [(x+y,0) | y > 0, x + y <= a] ++ 
    [(0,x+y) | x > 0, x + y <= b]

-- Los nodos son las soluciones parciales
type NodoJarras = [EstadoJarras]

inicialNjarras :: NodoJarras
inicialNjarras = [inicialJarras]

esFinalNjarras :: (Int,Int,Int) -> NodoJarras -> Bool
esFinalNjarras p (e:_) = esFinalJarras p e

sucesoresNjarras :: (Int,Int,Int) -> NodoJarras -> [NodoJarras]
sucesoresNjarras p n@(e:es) =
    [e':n | e' <- sucesoresEjarras p e,
            e' `notElem` n]

solucionesJarras :: (Int,Int,Int) -> [NodoJarras]
solucionesJarras p = buscaEE (sucesoresNjarras p)
                             (esFinalNjarras p)
                             inicialNjarras

jarras :: (Int,Int,Int) -> [[(Int,Int)]]
jarras p = map reverse (solucionesJarras p)

import I1M.BusquedaEnEspaciosDeEstados

-- Un problema queda determinado por las capacidades de las dos jarras y

-- el contenido que se desea lograr

-- Un estado es una lista de dos números. El primero es el contenido de

-- la jarra de 4 litros y el segundo el de la de 3 litros.

type EstadoJarras = (Int,Int)

inicialJarras :: EstadoJarras

inicialJarras = (0,0)

esFinalJarras :: (Int,Int,Int) -> EstadoJarras -> Bool

esFinalJarras (_,_,c) (x,_) = x == c

sucesoresEjarras :: (Int,Int,Int) -> EstadoJarras -> [EstadoJarras]

sucesoresEjarras (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 > 0, x + y > a] ++

[(x-(b-y),b) | x > 0, y < b, x + y > b] ++

[(x+y,0) | y > 0, x + y <= a] ++

[(0,x+y) | x > 0, x + y <= b]

-- Los nodos son las soluciones parciales

type NodoJarras = [EstadoJarras]

inicialNjarras :: NodoJarras

inicialNjarras = [inicialJarras]

esFinalNjarras :: (Int,Int,Int) -> NodoJarras -> Bool

esFinalNjarras p (e:_) = esFinalJarras p e

sucesoresNjarras :: (Int,Int,Int) -> NodoJarras -> [NodoJarras]

sucesoresNjarras p n@(e:es) =

[e':n | e' <- sucesoresEjarras p e,

e' `notElem` n]

solucionesJarras :: (Int,Int,Int) -> [NodoJarras]

solucionesJarras p = buscaEE (sucesoresNjarras p)

(esFinalNjarras p)

inicialNjarras

jarras :: (Int,Int,Int) -> [[(Int,Int)]]

jarras p = map reverse (solucionesJarras p)

6 Comentarios

type Jarra = (Int,Int)

data NodoJarra = Nodo [Jarra]
               deriving (Eq,Ord,Show)

jarras :: (Int,Int,Int) -> [[Jarra]]
jarras x@(a,b,c) 
    | abs (a-b) > c = []
    | otherwise = nodos2Lists $ 
           buscaEE (sucesoresN x) (esFinal x) (Nodo [inicial])

inicial :: Jarra
inicial = (0,0)

esFinal :: (Int,Int,Int) -> NodoJarra -> Bool
esFinal (a,b,c) (Nodo ((x,y):_)) = x == c
esFinal _ _ = False

sucesores :: (Int,Int,Int) -> Jarra -> [Jarra]
sucesores (a,b,c) (x,y) 
         | x == a = f (x,y) ++ g (a,y) ++ vacia (x,y)
         | otherwise = (a,y): (f (x,y) ++
                      g (x,y) ++ vacia (x,y))
         where f = completaConGrifo (a,b,c)
               g = completaConJarra (a,b,c)

completaConGrifo :: (Int,Int,Int) -> Jarra -> [Jarra]
completaConGrifo (a,b,_) (x,y) = [(a,y),(x,b)] 

completaConJarra :: (Int,Int,Int) -> Jarra -> [Jarra]
completaConJarra (a,b,_) (x,y) = filter (p (a,b))
             $ completaCon x (a,b) (x,y) ++
               completaCon y (a,b) (x,y)
         where p (a,b) (x,y) = x <= a && y <= b 
                               && x >= 0 && y >= 0

completaCon :: Int -> Jarra -> Jarra -> [Jarra]
completaCon p (a,b) (x,y)
    | p==x = [(x-n,y+n) | n <- [x,b-y]]
    | p==y = [(x+n,y-n) | n <- [y,a-x]]
   
vacia :: Jarra -> [Jarra]
vacia (x,y) = filter (/=(0,0)) 
         [(m1,m2) | m1 <- [0,x], m2<- [0,y]]

sucesoresN :: (Int,Int,Int) -> NodoJarra -> [NodoJarra]
sucesoresN (a,b,c) (Nodo n) = 
      [Nodo (x:n) | x <- sucesores (a,b,c) (head n), notElem x n]

nodos2Lists :: [NodoJarra] -> [[Jarra]]
nodos2Lists [] = []
nodos2Lists ((Nodo x):xs) = x : nodos2Lists xs

type Jarra = (Int,Int)

data NodoJarra = Nodo [Jarra]

deriving (Eq,Ord,Show)

jarras :: (Int,Int,Int) -> [[Jarra]]

jarras x@(a,b,c)

| abs (a-b) > c = []

| otherwise = nodos2Lists $

buscaEE (sucesoresN x) (esFinal x) (Nodo [inicial])

inicial :: Jarra

inicial = (0,0)

esFinal :: (Int,Int,Int) -> NodoJarra -> Bool

esFinal (a,b,c) (Nodo ((x,y):_)) = x == c

esFinal _ _ = False

sucesores :: (Int,Int,Int) -> Jarra -> [Jarra]

sucesores (a,b,c) (x,y)

| x == a = f (x,y) ++ g (a,y) ++ vacia (x,y)

| otherwise = (a,y): (f (x,y) ++

g (x,y) ++ vacia (x,y))

where f = completaConGrifo (a,b,c)

g = completaConJarra (a,b,c)

completaConGrifo :: (Int,Int,Int) -> Jarra -> [Jarra]

completaConGrifo (a,b,_) (x,y) = [(a,y),(x,b)]

completaConJarra :: (Int,Int,Int) -> Jarra -> [Jarra]

completaConJarra (a,b,_) (x,y) = filter (p (a,b))

$ completaCon x (a,b) (x,y) ++

completaCon y (a,b) (x,y)

where p (a,b) (x,y) = x <= a && y <= b

&& x >= 0 && y >= 0

completaCon :: Int -> Jarra -> Jarra -> [Jarra]

completaCon p (a,b) (x,y)

| p==x = [(x-n,y+n) | n <- [x,b-y]]

| p==y = [(x+n,y-n) | n <- [y,a-x]]

vacia :: Jarra -> [Jarra]

vacia (x,y) = filter (/=(0,0))

[(m1,m2) | m1 <- [0,x], m2<- [0,y]]

sucesoresN :: (Int,Int,Int) -> NodoJarra -> [NodoJarra]

sucesoresN (a,b,c) (Nodo n) =

[Nodo (x:n) | x <- sucesores (a,b,c) (head n), notElem x n]

nodos2Lists :: [NodoJarra] -> [[Jarra]]

nodos2Lists [] = []

nodos2Lists ((Nodo x):xs) = x : nodos2Lists xs

Responder

manpende dice:

18-mayo-2016 a las 11:22

No he sido capaz de que aparezcan las soluciones en el orden mostrado en los ejemplos.

Responder

import I1M.BusquedaEnEspaciosDeEstados

jarras :: (Int,Int,Int) -> [[(Int,Int)]]
jarras (a,b,c) = buscaEE sucesores esFinal [(0,0)]
        where esFinal xs = fst (last xs) == c 
              sucesores e = map (\x -> e ++ [x]) $ filter (`notElem`e) (xs ++ ys ++ zs ++ as ++ bs)
                  where xs = [(x,0),(0,y),(a,y),(x,b)]
                        ys = if x+y <= a then [(x+y,0)] else []
                        zs = if x+y <= b then [(0,x+y)] else []
                        as = if x+y > a then [(a,x+y-a)] else []
                        bs = if x+y > b then [(x+y-b,b)] else []
                        (x,y) = last e

import I1M.BusquedaEnEspaciosDeEstados

jarras :: (Int,Int,Int) -> [[(Int,Int)]]

jarras (a,b,c) = buscaEE sucesores esFinal [(0,0)]

where esFinal xs = fst (last xs) == c

sucesores e = map (\x -> e ++ [x]) $ filter (`notElem`e) (xs ++ ys ++ zs ++ as ++ bs)

where xs = [(x,0),(0,y),(a,y),(x,b)]

ys = if x+y <= a then [(x+y,0)] else []

zs = if x+y <= b then [(0,x+y)] else []

as = if x+y > a then [(a,x+y-a)] else []

bs = if x+y > b then [(x+y-b,b)] else []

(x,y) = last e

Responder

Con una distinción bastante amplia de casos para optimizar lo máximo posible

jarras :: (Int,Int,Int) -> [[(Int,Int)]]
jarras (a,b,c) = busca [[(0,0)]]
  where
    busca :: [[(Int,Int)]] -> [[(Int,Int)]]
    busca ((ys@((d,e):_)):xss)
      | d == c    = reverse ys : busca xss
      | otherwise = busca (xss ++
                           [(a,e):ys | d < a, (a,e) `notElem` ys] ++
                           [(d,b):ys | e < b, (d,b) `notElem` ys] ++
                           [(0,e):ys | d > 0, (0,e) `notElem` ys] ++
                           [(d,0):ys | e > 0, (d,0) `notElem` ys] ++
                           [(a,e-a+d):ys | d < 4, e > 0, d + e >a,
                                          (a,e-a+d) `notElem` ys] ++
                           [(d-b+e,b):ys | d > 0, e < 3, d + e > b,
                                          (d-b+e,b) `notElem` ys] ++
                           [(d+e,0):ys | e > 0, d + e <= a,
                                            (d+e,0) `notElem` ys] ++ 
                           [(0,d+e):ys | d > 0, d + e <= b,
                                            (0,d+e) `notElem` ys])
    busca [] = []

jarras :: (Int,Int,Int) -> [[(Int,Int)]]

jarras (a,b,c) = busca [[(0,0)]]

where

busca :: [[(Int,Int)]] -> [[(Int,Int)]]

busca ((ys@((d,e):_)):xss)

| d == c = reverse ys : busca xss

| otherwise = busca (xss ++

[(a,e):ys | d < a, (a,e) `notElem` ys] ++

[(d,b):ys | e < b, (d,b) `notElem` ys] ++

[(0,e):ys | d > 0, (0,e) `notElem` ys] ++

[(d,0):ys | e > 0, (d,0) `notElem` ys] ++

[(a,e-a+d):ys | d < 4, e > 0, d + e >a,

(a,e-a+d) `notElem` ys] ++

[(d-b+e,b):ys | d > 0, e < 3, d + e > b,

(d-b+e,b) `notElem` ys] ++

[(d+e,0):ys | e > 0, d + e <= a,

(d+e,0) `notElem` ys] ++

[(0,d+e):ys | d > 0, d + e <= b,

(0,d+e) `notElem` ys])

busca [] = []

Responder

fracruzam dice:

18-mayo-2016 a las 17:55

En la línea 12 debería ir ‘d < a' y no 'd < 4'. En la 14 debería ir 'e < b' y no 'e < 3'.

Responder

import I1M.BusquedaEnEspaciosDeEstados 

inicioJ :: [(Int,Int)]
inicioJ = [(0,0)]

esFinalJ :: (Int,Int,Int) -> [(Int,Int)] -> Bool
esFinalJ (_,_,c) xs = cumple (head xs)
    where cumple (x,_) = x == c

sucesorJ :: (Int,Int,Int) -> (Int,Int) -> [(Int,Int)]
sucesorJ (a,b,_) (x,y) = xs ++ ys ++ zs ++ rs ++ ts ++ us ++ vs ++ ds
   where xs = [ (x,b) | y < b]
         ys = [ (a,y) | x < a]
         zs = [ (x,0) | y > 0]
         rs = [ (0,y) | x > 0]
         ts = [ (a,y-(a-x)) | x < a, y > 0, x+y > a]
         us = [ (x-(b-y),b) | x > 0, y < b, x+y > b]
         vs = [ (0,x+y) | x > 0, x+y <= b]
         ds = [ (x+y,0) | y > 0, x+y <= a]

todoSucesorJ :: (Int,Int,Int) -> [(Int,Int)] -> [[(Int,Int)]]
todoSucesorJ (a,b,c) m@(x:xs) = [ y:m | y <- sucesorJ (a,b,c) x, notElem y m]

buscador :: (Int,Int,Int) -> [[(Int,Int)]]
buscador (a,b,c) = 
 buscaEE (todoSucesorJ (a,b,c)) (esFinalJ (a,b,c)) inicioJ

jarras :: (Int,Int,Int) -> [[(Int,Int)]]
jarras (a,b,c) = [ reverse xs | xs <- buscador (a,b,c)]

import I1M.BusquedaEnEspaciosDeEstados

inicioJ :: [(Int,Int)]

inicioJ = [(0,0)]

esFinalJ :: (Int,Int,Int) -> [(Int,Int)] -> Bool

esFinalJ (_,_,c) xs = cumple (head xs)

where cumple (x,_) = x == c

sucesorJ :: (Int,Int,Int) -> (Int,Int) -> [(Int,Int)]

sucesorJ (a,b,_) (x,y) = xs ++ ys ++ zs ++ rs ++ ts ++ us ++ vs ++ ds

where xs = [ (x,b) | y < b]

ys = [ (a,y) | x < a]

zs = [ (x,0) | y > 0]

rs = [ (0,y) | x > 0]

ts = [ (a,y-(a-x)) | x < a, y > 0, x+y > a]

us = [ (x-(b-y),b) | x > 0, y < b, x+y > b]

vs = [ (0,x+y) | x > 0, x+y <= b]

ds = [ (x+y,0) | y > 0, x+y <= a]

todoSucesorJ :: (Int,Int,Int) -> [(Int,Int)] -> [[(Int,Int)]]

todoSucesorJ (a,b,c) m@(x:xs) = [ y:m | y <- sucesorJ (a,b,c) x, notElem y m]

buscador :: (Int,Int,Int) -> [[(Int,Int)]]

buscador (a,b,c) =

buscaEE (todoSucesorJ (a,b,c)) (esFinalJ (a,b,c)) inicioJ

jarras :: (Int,Int,Int) -> [[(Int,Int)]]

jarras (a,b,c) = [ reverse xs | xs <- buscador (a,b,c)]

Responder

Problema de las jarras

Soluciones

6 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Se puede imprimir o compartir con

6 Comentarios

Escribe tu soluciónCancel reply

Entradas recientes

Buscar

Correo electrónico