13 people like it.

Missionaries and Cannibals Problem and its state space tree

Generating a state space tree to the Missionaries and Cannibals Problem (http://en.wikipedia.org/wiki/Missionaries_and_cannibals_problem). Then, this tree is iterated with depth-first approach, printing all the visitations. The solutions to problem have a depth equals 9.

  1: 
  2: 
  3: 
  4: 
  5: 
  6: 
  7: 
  8: 
  9: 
 10: 
 11: 
 12: 
 13: 
 14: 
 15: 
 16: 
 17: 
 18: 
 19: 
 20: 
 21: 
 22: 
 23: 
 24: 
 25: 
 26: 
 27: 
 28: 
 29: 
 30: 
 31: 
 32: 
 33: 
 34: 
 35: 
 36: 
 37: 
 38: 
 39: 
 40: 
 41: 
 42: 
 43: 
 44: 
 45: 
 46: 
 47: 
 48: 
 49: 
 50: 
 51: 
 52: 
 53: 
 54: 
 55: 
 56: 
 57: 
 58: 
 59: 
 60: 
 61: 
 62: 
 63: 
 64: 
 65: 
 66: 
 67: 
 68: 
 69: 
 70: 
 71: 
 72: 
 73: 
 74: 
 75: 
 76: 
 77: 
 78: 
 79: 
 80: 
 81: 
 82: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 
104: 
105: 
106: 
107: 
108: 
109: 
110: 
111: 
112: 
113: 
114: 
115: 
116: 
117: 
118: 
119: 
120: 
121: 
122: 
123: 
124: 
125: 
126: 

//state
type person = | M of int | C of int
type state = {top : Set<person>; bottom : Set<person>; isValid : bool} 

let initialState = {top = Set.ofList [C 1; C 2; C 3; M 1; M 2; M 3]; bottom = Set.ofList []; isValid = true}

let goalState = {top = Set.ofList []; bottom = Set.ofList [C 1; C 2; C 3; M 1; M 2; M 3]; isValid = true}

//functions to problem solving
let isValid (xs:Set<person>) =
    let (c, m) = xs |> Set.fold (fun acc s ->
                                    let (c, m) = acc
                                    match s with
                                    | M _ -> (c, m + 1)
                                    | C _ -> (c + 1, m)) (0, 0)
    m = 0 || m >= c

let moveDown (s:state) =
    let rec moveDownRec (t:Set<person>, b:Set<person>, xs:person list) =
        match xs with
        | x :: ys -> 
            List.append [for y in ys -> 
                            let bottom = Set.union b (Set.ofList [x; y])
                            let top = Set.difference t bottom
                            let isValid = isValid(top) && isValid(bottom)
                            {top = top; bottom = bottom; isValid = isValid}] (moveDownRec (t, b, ys))
        | _ -> []    
    moveDownRec (s.top, s.bottom, (Set.toList s.top))

let moveUp (s:state) =
    [for x in s.bottom -> 
        let xs = Set.ofList [x]
        let bottom = Set.difference s.bottom xs
        let top = Set.union s.top xs
        let isValid = isValid(bottom)
        {top = top; bottom = bottom; isValid = isValid}]

//state space tree
type Node<'a> = {value : 'a; mutable children : Node<'a> list}

let makeNode (s) = {value = s; children = []}

let makeTree (state) = 
    let rec makeTreeRec (n:Node<state>, isDown) : Node<state> =
        let x = n.value
        let ss = if isDown then (moveDown x) else (moveUp x)        
        if List.length ss > 1 then
            let children = ss |> List.map (fun s -> makeNode s)
            let isUp = not isDown            
            for child in children do makeTreeRec (child, isUp) |> ignore
            n.children <- children
        n
    makeTreeRec (makeNode state, true)

//explore state space tree using depth-first search
let dfs (node:Node<state>) =
    let c = ref 1
    let display (xs:int list, ys:state list, depth:int) = 
        let toString (s:state) =
            let p (x:person) =
                match x with
                | M i -> sprintf "M%d" i
                | C i -> sprintf "C%d" i        
            let sb = new System.Text.StringBuilder()
            sb.Append("{") |> ignore
            for x in s.top do sb.Append(p x).Append(" ") |> ignore
            sb.Append("|~~| ") |> ignore
            for x in s.bottom do sb.Append(p x).Append(" ") |> ignore
            sb.Remove(sb.Length - 1, 1) |> ignore
            //sb.Append(" -> ").Append(s.isValid).Append("}") |> ignore
            //or (*)
            sb.Append("}") |> ignore
            sb.ToString()
        let zs = List.zip xs ys |> Array.ofList
        printfn "-----------------------------------------"
        printfn "{depth = %d} %d" depth !c
        c := !c + 1
        printfn "%2d:%s initial" (fst zs.[0]) (toString(snd zs.[0]))
        let mutable isDown = true
        for i = 1 to depth do 
            printfn "%2d:%s %s" (fst zs.[i]) (toString(snd zs.[i])) (if isDown then "down" else "up")
            isDown <- not isDown

    let rec dfsRec (node:Node<state>, xs:int list, ys:state list, isDown:bool, depth:int) =
        if not (List.isEmpty node.children) then
            let mutable i = 0
            let isUp = not isDown
            for child in node.children do
                //dfsRec(child, List.append xs [i], List.append ys [child.value], isUp, depth + 1)
                //or (*)
                if (child.value.isValid) then                
                    dfsRec(child, List.append xs [i], List.append ys [child.value], isUp, depth + 1)
                else
                    display (List.append xs [i], List.append ys [child.value], depth + 1)
                i <- i + 1
        else
            display (List.append xs [0], List.append ys [goalState], depth + 1)

    dfsRec (node, [0], [node.value], true, 0)

//main
let root = makeTree initialState
dfs root

(* who is/are in the boat?
   pseudo code:
   if down then boat = Set.intersection current.bottom previous.top
   else 
   if up then boat = Set.intersection current.top previous.bottom *)

(* Sample result:
   ...
   -----------------------------------------
   {depth = 9} 6263
    0:{M1 M2 M3 C1 C2 C3 |~~|} initial
   10:{M1 M2 C1 C3 |~~| M3 C2} down
    0:{M1 M2 M3 C1 C3 |~~| C2} up
    9:{M1 M2 M3 |~~| C1 C2 C3} down
    0:{M1 M2 M3 C1 |~~| C2 C3} up
    0:{M3 C1 |~~| M1 M2 C2 C3} down
    3:{M3 C1 C3 |~~| M1 M2 C2} up
    0:{C3 |~~| M1 M2 M3 C1 C2} down
    0:{M1 C3 |~~| M2 M3 C1 C2} up
    0:{|~~| M1 M2 M3 C1 C2 C3} down
   -----------------------------------------
   ... *)
union case person.M: int -> person
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
union case person.C: int -> person
type state =
  {top: Set<person>;
   bottom: Set<person>;
   isValid: bool;}

Full name: Script.state
state.top: Set<person>
Multiple items
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  member IsProperSupersetOf : otherSet:Set<'T> -> bool
  ...

Full name: Microsoft.FSharp.Collections.Set<_>

--------------------
new : elements:seq<'T> -> Set<'T>
type person =
  | M of int
  | C of int

Full name: Script.person
state.bottom: Set<person>
state.isValid: bool
type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool
val initialState : state

Full name: Script.initialState
val ofList : elements:'T list -> Set<'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Set.ofList
val goalState : state

Full name: Script.goalState
val isValid : xs:Set<person> -> bool

Full name: Script.isValid
val xs : Set<person>
val c : int
val m : int
val fold : folder:('State -> 'T -> 'State) -> state:'State -> set:Set<'T> -> 'State (requires comparison)

Full name: Microsoft.FSharp.Collections.Set.fold
val acc : int * int
val s : person
val moveDown : s:state -> state list

Full name: Script.moveDown
val s : state
val moveDownRec : (Set<person> * Set<person> * person list -> state list)
val t : Set<person>
val b : Set<person>
val xs : person list
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val x : person
val ys : person list
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val append : list1:'T list -> list2:'T list -> 'T list

Full name: Microsoft.FSharp.Collections.List.append
val y : person
val bottom : Set<person>
val union : set1:Set<'T> -> set2:Set<'T> -> Set<'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Set.union
val top : Set<person>
val difference : set1:Set<'T> -> set2:Set<'T> -> Set<'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Set.difference
val isValid : bool
val toList : set:Set<'T> -> 'T list (requires comparison)

Full name: Microsoft.FSharp.Collections.Set.toList
val moveUp : s:state -> state list

Full name: Script.moveUp
type Node<'a> =
  {value: 'a;
   mutable children: Node<'a> list;}

Full name: Script.Node<_>
Node.value: 'a
Node.children: Node<'a> list
val makeNode : s:'a -> Node<'a>

Full name: Script.makeNode
val s : 'a
val makeTree : state:state -> Node<state>

Full name: Script.makeTree
Multiple items
val state : state

--------------------
type state =
  {top: Set<person>;
   bottom: Set<person>;
   isValid: bool;}

Full name: Script.state
val makeTreeRec : (Node<state> * bool -> Node<state>)
val n : Node<state>
val isDown : bool
val x : state
Node.value: state
val ss : state list
val length : list:'T list -> int

Full name: Microsoft.FSharp.Collections.List.length
val children : Node<state> list
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
val isUp : bool
val not : value:bool -> bool

Full name: Microsoft.FSharp.Core.Operators.not
val child : Node<state>
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
Node.children: Node<state> list
val dfs : node:Node<state> -> unit

Full name: Script.dfs
val node : Node<state>
val c : int ref
Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
val display : (int list * state list * int -> unit)
val xs : int list
val ys : state list
val depth : int
val toString : (state -> string)
val p : (person -> string)
val i : int
val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf
val sb : System.Text.StringBuilder
namespace System
namespace System.Text
Multiple items
type StringBuilder =
  new : unit -> StringBuilder + 5 overloads
  member Append : value:string -> StringBuilder + 18 overloads
  member AppendFormat : format:string * arg0:obj -> StringBuilder + 4 overloads
  member AppendLine : unit -> StringBuilder + 1 overload
  member Capacity : int with get, set
  member Chars : int -> char with get, set
  member Clear : unit -> StringBuilder
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EnsureCapacity : capacity:int -> int
  member Equals : sb:StringBuilder -> bool
  ...

Full name: System.Text.StringBuilder

--------------------
System.Text.StringBuilder() : unit
System.Text.StringBuilder(capacity: int) : unit
System.Text.StringBuilder(value: string) : unit
System.Text.StringBuilder(value: string, capacity: int) : unit
System.Text.StringBuilder(capacity: int, maxCapacity: int) : unit
System.Text.StringBuilder(value: string, startIndex: int, length: int, capacity: int) : unit
System.Text.StringBuilder.Append(value: char []) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: obj) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: uint64) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: uint32) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: uint16) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: decimal) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: float) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: float32) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: int64) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Append(value: int) : System.Text.StringBuilder
   (+0 other overloads)
