Problema de las jarras

PorJosé A. Alonso 10-mayo-201817-mayo-2018

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)

5 Comentarios

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)

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)

Responder

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

--------

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

Responder

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

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

Responder

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 .

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

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.

Responder

jaibengue dice:

14-mayo-2018 a las 11:44

Nice one!

Responder

Problema de las jarras

Soluciones

5 Comentarios

Leave a Reply to jaibengueCancel reply

Entradas recientes

Buscar

Correo electrónico

Soluciones

Se puede imprimir o compartir con

5 Comentarios

Leave a Reply to jaibengueCancel reply

Entradas recientes

Buscar

Correo electrónico