Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 222 lines (204 sloc) 6.649 kB
eacbfbd @moritz initial Sudoku code
authored
1 use v6;
2
3 class Sudoku::Constraint {
4 has @.x;
5 has @.y; # ;;
6 has %.remaining-symbols handles delete-symbol => 'delete';
df7f317 @moritz proper constraint tracking; simple (not yet active) solving
authored
7 method xy() { @!x Z @!y };
8 method Str {
9 ' Constraint: x(' ~ @!x ~ '); y(' ~ @!y ~ ') '
10 ~ %!remaining-symbols.keys.sort
11 ~ "\n";
12 }
eacbfbd @moritz initial Sudoku code
authored
13 }
14
15 class Sudoku {
16 has $.block-size = 3;
17 has $.size = $.block-size ** 2;
f50c95a @moritz track available numbers per cell; more simple solving
authored
18 has @!rows;
df7f317 @moritz proper constraint tracking; simple (not yet active) solving
authored
19 has @!coverage;
eacbfbd @moritz initial Sudoku code
authored
20
f50c95a @moritz track available numbers per cell; more simple solving
authored
21 has @!constraints;
22
23 has @!available;
187a834 @moritz add SVG output method
authored
24 has $.stuck = False;
eacbfbd @moritz initial Sudoku code
authored
25
26 method from-string($s) {
f50c95a @moritz track available numbers per cell; more simple solving
authored
27 my $o = self.new(
28 rows => (^9).map({[0 xx 9]}),
29 available => (^9).map({[(^9).map: { [ True xx 9 ]}]}),
30 );
eacbfbd @moritz initial Sudoku code
authored
31 $o.init();
df7f317 @moritz proper constraint tracking; simple (not yet active) solving
authored
32 for ^$o.size X ^$o.size -> $y, $x {
33 my $i = 9 * $y + $x;
34 if $s.substr($i, 1) -> $char {
35 $o.add-hint($char, :$x, :$y);
36 }
37 }
eacbfbd @moritz initial Sudoku code
authored
38 $o;
39 }
40
187a834 @moritz add SVG output method
authored
41 method check() {
42 for ^$!size X ^$!size -> $x, $y {
43 if @!rows[$y][$x] == 0 && none(@(@!available[$y][$x])) {
44 die "Stuck here at ($x, $y), no meaningful way out!";
45 }
46 }
47 }
48
49 method is-solved() {
50 for @!rows {
51 return False if any(@($_)) == 0;
52 }
53 True;
54 }
55
eacbfbd @moritz initial Sudoku code
authored
56 method Str {
57 @!rows.map({ .map({ $_ == 0 ?? '.' !! $_ }).join ~ "\n" }).join;
58 }
59
187a834 @moritz add SVG output method
authored
60 # returns a data structure that can be turned into SVG with
61 # the SVG module from http://github.com/moritz/svg/
62 # like this:
63 #
64 # say SVG.serialize: 'svg' => [
65 # width => 310,
66 # height => 310,
67 # $sudoku.SVG-tree,
68 # ];
69 method SVG-tree(:$output-size = 304, :$line-width=1) {
70 my $offset = 2 * $line-width;
71 my $upto = $output-size - $offset;
72 my $line-length = $output-size - 2 * $offset;
73 my $cell = $line-length / $!size;
74 gather {
75 for 1..^$!size {
76 my $stroke-width = $line-width;
77 my $color = 'grey';
78 if $_ %% $!block-size {
79 $stroke-width *= 1.5;
80 $color = 'black';
81 }
82 # horizontal grid
83 take 'line' => [
84 x1 => $offset,
85 x2 => $upto,
86 y1 => ($offset + $_ / $!size * $line-length),
87 y2 => ($offset + $_ / $!size * $line-length),
88 stroke => $color,
89 :$stroke-width,
90 ];
91 # horizontal grid
92 take 'line' => [
93 y1 => $offset,
94 y2 => $upto,
95 x1 => ($offset + $_ / $!size * $line-length),
96 x2 => ($offset + $_ / $!size * $line-length),
97 stroke => $color,
98 :$stroke-width,
99 ];
100 }
101
102 # outer frame
103 take 'rect' => [
104 x => $offset,
105 y => $offset,
106 width => $line-length,
107 height => $line-length,
108 stroke-width => 2.3 * $line-width,
109 stroke => 'black',
110 fill => 'none'
111 ];
112
113 # numbers
114 for ^$!size X ^$!size -> $y, $x {
115 if @!rows[$y][$x] -> $symbol {
116 take 'text' => [
117 x => $offset + ($x + 0.5) * $cell,
118 y => $offset + ($y + 0.5) * $cell,
119 text-anchor => 'middle',
120 dominant-baseline => 'middle',
121 font-weight => 'bold',
122 $symbol,
123 ];
124 }
125 }
126 }
127 }
128
df7f317 @moritz proper constraint tracking; simple (not yet active) solving
authored
129 method add-hint($n, :$x, :$y) {
2a8ea28 @moritz iterate simple solving until it no longer achieves anything
authored
130 say "Adding hint $n at ($x, $y)";
de392cd @moritz method add-number (untested)
authored
131 given @!rows[$y][$x] {
132 if $_ && $_ !== $n {
187a834 @moritz add SVG output method
authored
133 $!stuck = True;
de392cd @moritz method add-number (untested)
authored
134 die "Trying to set ($x, $y) to $n, but it is already set (to $_)";
f50c95a @moritz track available numbers per cell; more simple solving
authored
135 } elsif $_ {
136 # say "... but it's already there";
137 return;
de392cd @moritz method add-number (untested)
authored
138 }
139 }
df7f317 @moritz proper constraint tracking; simple (not yet active) solving
authored
140 @!rows[$y][$x] = $n;
f50c95a @moritz track available numbers per cell; more simple solving
authored
141 @!available[$y][$x][$_] = False for ^$!size;
142 for @(@!coverage[$y][$x]) -> $c {
143 $c.delete-symbol($n);
144 for $c.xy -> $mx, $my {
145 @!available[$my][$mx][$n - 1] = False;
146 }
de392cd @moritz method add-number (untested)
authored
147 }
148 }
149
eacbfbd @moritz initial Sudoku code
authored
150 method init() {
151 for ^$!size {
152 # rows
153 @!constraints.push: Sudoku::Constraint.new(
154 x => ^$.size,
155 y => $_ xx $!size,
156 remaining-symbols => hash( 1..$!size Z=> True xx * ),
157 );
158 # columns
159 @!constraints.push: Sudoku::Constraint.new(
160 x => $_ xx $.size,
161 y => ^$.size,
162 remaining-symbols => hash( 1..$!size Z=> True xx * ),
163 );
164 }
165 for ^$!block-size X ^$!block-size -> $x, $y {
df7f317 @moritz proper constraint tracking; simple (not yet active) solving
authored
166 # blocks
eacbfbd @moritz initial Sudoku code
authored
167 @!constraints.push: Sudoku::Constraint.new(
168 x => (^$!block-size X+ ($x * $!block-size)) xx $!block-size,
169 y => ((^$!block-size Xxx $!block-size )X+ ($y * $!block-size)),
170 remaining-symbols => hash( 1..$!size Z=> True xx * ),
171 );
172 }
df7f317 @moritz proper constraint tracking; simple (not yet active) solving
authored
173 for @!constraints -> $c {
174 for $c.xy -> $x, $y {
175 @!coverage[$y][$x] //= [];
176 @!coverage[$y][$x].push: $c;
177 }
178 }
179 }
180
181 method solve() {
2a8ea28 @moritz iterate simple solving until it no longer achieves anything
authored
182 my $track = @!rows.join('|');
183 loop {
184 $.simple-fill();
185 my $new-track = @!rows.join('|');
186 last if $track eq $new-track;
187 $track = $new-track;
188 }
df7f317 @moritz proper constraint tracking; simple (not yet active) solving
authored
189 }
190
191 method simple-fill() {
f50c95a @moritz track available numbers per cell; more simple solving
authored
192 for ^$!size X ^$!size -> $x, $y {
193 if 1 == [+] @(@!available[$y][$x]) {
194 # just one number allowed here... find it
195 for ^$!size -> $n {
196 if @!available[$y][$x][$n] {
197 $.add-hint($n + 1, :$x, :$y);
198 last;
199 }
200 }
201 }
202 }
203
df7f317 @moritz proper constraint tracking; simple (not yet active) solving
authored
204 for @!constraints -> $c {
205 my @rc = $c.remaining-symbols.keys;
206 if @rc == 1 {
207 # just one remaining symbol
208 # find out where it is
209 for $c.xy -> $x, $y {
210 if @!rows[$y][$x] == 0 {
f50c95a @moritz track available numbers per cell; more simple solving
authored
211 # warn "Adding @rc[0] to ($x, $y)";
df7f317 @moritz proper constraint tracking; simple (not yet active) solving
authored
212 $.add-hint(@rc[0], :$x, :$y);
213 last;
214 }
215 }
216 }
217 }
eacbfbd @moritz initial Sudoku code
authored
218 }
219 }
220
221 # vim: ft=perl6
Something went wrong with that request. Please try again.