From 7efa72b4436d833f16ff6163227d0a2ed7c05ef2 Mon Sep 17 00:00:00 2001 From: Fernando Correa de Oliveira Date: Thu, 31 Aug 2017 00:55:29 -0300 Subject: [PATCH 1/6] rewriting --- lib/ProblemSolver.pm6 | 135 +++++++++++------------------------------- 1 file changed, 35 insertions(+), 100 deletions(-) diff --git a/lib/ProblemSolver.pm6 b/lib/ProblemSolver.pm6 index 4a6d657..fc73aff 100644 --- a/lib/ProblemSolver.pm6 +++ b/lib/ProblemSolver.pm6 @@ -1,118 +1,53 @@ -use ProblemSolver::State; unit class ProblemSolver; -has Bool $.stop-on-first-solution = False; -has Bool $!found-solution = False; -has Array of Callable %!constraints{Signature}; -has $!variables handles = ProblemSolver::State.new; -#has ProblemSolver::State $!variables handles .= new; -has &.print-found is rw; -has Array of Callable %!heuristics; +has %.variables; +has Bag $.vars .= new; +has %.constraints{Set}; +has %.heuristics{Str}; +has %.found; -method add-constraint(&const) { - %!constraints{&const.signature}.push: &const +multi method create-variable(Str $name where { not %!variables{$_}:exists }, Bag() \values) { + $!vars = |$!vars (+) Pair.new: $name, 1; + %!variables = |%!variables, $name => values; } -method add-heuristic($var, &heu) { - %!heuristics{$var}.push: &heu +multi method create-variable(Bag $names where { %!variables{$_.none}:exists }, Bag() \values) { + $!vars = $!vars (+) $names; + %!variables = |%!variables, |do for $names.keys -> $name { $name => values } } -method solve { - for $!variables.found-vars -> $key { - self!remove-values($!variables, :variable($key), :value($!variables.get($key))) if %!heuristics{$key}:exists; - } - self!solve-all($!variables) -} - -method !solve-all($todo) { - do if $todo.found-everything { - my %tmp = $todo.found-hash; - do if self!run-constraints(%tmp, :debug) { - $!found-solution = True; - %tmp - } - } else { - my @resp; - my $key = $todo.next-var; - for $todo.iterate-over($key) -> $new { - next unless self!run-constraints($new.found-hash) or $new.has-empty-vars; - self!remove-values($new, :variable($key), :value($new.get($key))) if %!heuristics{$key}:exists; - &!print-found($new.found-hash) if &!print-found; - @resp.push: self!solve-all($new); - last if $!stop-on-first-solution and $!found-solution - } - |@resp - } +method add-constraint(Set() \vars where {%!variables{vars.keys.all}:exists}, &constraint) { + %!constraints{vars}.push: &constraint } -method !remove-values($todo, Str :$variable, :$value) { - if %!heuristics{$variable}:exists { - for @( %!heuristics{$variable} ) -> &func { - func($todo, $value) - } - } +method add-heuristic(Set() \vars where {%!variables{vars.keys.all}:exists}, &heuristic) { + %!heuristics{$_}.push: &heuristic for vars.keys } -method !run-constraints(%values, :$debug) { - my @cons = self!get-constraints-for-vars(%values); - for @cons -> &func { - return False if not func(|%values) - } - True +multi method remove-possibility(Str \name where {%!variables{name}:exists}, \value) { + %!variables{name} = %!variables{name} (-) bag(value xx %!variables{name}{value}); + fail if %!variables{name}.elems == 0; + %!variables{name} = %!variables{name}.keys[0] if %!variables{name}.elems == 1; } -method !get-constraints-for-vars(%vars) { - my @keys = %!constraints.keys.grep: -> \sig { %vars ~~ sig } - |%!constraints{@keys}.map: |* +method variable-bag { + %!variables.keys.map(-> Str \var { + slip var xx (($!vars{var} * %!constraints.pairs.grep(var ∈ *.key).map(*.value.elems).sum) || 1) + }).Bag } -method constraint-vars(&red, @vars) { - my $pars = &red.signature.params.elems; - my @comb = @vars.combinations($pars); - for @comb -> @pars { - my $sig = @pars.map({":\${$_}!"}).join(", "); - my $cal = @pars.map({"\${$_}"}).join(", "); - use MONKEY-SEE-NO-EVAL; - my &func = EVAL "-> $sig, | \{ red($cal)\}"; - no MONKEY-SEE-NO-EVAL; - $.add-constraint(&func) - } - for @vars -> $var { - my @v = @vars.grep(* !eq $var); - $.add-heuristic($var, -> $todo, $value { - for @v (&) $todo.not-found-vars -> $var { - $todo.find-and-remove-from: $var.key, -> $v { not red($v, $value) } - } - }) - } +method variable-order { + |$.variable-bag.pairs.sort({-.value}).map: {.key} } -method unique-vars(@vars) { - my @comb = @vars.combinations(2); - for @comb -> @pars { - my $sig = @pars.map({":\${$_}!"}).join(", "); - my $cal = @pars.map({"\${$_}"}).join(", "); - use MONKEY-SEE-NO-EVAL; - my &func = EVAL "-> $sig, | \{ [!~~] $cal \}"; - no MONKEY-SEE-NO-EVAL; - $.add-constraint(&func) - } - for @vars -> $var { - my @v = @vars.grep(* !eq $var); - $.add-heuristic($var, -> $todo, $value { - for @v (&) $todo.not-found-vars -> $var { - $todo.remove-from: $var.key, $value - } - }) - } -} - -method no-order-vars(+@vars) { - for @vars -> $var { - my @v = @vars.grep(* !eq $var); - $.add-heuristic($var, -> $todo, $value { - $todo.recursive-remove-from-vars: @v, $value - }) - } +method solve { + # TODO: Run constraints + # TODO: Run heuristics + for $.variable-order -> $var { + for |%!variables{$var}.pairs.sort(-*.value).map: *.key -> $value { + my %variables = |%!variables, $var => $value; + my $clone = self.clone: :variables(%variables), :vars($!vars (-) bag($var xx $!vars{$var})); + note $clone + } + } } - From 1d58a8356efe3989ecf8d8638ab10493aa93c4b1 Mon Sep 17 00:00:00 2001 From: Fernando Correa de Oliveira Date: Thu, 31 Aug 2017 23:55:51 -0300 Subject: [PATCH 2/6] gather --- lib/ProblemSolver.pm6 | 39 +++++++++++++++++++++++++++------------ 1 file changed, 27 insertions(+), 12 deletions(-) diff --git a/lib/ProblemSolver.pm6 b/lib/ProblemSolver.pm6 index fc73aff..7288708 100644 --- a/lib/ProblemSolver.pm6 +++ b/lib/ProblemSolver.pm6 @@ -1,10 +1,11 @@ unit class ProblemSolver; -has %.variables; -has Bag $.vars .= new; -has %.constraints{Set}; -has %.heuristics{Str}; -has %.found; +has %.variables; +has Bag $.vars .= new; +has %.constraints{Set}; +has %.heuristics{Str}; +has %.found; +has Bool $!complete = False; multi method create-variable(Str $name where { not %!variables{$_}:exists }, Bag() \values) { $!vars = |$!vars (+) Pair.new: $name, 1; @@ -24,16 +25,24 @@ method add-heuristic(Set() \vars where {%!variables{vars.keys.all}:exists}, &heu %!heuristics{$_}.push: &heuristic for vars.keys } +role Found {} multi method remove-possibility(Str \name where {%!variables{name}:exists}, \value) { %!variables{name} = %!variables{name} (-) bag(value xx %!variables{name}{value}); - fail if %!variables{name}.elems == 0; - %!variables{name} = %!variables{name}.keys[0] if %!variables{name}.elems == 1; + die "No options" if %!variables{name}.elems == 0; + if %!variables{name}.elems == 1 { + %!variables{name} = %!variables{name}.keys.head but Found; + } } method variable-bag { - %!variables.keys.map(-> Str \var { - slip var xx (($!vars{var} * %!constraints.pairs.grep(var ∈ *.key).map(*.value.elems).sum) || 1) - }).Bag + %!variables.keys + .grep(-> Str \key { + %!variables{key} !~~ Found + }) + .map(-> Str \var { + slip var xx (($!vars{var} * %!constraints.pairs.grep(var ∈ *.key).map(*.value.elems).sum) || 1) + }) + .Bag } method variable-order { @@ -41,13 +50,19 @@ method variable-order { } method solve { + lazy gather $.run-tests; +} + +method run-tests { + $!complete = %!variables.values.all ~~ Found; # TODO: Run constraints + take %!variables if $!complete; # TODO: Run heuristics for $.variable-order -> $var { for |%!variables{$var}.pairs.sort(-*.value).map: *.key -> $value { - my %variables = |%!variables, $var => $value; + my %variables = |%!variables, $var => $value but Found; my $clone = self.clone: :variables(%variables), :vars($!vars (-) bag($var xx $!vars{$var})); - note $clone + $clone.run-tests } } } From 5aadfbdad67d793b77f6ab93f10c93ce33f4a7d1 Mon Sep 17 00:00:00 2001 From: Fernando Correa de Oliveira Date: Sat, 2 Sep 2017 00:36:42 -0300 Subject: [PATCH 3/6] Getting better --- colorize-map.p6 | 4 +- decript.p6 | 11 ++++++ lib/ProblemSolver.pm6 | 88 ++++++++++++++++++++++++++++++++----------- n-queens.p6 | 4 +- 4 files changed, 78 insertions(+), 29 deletions(-) create mode 100644 decript.p6 diff --git a/colorize-map.p6 b/colorize-map.p6 index 1bd53de..b35e507 100644 --- a/colorize-map.p6 +++ b/colorize-map.p6 @@ -21,9 +21,7 @@ my @states = < sergipe tocantins >; -for @states -> $state { - $problem.add-variable: $state, @colors; -} +$problem.create-variable: @states, @colors; $problem.unique-vars: ; $problem.unique-vars: ; diff --git a/decript.p6 b/decript.p6 new file mode 100644 index 0000000..1ff1114 --- /dev/null +++ b/decript.p6 @@ -0,0 +1,11 @@ +use ProblemSolver; +my ProblemSolver $problem .= new; + +$problem.create-variable: "a", ^100; +$problem.create-variable: "b", ^100; + +$problem.add-constraint: , -> %vars {%vars * 3 == %vars + 14}; +$problem.add-constraint: , -> %vars {%vars * 2 == %vars}; + +#$problem.print-found = &say; +say $problem.solve.head diff --git a/lib/ProblemSolver.pm6 b/lib/ProblemSolver.pm6 index 7288708..65bac80 100644 --- a/lib/ProblemSolver.pm6 +++ b/lib/ProblemSolver.pm6 @@ -3,66 +3,108 @@ unit class ProblemSolver; has %.variables; has Bag $.vars .= new; has %.constraints{Set}; -has %.heuristics{Str}; +has %.heuristics{Set}; has %.found; -has Bool $!complete = False; +has &.print-found is rw; multi method create-variable(Str $name where { not %!variables{$_}:exists }, Bag() \values) { - $!vars = |$!vars (+) Pair.new: $name, 1; + $!vars = |$!vars ⊎ Pair.new: $name, 1; %!variables = |%!variables, $name => values; } -multi method create-variable(Bag $names where { %!variables{$_.none}:exists }, Bag() \values) { - $!vars = $!vars (+) $names; +multi method create-variable(Bag() $names where { %!variables{$_.none}:exists }, Bag() \values) { + $!vars = $!vars ⊎ $names; %!variables = |%!variables, |do for $names.keys -> $name { $name => values } } -method add-constraint(Set() \vars where {%!variables{vars.keys.all}:exists}, &constraint) { +method add-constraint(Set() \vars where {%!variables{.keys.all}:exists}, &constraint) { %!constraints{vars}.push: &constraint } -method add-heuristic(Set() \vars where {%!variables{vars.keys.all}:exists}, &heuristic) { - %!heuristics{$_}.push: &heuristic for vars.keys +method add-heuristic( + Set() \consts where {%!variables{.keys.all}:exists}, + Set() $to-rem where {%!variables{.keys.all}:exists}, + &heuristic +) { + %!heuristics{consts}.push: {code => &heuristic, :$to-rem} } role Found {} +multi method remove-possibility(Str \name where {%!variables{name}:exists}, Set \value) { + for value.keys -> \v { + $.remove-possibility(name, v) + } +} + multi method remove-possibility(Str \name where {%!variables{name}:exists}, \value) { - %!variables{name} = %!variables{name} (-) bag(value xx %!variables{name}{value}); + %!variables{name} = %!variables{name} ∖ bag(value xx %!variables{name}{value}); die "No options" if %!variables{name}.elems == 0; if %!variables{name}.elems == 1 { %!variables{name} = %!variables{name}.keys.head but Found; } } +method constants { + %!variables.pairs.grep({ .value ~~ Found }).Map +} + method variable-bag { %!variables.keys .grep(-> Str \key { %!variables{key} !~~ Found }) .map(-> Str \var { - slip var xx (($!vars{var} * %!constraints.pairs.grep(var ∈ *.key).map(*.value.elems).sum) || 1) + my Int $in-constraints = %!constraints.pairs.grep(var ∈ *.key).map(*.value.elems).sum; + my Int $in-heuristics = %!heuristics.pairs.grep(var ∈ *.key).map(*.value.elems).sum; + slip var xx ($!vars{var} * ($in-constraints + 1) * ($in-heuristics + 1)) }) .Bag } -method variable-order { - |$.variable-bag.pairs.sort({-.value}).map: {.key} +method get-constraints { + |%!constraints.pairs.grep(*.key ⊆ $.constants.keys.Set).map: |*.value +} + +method run-heuristcs { + # TODO: implement heuristics + for |%!heuristics.pairs.grep(*.key ⊆ $.constants.keys.Set).kv -> %from, (:&code, :%to-rem) { + code(%from.keys) + } +} + +method next-variable { + $.variable-bag.pairs.max({.value}).key } method solve { lazy gather $.run-tests; } +sub merge-used(%a1, %a2) { + (|%a1.keys, |%a2.keys).unique.map(-> Str $key { + $key => (%a1{$key} // {}) ∪ (%a2{$key} // {}) + }).Map +} + method run-tests { - $!complete = %!variables.values.all ~~ Found; - # TODO: Run constraints - take %!variables if $!complete; - # TODO: Run heuristics - for $.variable-order -> $var { - for |%!variables{$var}.pairs.sort(-*.value).map: *.key -> $value { - my %variables = |%!variables, $var => $value but Found; - my $clone = self.clone: :variables(%variables), :vars($!vars (-) bag($var xx $!vars{$var})); - $clone.run-tests - } - } + my Set %tested = $.constants.kv.map: -> $key, $value {$key => set($value)}; + my %consts = $.constants; + for $.get-constraints -> &constraint { + return %tested unless constraint(%consts) + } + $_.(%consts) with &!print-found; + if %.variable-bag.elems { + my Str $var = $.next-variable; + $.run-heuristcs; + for |%!variables{$var}.pairs.sort(-*.value).map: *.key -> $value { + my %variables = |%!variables, $var => $value but Found; + my $clone = self.clone: :variables(%variables), :vars($!vars ∖ bag($var xx $!vars{$var})); + my %returned = $clone.run-tests; + %tested = merge-used %tested, %returned + # TODO: remove the unordered var values + } + } else { + take %consts; + } + %tested } diff --git a/n-queens.p6 b/n-queens.p6 index 8a87508..696156f 100644 --- a/n-queens.p6 +++ b/n-queens.p6 @@ -41,9 +41,7 @@ sub MAIN(Int $n = 4) { my @board = (^$n X ^$n).map(-> ($x, $y) {Point.new: :$x, :$y}); my @vars = (1 .. $n).map: {"Q$_"}; - for @vars -> $var { - $problem.add-variable: $var, @board; - } + $problem.create-variable: @vars, @board; #$problem.no-order-vars: @vars; $problem.unique-vars: @vars; From b5cc4b835234bd438dc9fae3bba3a9fcf63b5668 Mon Sep 17 00:00:00 2001 From: Fernando Correa de Oliveira Date: Sat, 2 Sep 2017 00:38:09 -0300 Subject: [PATCH 4/6] Using set on decript's create var --- decript.p6 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/decript.p6 b/decript.p6 index 1ff1114..cccb675 100644 --- a/decript.p6 +++ b/decript.p6 @@ -1,8 +1,7 @@ use ProblemSolver; my ProblemSolver $problem .= new; -$problem.create-variable: "a", ^100; -$problem.create-variable: "b", ^100; +$problem.create-variable: , ^100; $problem.add-constraint: , -> %vars {%vars * 3 == %vars + 14}; $problem.add-constraint: , -> %vars {%vars * 2 == %vars}; From f851ab606cc27af21f76d02f7e2f02072046620c Mon Sep 17 00:00:00 2001 From: Fernando Correa de Oliveira Date: Sat, 2 Sep 2017 14:07:39 -0300 Subject: [PATCH 5/6] Push --- lib/ProblemSolver.pm6 | 37 +++++++++++++++++++++++++++++++------ 1 file changed, 31 insertions(+), 6 deletions(-) diff --git a/lib/ProblemSolver.pm6 b/lib/ProblemSolver.pm6 index 65bac80..fc8f25d 100644 --- a/lib/ProblemSolver.pm6 +++ b/lib/ProblemSolver.pm6 @@ -3,7 +3,7 @@ unit class ProblemSolver; has %.variables; has Bag $.vars .= new; has %.constraints{Set}; -has %.heuristics{Set}; +has %.heuristics{Str}; has %.found; has &.print-found is rw; @@ -21,12 +21,37 @@ method add-constraint(Set() \vars where {%!variables{.keys.all}:exists}, &constr %!constraints{vars}.push: &constraint } -method add-heuristic( +multi method add-heuristic( + Str() \consts where {%!variables{$_}:exists}, + Str() \to-rem where {%!variables{$_}:exists}, + &heuristic +) { + %!heuristics{consts}{to-rem}.push: &heuristic; + %!heuristics{to-rem}{consts}.push: -> $a, $b { heuristic $b, $a } +} + +multi method add-heuristic( + Set() \consts where {%!variables{$_}:exists}, + Str() \to-rem where {%!variables{.keys.all}:exists}, + &heuristic +) { + $.add-heuristic($_, to-rem, &heuristic) for consts.keys +} + +multi method add-heuristic( + Str() \const where {%!variables{$_}:exists}, + Set() \to-rem where {%!variables{.keys.all}:exists}, + &heuristic +) { + $.add-heuristic(const, $_, &heuristic) for to-rem.keys +} + +multi method add-heuristic( Set() \consts where {%!variables{.keys.all}:exists}, - Set() $to-rem where {%!variables{.keys.all}:exists}, + Set() \to-rem where {%!variables{.keys.all}:exists}, &heuristic ) { - %!heuristics{consts}.push: {code => &heuristic, :$to-rem} + $.add-heuristic(consts, $_, &heuristic) for to-rem.keys } role Found {} @@ -67,8 +92,8 @@ method get-constraints { method run-heuristcs { # TODO: implement heuristics - for |%!heuristics.pairs.grep(*.key ⊆ $.constants.keys.Set).kv -> %from, (:&code, :%to-rem) { - code(%from.keys) + for |%!heuristics.pairs.grep(* ∈ $.constants.keys.Set).kv -> $key, %to-rem { + # TODO!!! } } From 01f90d1395f39fc0df5add9e11fc3c53d56f71f3 Mon Sep 17 00:00:00 2001 From: Fernando Correa de Oliveira Date: Mon, 4 Sep 2017 00:33:38 -0300 Subject: [PATCH 6/6] WiP --- decript.p6 | 5 +- lib/ProblemSolver.pm6 | 140 +++++++++++++++++++++++++----------------- n-queens.p6 | 16 +++-- 3 files changed, 95 insertions(+), 66 deletions(-) diff --git a/decript.p6 b/decript.p6 index cccb675..8347345 100644 --- a/decript.p6 +++ b/decript.p6 @@ -3,8 +3,9 @@ my ProblemSolver $problem .= new; $problem.create-variable: , ^100; -$problem.add-constraint: , -> %vars {%vars * 3 == %vars + 14}; -$problem.add-constraint: , -> %vars {%vars * 2 == %vars}; +$problem.add-constraint: , -> $_ {. * 3 == . + 14}; +$problem.add-constraint: , -> $_ {. * 2 == .}; +$problem.add-heuristic: , -> $_ {. < .} #$problem.print-found = &say; say $problem.solve.head diff --git a/lib/ProblemSolver.pm6 b/lib/ProblemSolver.pm6 index fc8f25d..7068954 100644 --- a/lib/ProblemSolver.pm6 +++ b/lib/ProblemSolver.pm6 @@ -1,11 +1,12 @@ unit class ProblemSolver; has %.variables; +has %.constants; has Bag $.vars .= new; has %.constraints{Set}; -has %.heuristics{Str}; -has %.found; +has %.heuristics{Set}; has &.print-found is rw; +has Set %.unordered; multi method create-variable(Str $name where { not %!variables{$_}:exists }, Bag() \values) { $!vars = |$!vars ⊎ Pair.new: $name, 1; @@ -21,63 +22,38 @@ method add-constraint(Set() \vars where {%!variables{.keys.all}:exists}, &constr %!constraints{vars}.push: &constraint } -multi method add-heuristic( - Str() \consts where {%!variables{$_}:exists}, - Str() \to-rem where {%!variables{$_}:exists}, - &heuristic -) { - %!heuristics{consts}{to-rem}.push: &heuristic; - %!heuristics{to-rem}{consts}.push: -> $a, $b { heuristic $b, $a } +method add-heuristic(Set() \consts where {%!variables{.keys.all}:exists}, &heuristic) { + %!heuristics{consts}.push: &heuristic; } -multi method add-heuristic( - Set() \consts where {%!variables{$_}:exists}, - Str() \to-rem where {%!variables{.keys.all}:exists}, - &heuristic -) { - $.add-heuristic($_, to-rem, &heuristic) for consts.keys +proto method remove-possibility($name, $value) { + #note "remove-possibility($name, $value)"; + {*} } -multi method add-heuristic( - Str() \const where {%!variables{$_}:exists}, - Set() \to-rem where {%!variables{.keys.all}:exists}, - &heuristic -) { - $.add-heuristic(const, $_, &heuristic) for to-rem.keys -} - -multi method add-heuristic( - Set() \consts where {%!variables{.keys.all}:exists}, - Set() \to-rem where {%!variables{.keys.all}:exists}, - &heuristic -) { - $.add-heuristic(consts, $_, &heuristic) for to-rem.keys -} - -role Found {} -multi method remove-possibility(Str \name where {%!variables{name}:exists}, Set \value) { +multi method remove-possibility(Str \name where {%!variables{name}:exists}, Set() \value) { for value.keys -> \v { - $.remove-possibility(name, v) + nextwith(name, v) } } -multi method remove-possibility(Str \name where {%!variables{name}:exists}, \value) { - %!variables{name} = %!variables{name} ∖ bag(value xx %!variables{name}{value}); - die "No options" if %!variables{name}.elems == 0; - if %!variables{name}.elems == 1 { - %!variables{name} = %!variables{name}.keys.head but Found; - } +multi method remove-possibility(Set \name where {%!variables{.keys.all}:exists}, Set() \value) { + for name.keys -> \n { + nextwith(n, value) + } } -method constants { - %!variables.pairs.grep({ .value ~~ Found }).Map +multi method remove-possibility(Str $name where {%!variables{$name}:exists}, \value) { + %!variables{$name} = %!variables{$name} ∖ bag(value xx %!variables{$name}{value}); + die "No options" if %!variables{$name}.elems == 0; + if %!variables{$name}.elems == 1 { + %!variables = %!variables.pairs.grep: *.key !~~ $name; + %!constants = |%!constants, $name => value + } } method variable-bag { %!variables.keys - .grep(-> Str \key { - %!variables{key} !~~ Found - }) .map(-> Str \var { my Int $in-constraints = %!constraints.pairs.grep(var ∈ *.key).map(*.value.elems).sum; my Int $in-heuristics = %!heuristics.pairs.grep(var ∈ *.key).map(*.value.elems).sum; @@ -87,14 +63,53 @@ method variable-bag { } method get-constraints { - |%!constraints.pairs.grep(*.key ⊆ $.constants.keys.Set).map: |*.value + |%!constraints.pairs.grep(*.key ⊆ %!constants.keys.Set).map: |*.value +} + +method classify-heuristics { + %!heuristics.pairs.classify: {%!constants{one(.key)}:!exists ?? .key !! Empty}, :as{.value} +} + +method unique-value-vars(Set() \vars) { + for vars.keys.combinations: 2 -> @vars { + #say @vars; + $.add-constraint(@vars, -> %vars { %vars{@vars[0]} !~~ %vars{@vars[1]} }); + $.add-heuristic( @vars, -> %vars { %vars{@vars[0]} !~~ %vars{@vars[1]} }) + } +} + +method constraint-vars(Set() \vars, &constraint) { + for vars.keys.combinations: 2 -> @vars { + $.add-constraint(@vars, -> %vars { constraint |%vars{|@vars} }); + $.add-heuristic( @vars, -> %vars { constraint |%vars{|@vars} }) + } +} + +method unordered-vars(Set() \vars) { + for vars.keys -> Str $key { + %!unordered{$key} = vars ∖ set($key); + } } method run-heuristcs { # TODO: implement heuristics - for |%!heuristics.pairs.grep(* ∈ $.constants.keys.Set).kv -> $key, %to-rem { - # TODO!!! + my %not-used{Set}; + for |%!heuristics.kv -> %sig, @heu { + my \c = %sig.keys.classify: {%!constants{$_}:exists ?? "const" !! "var"} + if c.elems == 1 { + my %consts = %!constants{|c}:kv; + my $var-name = c.head; + my &gfunc = -> $value { + my %vars = |%consts, $var-name => $value; + ![&&] do for @heu { .(%vars) } + } + my %to-remove := set %!variables{$var-name}.keys.grep: &gfunc; + $.remove-possibility($var-name, %to-remove) + } else { + %not-used{%sig} = @heu + } } + %not-used } method next-variable { @@ -111,25 +126,34 @@ sub merge-used(%a1, %a2) { }).Map } +sub test-unordered(%un, %test, $var, $value) { + %un{$var}:exists and %test{%un{$var}.any}:exists and %test{%un{$var}.any}{$value} +} + method run-tests { - my Set %tested = $.constants.kv.map: -> $key, $value {$key => set($value)}; - my %consts = $.constants; + my Set %tested = %!constants.kv.map: -> $key, $value {$key => set($value)}; for $.get-constraints -> &constraint { - return %tested unless constraint(%consts) + return %tested unless constraint(%!constants) } - $_.(%consts) with &!print-found; + .(%!constants) with &!print-found; if %.variable-bag.elems { my Str $var = $.next-variable; - $.run-heuristcs; + my %heuristics := $.run-heuristcs; for |%!variables{$var}.pairs.sort(-*.value).map: *.key -> $value { - my %variables = |%!variables, $var => $value but Found; - my $clone = self.clone: :variables(%variables), :vars($!vars ∖ bag($var xx $!vars{$var})); + if test-unordered %!unordered, %tested, $var, $value { + next + } + my %constants = |%!constants, $var => $value; + my %variables = |%!variables.pairs.grep: *.key !~~ $var; + my $clone = self.clone: :%variables, :%constants, :%heuristics, :vars($!vars ∖ bag($var xx $!vars{$var})); my %returned = $clone.run-tests; - %tested = merge-used %tested, %returned - # TODO: remove the unordered var values + %tested = merge-used %tested, %returned; + + #note %tested; + $.remove-possibility($_, %tested{|%!unordered{$_}}) for %!unordered.grep: {%tested{$_}:exists} } } else { - take %consts; + take %!constants; } %tested } diff --git a/n-queens.p6 b/n-queens.p6 index 696156f..628ae3c 100644 --- a/n-queens.p6 +++ b/n-queens.p6 @@ -9,6 +9,7 @@ class Point { "{self.^name}(:x($!x), :y($!y))" } method gist {$.WHICH} + method Bool {$!x and $!y} } sub MAIN(Int $n = 4) { @@ -44,19 +45,22 @@ sub MAIN(Int $n = 4) { $problem.create-variable: @vars, @board; #$problem.no-order-vars: @vars; - $problem.unique-vars: @vars; + $problem.unique-value-vars: @vars; - $problem.constraint-vars: -> $q1, $q2 { + $problem.constraint-vars: @vars, -> $q1, $q2 { $q1.x != $q2.x && $q1.y != $q2.y && $q1.x - $q1.y != $q2.x - $q2.y && $q1.x + $q1.y != $q2.x + $q2.y - }, @vars; + }; - my @response = $problem.solve; - say "\n", "=" x 30, " Answers ", "=" x 30, "\n"; + $problem.unordered-vars: @vars; - for @response -> %ans { + my @solutions = eager $problem.solve; + say "\n", "=" x 30, " Answers ", "=" x 30, "\n"; + for @solutions -> %ans { print-board(%ans) } + + #print-board($problem.solve.head) }