Wolf, Goat, Cabbage problem in Elm

River.elm

module River exposing (..)


type Character
    = Wolf
    | Goat
    | Cabbage


type State
    = STL (List Character) (List Character)
    | STR (List Character) (List Character)


type Path
    = P State (List State)


startState : State
startState =
    STL [ Wolf, Goat, Cabbage ] []


success : State -> Bool
success st =
    compareState (STR [] [ Wolf, Goat, Cabbage ]) st == EQ


solutions : List (List State)
solutions =
    validMoves [] (P startState [])
        |> List.map (\(P c ps) -> c :: ps |> List.reverse)


validMoves : List State -> Path -> List Path
validMoves visited ((P curr path) as p) =
    if success curr then
        [ p ]
    else
        curr
            |> allPossibleNextMoves
            |> List.filter (isValidMove visited)
            |> List.map (\st -> P st <| curr :: path)
            |> List.concatMap (validMoves <| curr :: visited)


allPossibleNextMoves : State -> List State
allPossibleNextMoves curr =
    case curr of
        STL lb rb ->
            lb
                |> List.map (\p -> STR (remove p lb) (p :: rb))
                |> (::) (STR lb rb)

        STR lb rb ->
            rb
                |> List.map (\p -> STL (p :: lb) (remove p rb))
                |> (::) (STL lb rb)


isValidMove : List State -> State -> Bool
isValidMove visited st =
    not (alreadyVisited visited st) && not (isIllegal st)


isIllegal : State -> Bool
isIllegal st =
    let
        tester set =
            (List.member Wolf set && List.member Goat set)
                || (List.member Goat set && List.member Cabbage set)
    in
        case st of
            STL _ rb ->
                tester rb

            STR lb _ ->
                tester lb


alreadyVisited : List State -> State -> Bool
alreadyVisited xs x =
    List.any (\y -> compareState x y == EQ) xs


compareState : State -> State -> Order
compareState st1 st2 =
    let
        stringify =
            List.map toString >> List.sort
    in
        case ( st1, st2 ) of
            ( STL lb1 _, STL lb2 _ ) ->
                compare (stringify lb1) (stringify lb2)

            ( STR lb1 _, STR lb2 _ ) ->
                compare (stringify lb1) (stringify lb2)

            _ ->
                GT


remove : a -> List a -> List a
remove c lst =
    List.filter ((/=) c) lst