油売り

すごく投げやりな感じ。勉強しなきゃなのに。まさに油売り。aburawryyyyy。

type State = ((Int, Int, Int), History)
type History  = [(Cup, Cup, Int)]
data Cup = A | B | C deriving Show

s = 10
x = 7
y = 3
g = 5

move :: State -> [State]
move ((a, b, c), h) =
    [ ((a-(x-b), x, c), (A,B, x-b):h)
    , ((a-(y-c), b, y), (A,C, y-c):h)
    , ((a+b, 0, c),     (B,A, b):h)
    , ((a+c, b, 0),     (C,A, c):h)
    ] ++
    [ let t = y-c in
      if t > b then ((a, 0, b+c), (B,C,b):h)
               else ((a, b-t, y), (B,C,t):h)
    , let t = x-b in
      if t > c then ((a, b+c, 0), (C,B,c):h)
               else ((a, x, c-t), (C,B,t):h)
    ]

findloop :: [State] -> [State] -> History
findloop queue searched =
    let s = map fst searched
        q = filter (\x -> notElem (fst x) s) $ concatMap move queue
        t = filter isOK q in
    if null t then findloop q $ q++searched else reverse $ snd $ head t
isOK ((a,_,_),_) = a==g

main = mapM_ (putStrLn . showHistory) $ findloop [((s,0,0), [])] []
showHistory (from,to,q) = show from++" --"++show q++"--> "++show to

Main> main
A --7--> B
B --3--> C
C --3--> A
B --3--> C
C --3--> A
B --1--> C
A --7--> B
B --2--> C
C --3--> A
Main>