System.Text.StringBuilder.Remove(startIndex: int, length: int) : System.Text.StringBuilder
property System.Text.StringBuilder.Length: int
System.Text.StringBuilder.ToString() : string
System.Text.StringBuilder.ToString(startIndex: int, length: int) : string
val zs : (int * state) []
val zip : list1:'T1 list -> list2:'T2 list -> ('T1 * 'T2) list

Full name: Microsoft.FSharp.Collections.List.zip
module Array

from Microsoft.FSharp.Collections
val ofList : list:'T list -> 'T []

Full name: Microsoft.FSharp.Collections.Array.ofList
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val fst : tuple:('T1 * 'T2) -> 'T1

Full name: Microsoft.FSharp.Core.Operators.fst
val snd : tuple:('T1 * 'T2) -> 'T2

Full name: Microsoft.FSharp.Core.Operators.snd
val mutable isDown : bool
val dfsRec : (Node<state> * int list * state list * bool * int -> unit)
val isEmpty : list:'T list -> bool

Full name: Microsoft.FSharp.Collections.List.isEmpty
val mutable i : int
val root : Node<state>

Full name: Script.root
Raw view Test code New version

More information

Link:http://fssnip.net/mA
Posted:9 years ago
Author:Fabio Galuppo
Tags: puzzle , puzzles , ai

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.