import Data.List
import Debug.Trace

-- Subject
data Subject = Mom | Girl | Boy | Pop | Cop | Crim
    deriving Show

instance Enum Subject where
    fromEnum Mom = 0
    fromEnum Girl = 1
    fromEnum Boy = 2
    fromEnum Pop = 3
    fromEnum Cop = 4
    fromEnum Crim = 5

instance Eq Subject where
    (==) s1 s2 = (fromEnum s1) == (fromEnum s2)

instance Ord Subject where
    (<=) s1 s2 = (<=) (fromEnum s1) (fromEnum s2)

--Raft
data Raft = Raft0 | Raft1 Subject | Raft2 Subject Subject

instance Enum Raft where
    fromEnum Raft0 = 0
    fromEnum (Raft1 s1) = fromEnum s1
    fromEnum (Raft2 s1 s2) = (fromEnum s1) * 1000 + (fromEnum s2)

instance Eq Raft where
    (==) r1 r2 = (fromEnum r1) == (fromEnum r2)

instance Ord Raft where
    (<=) r1 r2 = (fromEnum r1) <= (fromEnum r2)

instance Show Raft where
    show Raft0 = "{}"
    show (Raft1 r1) = "{" ++ show r1 ++ "}"
    show (Raft2 r1 r2) = "{" ++ show r1 ++ " & " ++ show r2 ++ "}"

-- direction
data Position = AtLeft | AtRight
    deriving Show

instance Enum Position where
    fromEnum AtLeft = 0
    fromEnum AtRight = 1

instance Eq Position where
    (==) p1 p2 = (fromEnum p1) == (fromEnum p2)

instance Ord Position where
    (<=) p1 p2 = (fromEnum p1) <= (fromEnum p2)
    
changePos AtLeft = AtRight
changePos AtRight = AtLeft

-- World
data World = World [Subject] Raft Position [Subject]
    
instance Eq World where
    (==) (World ls1 raft1 pos1 rs1) (World ls2 raft2 pos2 rs2) = 
            (sort ls1 == sort ls2) &&
            (raft1 == raft2) &&
            (pos1 == pos2) &&
            (sort rs1 == sort rs2)

instance Ord World where
    (<=) (World ls1 raft1 pos1 rs1) (World ls2 raft2 pos2 rs2) = 
            (sort ls1 <= sort ls2) || 
            ((sort ls1 == sort ls2) && (raft1 <= raft2)) ||
            ((sort ls1 == sort ls2) && (raft1 == raft2) && (pos1 <= pos2)) ||
            ((sort ls1 == sort ls2) && (raft1 == raft2) && (pos1 == pos2) && (sort rs1 <= sort rs2))

instance Show World where
    show (World ls Raft0 AtLeft rs) = show ls  ++ " "     ++ show Raft0 ++ "     " ++ show rs
    show (World ls raft AtLeft rs)  = show ls  ++ "     " ++ show raft  ++ " >>> " ++ show rs
    show (World ls Raft0 AtRight rs) = show ls ++ "     " ++ show Raft0 ++ " "     ++ show rs
    show (World ls raft AtRight rs)  = show ls ++ " <<< " ++ show raft  ++ "     " ++ show rs

validWorld  (World leftSide raft _ rightSide) = (not $ invalidWorld leftSide) && (not $ invalidWorld rightSide) 
            && (validRaft raft)
        where invalidWorld mans = ((Pop `elem` mans) && (not $ Mom `elem` mans) && (Girl `elem` mans)) 
                || ((not $ Pop `elem` mans) && (Mom `elem` mans) && (Boy `elem` mans))
                || ((Crim `elem` mans) && (not $ Cop `elem` mans) && (hereCivilian mans))

hereCivilian mans = (Mom `elem` mans) || (Pop `elem` mans) || (Girl `elem` mans) || (Boy `elem` mans)

outEnt   ent  = putStr $ show ent
outEnts  ents = putStr (foldl (\x y -> x ++ (show y) ++ "\n") "" ents) 

outEnts2 [] = do
                putStr ""
outEnts2 (h:t) = do
                outEnts2' h
                outEnts2 t

outEnts2' [] = do
                putStr "-----------------------\n"
