答复: 三只大老虎和三只小老虎过河

原始问题：http://www.iteye.com/topic/315448

[quote]三只大老虎和三只小老虎过河
三只大老虎分别是A.B.C三只小老虎分别是1.2.3,只有一条船,一次只能坐两只,A和1是母子俩,B和2是母子俩,C和3母子俩,只要任何一个母亲离开小老虎,小老虎都会被吃掉.
问题补充：大老虎都会划船 三只小老虎中只有1会划船
设大老虎为ABC，相应的小老虎为abc，其中c会划船。
[/quote]

我的一些想法

这是典型的图论搜索问题。建立一个“图”，每个节点是一个状态（每只老虎在哪侧，船在哪侧）
两个节点之间有边，边表示一个状态调走一只或几只老虎，可以转换到另一个状态。
初始状态是6只老虎都在原侧，终结状态就是6只老虎都被转移到对侧。
解法就是找到从初始状态到终结状态的一条路径（最好是最短路径）。

状态分合法状态和非法状态。非法状态就是会有老虎被吃掉。因此搜索的时候，需要避免走到非法状态。
转移需要满足：最多转移两只老虎，而且必须有一只会划船。

这样用简单的BFS就可以了。

最优解法可能有多个，都是13步。

关于用Haskell语言实现BFS算法。
BFS算法，原本是用队列的入列和出列描述的。然而在Haskell里，由于没有可以变更的数据结构，只能用函数的参数来描述状态。

我的实现

module Main where

import List
import Maybe
import Text.Printf

main = putStrLn $ prettyPrintPath $ fromJust $ bfs

data Tiger = BigA | BigB | BigC | SmallA | SmallB | SmallC
            deriving (Show,Eq,Ord)
-- SmallC can drive boat

-- A helper logical function:  a implies b
implies :: Bool -> Bool -> Bool
implies a b = (not a) || b


data State = State Place [Tiger]    deriving (Show,Eq)
data Trans = Trans [Tiger]          deriving (Show,Eq)
data Place = Local | Remote         deriving (Show,Eq)

allTigers = [BigA,BigB,BigC,SmallA,SmallB,SmallC]
bigTigers = [BigA,BigB,BigC]
smallTigers = [SmallA,SmallB,SmallC]
driverTigers = [BigA,BigB,BigC,SmallC]

startingState = State Local allTigers
finalState = State Remote []


-- A state is valid if both side of river is valid
stateValid :: State -> Bool
stateValid (State _ tigers) = localStateValid tigers &&
                              localStateValid (allTigers\\tigers) where

    -- A state is valid on one side of river means
    -- Either there are no big tigers or all small tigers are protected by their mothers
    localStateValid tigers = (noBigTiger tigers) || (allProtected tigers)

    noBigTiger tigers = all (`notElem` tigers) bigTigers

    allProtected tigers = all protected (zip smallTigers bigTigers)
        where protected (small,big) = (small `elem` tigers) `implies` (big `elem` tigers)


-- A transition is valid if there is at most 2 tigers on the boat
-- and at least one of them can drive the boat.
transValid :: Trans -> Bool
transValid (Trans tigers) = length tigers <=2 && any (`elem` tigers) driverTigers


-- Find all possible transition from one state,
-- no matter whether the target state is valid.
findAllTrans :: State -> [Trans]
findAllTrans (State place tigers) = map Trans (if place==Local
                                      then allTransLocal tigers
                                      else allTransLocal (allTigers\\tigers)
                                      ) where

    allTransLocal :: [Tiger] -> [[Tiger]]
    allTransLocal tigers = 
        let (drivers,others) = partition (`elem` driverTigers) tigers
        in [[one] | one <- drivers] ++
           [[one,another] | one <- drivers, another <- others] ++
           anyTwo drivers
        where anyTwo [] = []
              anyTwo [x] = []
              anyTwo (x:xs) = [[x,another] | another <- xs] ++ anyTwo xs

-- Actually perform one transition on a state, return the target state.
-- Tiger lists are sorted for easy comparison.
doTrans :: State -> Trans -> State
doTrans (State Local tigers) (Trans goTigers) = State Remote (sort (tigers\\goTigers))
doTrans (State Remote tigers) (Trans comeTigers) = State Local (sort (tigers++comeTigers))


-- Breadth first search.
-- Search from the initial state to the final state
bfs :: Maybe [(State,Trans,State)]
bfs = bfs' [startingState] [] []

-- Inside algorithm
bfs' :: [State] -> [State] -> [(State,Trans,State)] -> Maybe [(State,Trans,State)]
bfs' [] _ _ = Nothing  -- When queue empty, fail.
bfs' (s:ss) visited transes =  -- s is current state, ss are other states.
    if s == finalState -- When final state reached, success.
    then Just (extractPath transes)
    else 
    if s `elem` visited -- If state visited or visited, discard.
    then bfs' ss visited transes
    else let newVisited = s:visited -- Otherwise mark this state visited.
             allValidTransition =   -- Find all transitions from current state (s), filtered.
                 let allTrans = findAllTrans s
                     allNewStates = map (doTrans s) allTrans
                 in filter (\(s,t,s') -> (stateValid s' && s' `notElem` newVisited))
                     (zip3 (repeat s) allTrans allNewStates) -- only keep valid and unvisited
             newFrontier = ss ++ (map (\(s,t,s') -> s') allValidTransition) -- update queue
             newTranses = allValidTransition ++ transes -- update transition tree
         in bfs' newFrontier newVisited newTranses -- next round


-- Given a resulting transition tree (a list of (State,Trans,State))
-- Output a path from startingState to finalState
extractPath sts = reverse $ extractPath' sts finalState
extractPath' _ curState | curState == startingState = []
extractPath' sts curState = let (prevState,trans,_) =
                                 (fromJust $ find (\(s,t,s') -> s' == curState) sts)
                            in (prevState,trans,curState):(extractPath' sts prevState)

-- Pretty print path: print all step and the final state
prettyPrintPath sts = unlines $ ((map prettyPrintStep sts) ++
                        [prettyPrintStateLine $ (\(_,_,s') -> s') $ last sts])

-- Each step consists of the old state and the transition
prettyPrintStep (s,t,s') = (prettyPrintStateLine s) ++ "\n" ++ (prettyPrintTransLine s t)

prettyPrintStateLine (State place tigers) =
    let lhs = prettyPrintTigers tigers
        rhs = prettyPrintTigers (allTigers\\tigers)
        stateLine = printf "[%6s] |            | [%6s]\n" lhs rhs :: String
    in stateLine

prettyPrintTransLine (State place oldTigers) (Trans movingTigers) =
    let moves = prettyPrintTigers movingTigers
        transLine = case place of
            Local  -> printf "           %2s --->" moves :: String
            Remote -> printf "              <--- %2s" moves :: String
    in transLine

prettyPrintTigers = map prettyPrintTiger
prettyPrintTiger tiger = case tiger of
    BigA -> 'A'
    BigB -> 'B'
    BigC -> 'C'
    SmallA -> '1'
    SmallB -> '2'
    SmallC -> '3'