4 people like it.

Backtracking search for Constraint Satisfaction Problems

Backtracking search for Constraint Satisfaction Problems (CSP)

 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: 

//type Variable = | WA | NT | Q | NSW | V | SA | T
//type Domain = | Red | Green | Blue
//type BinaryConstraint = | NotEqualTo of left: Variable * right: Variable | NotValue of variable: Variable * value: Domain
//
//let X = [ WA; NT; Q; NSW; V; SA; T ] //is a set of variables 
//let D = [ Red; Green; Blue ] //is a set of the respective domains of Domains, and 
//let C = [ NotValue(WA, Red); NotEqualTo(WA, NT); NotEqualTo(WA, SA); NotEqualTo(NT, SA); NotEqualTo(NT, Q); NotEqualTo(SA, Q); NotEqualTo(SA, NSW); NotEqualTo(SA, V); NotEqualTo(Q, NSW); NotEqualTo(NSW, V); NotEqualTo(T, V) ] //is a set of constraints
//
//type CSP = {X: Variable list;  D: Domain list; C: BinaryConstraint list}
//let csp = {X = X; D = D; C = C}

/////////////////////////////////////////////

type Variable = | WA | NT | Q | NSW | V | SA | T
type Domain = | Red | Green | Blue
type BinaryConstraint = | NotEqualTo of left: Variable * right: Variable | NotValue of variable: Variable * value: Domain

let X = [ WA; NT; Q; NSW; V; SA; T ] //is a set of variables 
let D = [ Red; Green; Blue ] //is a set of the respective domains of Domains, and 
let C = [ NotEqualTo(WA, NT); NotEqualTo(WA, SA); NotEqualTo(NT, SA); NotEqualTo(NT, Q); NotEqualTo(SA, Q); NotEqualTo(SA, NSW); NotEqualTo(SA, V); NotEqualTo(Q, NSW); NotEqualTo(NSW, V); NotEqualTo(T, V) ] //is a set of constraints

type CSP = {X: Variable list;  D: Domain list; C: BinaryConstraint list}
let csp = {X = X; D = D; C = C}

/////////////////////////////////////////////

//type Variable = | X1 | X2 | X3
//type Domain = | Red | Green | Blue
//type BinaryConstraint = | NotEqualTo of left: Variable * right: Variable | NotValue of variable: Variable * value: Domain
//
//let X = [ X1; X2; X3 ] //is a set of variables 
//let D = [ Red; Green; Blue ] //is a set of the respective domains of Domains, and 
//let C = [ NotEqualTo(X1, X2); NotEqualTo(X1, X3); NotEqualTo(X2, X3) ] //is a set of constraints
//
//type CSP = {X: Variable list;  D: Domain list; C: BinaryConstraint list}
//let csp = {X = X; D = D; C = C}

/////////////////////////////////////////////

let combine (xs:Variable list, ds: Domain list) =
    let rec combineRec (ys:Variable list, acc: (Variable * Domain) list) =
        match ys with
        | y :: ys -> seq { for d in ds do
                           for c in combineRec(ys, List.append acc [(y, d)]) do yield c }
        | [] -> Seq.ofList [acc]
    combineRec (xs, [])

let evaluate (xs:(Variable * Domain) list seq, cs: BinaryConstraint list) =
    let notEqualTo (left, right) = left <> right
    seq{ for x in xs ->
          [for c in cs ->
            match c with
            | NotValue(variable, value) ->
                let v = x |> List.find (fun (v, _) -> v = variable) |> snd
                notEqualTo(v, value)
            | NotEqualTo(left, right) ->
                let a = x |> List.find (fun (v, _) -> v = left)  |> snd
                let b = x |> List.find (fun (v, _) -> v = right) |> snd 
                notEqualTo(a, b)] }

let depthFirst (xs: Variable list, ds: Domain list, cs: BinaryConstraint list) =
    let all xs = xs |> Seq.forall (fun x -> x)
    let rec depthFirstRec (ys:((Variable * Domain) list * bool list) seq) =
        if (Seq.isEmpty ys) then []
        else
            let y = ys |> Seq.head            
            if all(snd y) then fst y 
            else depthFirstRec(ys |> Seq.skip 1)    
    let xds = combine(xs, ds)
    depthFirstRec (Seq.zip xds (evaluate(xds, cs)))