outEnts2' (h:t) = do
                putStr ((show h) ++ "\n")
                outEnts2' t

traceIt [] = "^^^^^^^^^^^^^^^^^^^^^^^^\n"
traceIt (h:t) = (traceIt' $ h) ++ (traceIt t)

traceIt' [] = "-----------------------\n"
traceIt' (h:t) = ((show h) ++ "\n") ++ (traceIt' t)

--validate raft loading
validRaft Raft0 = True

validRaft (Raft1 Pop) = True
validRaft (Raft1 Mom) = True
validRaft (Raft1 Cop) = True
validRaft (Raft1 _) = False

validRaft (Raft2 Mom Boy) = False
validRaft (Raft2 Mom Crim) = False
validRaft (Raft2 Mom _) = True

validRaft (Raft2 Girl Mom) = True
validRaft (Raft2 Girl Cop) = True
validRaft (Raft2 Girl _) = False

validRaft (Raft2 Pop Girl) = False
validRaft (Raft2 Pop Crim) = False
validRaft (Raft2 Pop _) = True

validRaft (Raft2 Boy Mom) = True
validRaft (Raft2 Boy Cop) = True
validRaft (Raft2 Boy _) = False

validRaft (Raft2 Cop _) = True

validRaft (Raft2 Crim Cop) = True
validRaft (Raft2 Crim _) = False

-- return all possible rafts:
getAllRafts [] = []
getAllRafts (h:t) = [Raft1 h] ++ (map (\x -> (Raft2 h x)) t) ++ (getAllRafts t)
-- return only valid rafts.
getValidRafts l = filter validRaft (getAllRafts $ nub l)

-- remove first entrance of item from list
removeFirst _ [] = []
removeFirst e (h:t) | h==e = t
                    | otherwise = h : (removeFirst e t)

-- remove first entrance of 2 items from list
removeFirst2 e1 e2 list = removeFirst e2 (removeFirst e1 list)

-- load raft
loadRaft :: World -> Raft -> World
loadRaft (World ls Raft0 AtLeft rs) raft@(Raft1 r1)    = (World (removeFirst r1 ls) raft AtLeft rs)
loadRaft (World ls Raft0 AtLeft rs) raft@(Raft2 r1 r2) = (World (removeFirst2 r1 r2 ls) raft AtLeft rs)
loadRaft (World ls Raft0 AtRight rs) raft = (World ors raft AtRight ols)
        where (World ols _ _ ors) = loadRaft (World rs Raft0 AtLeft ls) raft

-- move raft to other side
moveRaft :: World -> World
moveRaft (World ls raft pos rs) = (World ls raft (changePos pos) rs)

-- unload raft
unloadRaft :: World -> World
unloadRaft (World ls (Raft1 r1   ) AtLeft  rs) = (World (ls ++ [r1    ]) Raft0 AtLeft  rs)
unloadRaft (World ls (Raft2 r1 r2) AtLeft  rs) = (World (ls ++ [r1, r2]) Raft0 AtLeft  rs)
unloadRaft (World ls raft          AtRight rs) = (World ors              Raft0 AtRight ols)
        where (World ols _ _ ors) = unloadRaft (World rs raft AtLeft ls)

allLoads :: World -> [World]
allLoads w@(World ls Raft0 AtLeft  rs) = map (\r -> loadRaft w r) (getValidRafts ls)
allLoads w@(World ls Raft0 AtRight rs) = map (\r -> loadRaft w r) (getValidRafts rs)

allValidLoads :: World -> [World]
allValidLoads w = filter (\x -> validWorld x) (allLoads w)

stepLoad :: [[World]] -> [[World]]
stepLoad []     = []
stepLoad (w:ws) = (stepLoadOne w) ++ (stepLoad ws)

stepLoadOne :: [World] -> [[World]]
stepLoadOne (w:log) = map (\neww -> (neww:log)) (nub $ sort $ allValidLoads w)

stepUnload :: [[World]] -> [[World]]
stepUnload []     = []
stepUnload (w:ws) = (stepUnloadOne w) : (stepUnload ws)

