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; bottom : Set; 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) = 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, b:Set, 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, isDown) : Node = 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) = 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, 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 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
System.Text.StringBuilder.Append(value: obj) : System.Text.StringBuilder
System.Text.StringBuilder.Append(value: uint64) : System.Text.StringBuilder
System.Text.StringBuilder.Append(value: uint32) : System.Text.StringBuilder
System.Text.StringBuilder.Append(value: uint16) : System.Text.StringBuilder
System.Text.StringBuilder.Append(value: decimal) : System.Text.StringBuilder
System.Text.StringBuilder.Append(value: float) : System.Text.StringBuilder
System.Text.StringBuilder.Append(value: float32) : System.Text.StringBuilder
System.Text.StringBuilder.Append(value: int64) : System.Text.StringBuilder
System.Text.StringBuilder.Append(value: int) : System.Text.StringBuilder
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