//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)