stepUnloadOne :: [World] -> [World]
stepUnloadOne l@(w:log) = (unloadRaft $ moveRaft w):l

step :: Int -> [[World]] -> [[World]]
step 0 x = map reverse x
step n x = step (n-1) (stepUnload $ stepLoad x)

isSolved :: World -> Bool
isSolved (World [] _ _ _) = True
isSolved _ = False

hasSolved :: [[World]] -> Bool
hasSolved [] = False
hasSolved (h:t) | isSolved (head h) = True
                | otherwise = hasSolved t

getSolved :: [[World]] -> [World]
getSolved [] = error "illegel getSolved"
getSolved (h:t) | isSolved (head h) = reverse h
                | otherwise = getSolved t

filterDupAndInvalid :: [[World]] -> [[World]]
filterDupAndInvalid x = nubBy (\(h1:_) (h2:_) -> h1 == h2) (filter (\(h:_) -> validWorld h) x)

-- get initial, return log
solve :: Int -> [[World]] -> [World]
solve 0 _ = error "Path not found !!!"
solve n l    | hasSolved l = getSolved l
            | otherwise = solve (n - 1) (filterDupAndInvalid $ stepUnload $ stepLoad l)

initial = World [Mom, Girl, Girl, Pop, Boy, Boy, Cop, Crim] Raft0 AtLeft []

main :: IO ()
main = outEnts $ solve 100 [[initial]]

-- code goes here ...
instance Eq Subject where
    (==) s1 s2 = (fromEnum s1) == (fromEnum s2)
-- code goes here ...

LCR>Между прочим, работает тэг haskell

initial = World [Mom, Girl, Girl, Pop, Boy, Boy, Cop, Crim] Raft0 AtLeft []

SJA>Только по голове сильно не бейте. Это моя первая программа на Haskell-е такого "громадного" объёма.

