水の移し替えパズル in Haskell DouKaku?

A, B, Cの容器があり，それぞれ水が4L, 2L, 10L入っている．ここで次の操作を繰り返す．

(*)「A, B, Cのどれか二つの容器から水を1Lずつくみ上げ，残りの容器に移す．」

たとえばA, Bから1Lずつくみ上げて移せばA=3L, B=1L, C=12Lとなる．くみ上げる前の容器には必ず水が入っているとする．

(*)を繰り返してどれか一つの容器にのみ水がはいっている状態にする最小手数を求めよ．

可能ならA=827392L，B=65536L，C=122880Lのときも求めよ．

このお題は光成さんの投稿を元に作成しました。ご協力ありがとうございます。

幅優先探索です。

module Main(main) where

import List(any, findIndex)

type Youki = (Int, Int, Int)

main :: IO ()
main = print $ shallowestLeafDepth (4, 2, 10)

shallowestLeafDepth :: Youki -> Int
shallowestLeafDepth y = maybe 0 id $ findIndex (any isLeaf) $ bfs branch [y]

isLeaf :: Youki  -> Bool
isLeaf (_, 0, 0) = True
isLeaf (0, _, 0) = True
isLeaf (0, 0, _) = True
isLeaf _ = False

branch :: Youki -> [Youki]
branch (w1, 0, 0) = []
branch (0, w2, 0) = []
branch (0, 0, w3) = []
branch (0, w2, w3) = [(2, w2-1, w3-1)]
branch (w1, 0, w3) = [(w1-1, 2, w3-1)]
branch (w1, w2, 0) = [(w1-1, w2-1, 2)]
branch (w1, w2, w3) = [(w1+2, w2-1, w3-1), (w1-1, w2+2, w3-1), (w1-1, w2-1, w3+2)]

bfs :: (a -> [a]) -> [a] -> [[a]]
bfs f [] = []
bfs f xs = xs : bfs f (concatMap f xs)

停止性、効率を気にせずにやみくもに探索すると
したらどう書くかバージョン。

ここで使っている幅優先探索については
（参考ページ）毎日Haskellの 2007-07-04 参照。

see: 毎日Haskell

import List (transpose)
import Monad (msum)

tesuu ws = maybe (-1) (length . tail) result where
  result = msum $ f [] ws
  f moves xs = case filter (>0) xs of
    (_:_:_) -> (Nothing:) $ map msum $ transpose
      $ map (f moves') $ filter (all (>=0))
      $ map (zipWith (+) xs) [[2,-1,-1],[-1,2,-1],[-1,-1,2]]
    _ -> [Just moves']
    where moves' = moves++[xs]

深さ優先で。

import Control.Monad.State

type Youki = (Int,Int,Int)

f :: Int -> Youki -> State Int ()
f num y@(a,b,c) | or (map (0>) x) = return ()
                | maximum x == sum x = check (put num)
                | otherwise = check (mapM_ (f (num + 1)) next)
  where x = [a,b,c]
        next = [(a-1,b-1,c+2),(a-1,b+2,c-1),(a+2,b-1,c-1)]
        check f = do {n <- get; if num < n then f else return ()} 

start = execState state maxBound
  where state = f 0 [] (4,2,10)

DouKaku?

水の移し替えパズル

Posted feedbacks - Haskell

Index

Feed

Other

Link

Pathtraq