let backtrackingSearch (csp : CSP) = depthFirst(csp.X, csp.D, csp.C)

//main
printfn "%A" (backtrackingSearch csp)
union case Variable.WA: Variable
union case Variable.NT: Variable
union case Variable.Q: Variable
union case Variable.NSW: Variable
union case Variable.V: Variable
union case Variable.SA: Variable
union case Variable.T: Variable
type Domain =
  | Red
  | Green
  | Blue

Full name: Script.Domain
union case Domain.Red: Domain
union case Domain.Green: Domain
union case Domain.Blue: Domain
type BinaryConstraint =
  | NotEqualTo of left: Variable * right: Variable
  | NotValue of variable: Variable * value: Domain

Full name: Script.BinaryConstraint
union case BinaryConstraint.NotEqualTo: left: Variable * right: Variable -> BinaryConstraint
type Variable =
  | WA
  | NT
  | Q
  | NSW
  | V
  | SA
  | T

Full name: Script.Variable
union case BinaryConstraint.NotValue: variable: Variable * value: Domain -> BinaryConstraint
val X : Variable list

Full name: Script.X
val D : Domain list

Full name: Script.D
val C : BinaryConstraint list

Full name: Script.C
type CSP =
  {X: Variable list;
   D: Domain list;
   C: BinaryConstraint list;}

Full name: Script.CSP
CSP.X: Variable list
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
CSP.D: Domain list
CSP.C: BinaryConstraint list
val csp : CSP

Full name: Script.csp
val combine : xs:Variable list * ds:Domain list -> seq<(Variable * Domain) list>

Full name: Script.combine
val xs : Variable list
val ds : Domain list
val combineRec : (Variable list * (Variable * Domain) list -> seq<(Variable * Domain) list>)
val ys : Variable list
val acc : (Variable * Domain) list
val y : Variable
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

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

--------------------
type seq<'T> = System.Collections.Generic.IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
val d : Domain
val c : (Variable * Domain) 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
module Seq

from Microsoft.FSharp.Collections
val ofList : source:'T list -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.ofList
val evaluate : xs:seq<(Variable * Domain) list> * cs:BinaryConstraint list -> seq<bool list>

Full name: Script.evaluate
val xs : seq<(Variable * Domain) list>
val cs : BinaryConstraint list
val notEqualTo : ('a * 'a -> bool) (requires equality)
val left : 'a (requires equality)
val right : 'a (requires equality)
val x : (Variable * Domain) list
val c : BinaryConstraint
val variable : Variable
val value : Domain
val v : Domain
val find : predicate:('T -> bool) -> list:'T list -> 'T

Full name: Microsoft.FSharp.Collections.List.find
val v : Variable
val snd : tuple:('T1 * 'T2) -> 'T2

Full name: Microsoft.FSharp.Core.Operators.snd
val left : Variable
val right : Variable
val a : Domain
val b : Domain
val depthFirst : xs:Variable list * ds:Domain list * cs:BinaryConstraint list -> (Variable * Domain) list

Full name: Script.depthFirst
val all : (seq<bool> -> bool)
val xs : seq<bool>
val forall : predicate:('T -> bool) -> source:seq<'T> -> bool

Full name: Microsoft.FSharp.Collections.Seq.forall
val x : bool
val depthFirstRec : (seq<(Variable * Domain) list * bool list> -> (Variable * Domain) list)
val ys : seq<(Variable * Domain) list * bool list>
type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool
val isEmpty : source:seq<'T> -> bool

Full name: Microsoft.FSharp.Collections.Seq.isEmpty
val y : (Variable * Domain) list * bool list
val head : source:seq<'T> -> 'T

Full name: Microsoft.FSharp.Collections.Seq.head
val fst : tuple:('T1 * 'T2) -> 'T1

Full name: Microsoft.FSharp.Core.Operators.fst
val skip : count:int -> source:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Collections.Seq.skip
val xds : seq<(Variable * Domain) list>
val zip : source1:seq<'T1> -> source2:seq<'T2> -> seq<'T1 * 'T2>

Full name: Microsoft.FSharp.Collections.Seq.zip
val backtrackingSearch : csp:CSP -> (Variable * Domain) list

Full name: Script.backtrackingSearch
val csp : CSP
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
Raw view Test code New version

More information

Link:http://fssnip.net/nL
Posted:10 years ago
Author:Fabio Galuppo
Tags: ai , search , csp

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.