'`m g1 g2 f b1 b2 p c' =:(0&{)`(1&{)`(2&{)`(3&{)`(4&{)`(5&{)`(6&{)`(7&{)

and =: *.
or  =: +.
not =: -. @

cond1 =: m and (b1 or b2) and f not
cond2 =: f and (g1 or g2) and m not
cond3 =: c and (m or g1 or g2 or f or b1 or b2) and p not
cond  =: ( (cond1 or cond2 or cond3) not  )"1

raftcond =: ( cond and (m or f or p) )"1
raftmask =: (#~ 2&= @: (+/"1)) #: i.256

nextstates =: 3 : 0
  raft    =. (#~ raftcond) ~. raftmask *."1 y.
  from    =. y. -"1 raft
  to      =. raft +"1 -. y.
  from (and&cond # ]) to
)  

search1 =: 3 : 0
  l =. (#~ ($&1 0)@#) y. 
  r =. (#~ ($&0 1)@#) y. 
  if. (255 ~: {: r) and ((-: ~.) r) and ((-: ~.) l) 
   do. ( (,"_ 0) nextstates&.((8#2)&#:) @: {: ) y.
   else. y.
  end.        
)

search =: ~.@:,@:(<"1&search1&>"0) 
solutions =:  (#~ ((255&=@:{:) *. (0:= (2:|#))) @: >"0)  
out =: #&'MGGFBBPC' @: (- [: -. 1&|.) @: #:

~. out each solutions search ^:_ <255

> такого "громадного" объёма.

# b, b - boys
# g, g - girls
# o - outlaw
#
#
# M - Mother  ! Имена перевозчиков должны быть уникальны!
# F - Father
# P - Policeman
# N - None


class State

    # @left, @right -- массивы, в которых люди
    # @raft - положение плота: false -- слева, true -- справа
    # @next_left, @next_right -- следующие положения (для генерации  
следующего состояния)
    # @first, @second -- кому надо было переплыть
    
    attr_reader :left, :right, :raft, :next_left, :next_right, :first, :second
    
    
    def initialize(prevState, first, second)
        if prevState == nil
            # начальное состояние
            @left = ['b', 'b', 'g', 'g', 'o', 'M', 'F', 'P']
            @raft = false
        else        
            @prevState = prevState
            @left = prevState.next_left
            @right = prevState.next_right
            @raft = ! prevState.raft
            @first = first
            @second = second
        end
    end

        
    def move(first, second)
    
        if @prevState != nil
            return nil if ((@first == first) && (@second == second)) ||
                          ((@first == second) && (@first == second))
        end
    
        @next_left = Array.new(@left)
        @next_right = (@right == nil) ? [] : Array.new(@right)
    
        if @raft
            from = @next_right
            to = @next_left
        else
            from = @next_left
            to = @next_right
        end        
        
        from.delete_at(from.index(first))
        from.delete_at(from.index(second)) if second != '_'        
        to << first
        to << second if second != '_'
        
        # 1. Полицейский не может оставлять преступника с людьми одного.
        return nil if from.include?('o') && (from.length > 1) && (!  
from.include?('P'))
        return nil if to.include?('o') && (to.length > 1) && (! to.include?('P'))
        
        # 2. Папа не может оставлять сыновей одних с мамой, а мать - дочерей с  
папой.
        return nil if from.include?('M') && (! from.include?('F')) &&  
from.include?('b') # Мама с брошеными сыновьями
        return nil if to.include?('M') && (! to.include?('F')) &&  
to.include?('b') # Мама с брошеными сыновьями
        return nil if from.include?('F') && (! from.include?('M')) &&  
from.include?('g') # Папа с брошеными дочерьми
        return nil if to.include?('F') && (! to.include?('M')) &&  
to.include?('g') # Папа с брошеными дочерьми
        
        # Все правила соблюдены, делаем новое состояние
        return State.new(self, first, second)
    end
    
    
    def isEnd?
        return @left.empty? # && (@right.length == 8)
    end
    
    
    def printSolve
        if @prevState != nil
            @prevState.printSolve
        end
        print "(#{@first}, #{@second})  "
    end
    
end

@@MAX_DEPTH = 18

def turn(state, depth)

    if state.isEnd?
        state.printSolve
        print "\n"
        return        
    end
    
    # puts '.' * depth
    if depth >= @@MAX_DEPTH
        #state.printSolve
        #print "\n"
        return        
    end    
    
    from = (state.raft)?(state.right):(state.left)
    
    from.each { |first|
    
        # Первым должен быть взрослый
        next if (first != 'M') && (first != 'F') && (first != 'P')
        
        # Проверить возможность переплыва одному
        if newState = state.move(first, '_')
            turn(newState, depth + 1)
        end
        
        # Проверить возиожность переплыва с кем-л.    
        from.each { |second|        
            next if (first == second) # Должен быть другой участник, а не тот же  
самый
            
            if newState = state.move(first, second)
                turn(newState, depth + 1)
            end
        }

    }
end


initialState = State.new(nil, nil, nil)
turn(initialState, 1)

'`m g1 g2 f b1 b2 p c' =: ". (, '`'&,)/ '('&, @ ,&'&{)' @ ":"0 @ i. 8

  (, '`'&,)/ '('&, @ ,&'&{)' @ ":"0 @ i. 10
(0&{)`(1&{)`(2&{)`(3&{)`(4&{)`(5&{)`(6&{)`(7&{)`(8&{)`(9&{)

LCR>Я сделаю маленькое усовершенствование, можно?

LCR>'`m g1 g2 f b1 b2 p c' =: ". (, '`'&,)/ '('&, @ ,&'&{)' @ ":"0 @ i. 8
LCR>

LCR>  (, '`'&,)/ '('&, @ ,&'&{)' @ ":"0 @ i. 10
LCR>(0&{)`(1&{)`(2&{)`(3&{)`(4&{)`(5&{)`(6&{)`(7&{)`(8&{)`(9&{)
LCR>

vars =:  (([ , '=:'"_ , ] , '&{'"_)"1 ":"0 @: i. @: #) @: > @: ;:
   vars 'm g1 g2 f b1 b2 p c'
m =:0&{
g1=:1&{
g2=:2&{
f =:3&{
b1=:4&{
b2=:5&{
p =:6&{
c =:7&{

". vars 'm g1 g2 f b1 b2 p c'
m
+-+-+-+
|0|&|{|
+-+-+-+

LCR>PS: получил определённое удовольствие пока разбирался в твоей программе