Anonymous user
Sudoku: Difference between revisions
add Tailspin solution
SqrtNegInf (talk | contribs) m (→{{header|Sidef}}: Fix link: Perl 6 --> Raku) |
(add Tailspin solution) |
||
Line 11,597:
-------------
</pre>
=={{header|Tailspin}}==
<lang tailspin>
templates deduceRemainingDigits
templates findOpenPosition
@:{options: 10};
$ -> \[i;j](<[](..~$@findOpenPosition.options)> @findOpenPosition: {row: $i, col: $j, options: $::length}; \) -> !VOID
$@ !
end findOpenPosition
templates selectFirst@{pos:}
def digit: $($pos.row;$pos.col) -> $(1);
$ -> \[i;j](
<?($i <=$pos.row>)?($j <=$pos.col>)> $(1) !
<[]?($i <=$pos.row>)
|[]?($j <=$pos.col>)
|[]?(($i-1)~/3 <=($pos.row-1)~/3>)?(($j-1)~/3 <=($pos.col-1)~/3>)> [$... -> \(<~=$digit> $! \)] !
<> $ !
\) !
end selectFirst
@: $;
$ -> findOpenPosition -> #
<{options: <=0>}> [] !
<{options: <=10>}> $@ !
<> def next: $;
def result: $@ -> selectFirst@{pos: $next} -> deduceRemainingDigits;
$result -> \(<~=[]> $! \) !
$result -> \(<=[]> $! \) -> ^@($next.row;$next.col;1) -> { $next..., options: $next.options-1} -> #
end deduceRemainingDigits
test 'internal solver'
def sample: [
[5,3,4,6,7,8,9,1,2],
[6,7,2,1,9,5,3,4,8],
[1,9,8,3,4,2,5,6,7],
[8,5,9,7,6,1,4,2,3],
[4,2,6,8,5,3,7,9,1],
[7,1,3,9,2,4,8,5,6],
[9,6,1,5,3,7,2,8,4],
[2,8,7,4,1,9,6,3,5],
[3,4,5,2,8,6,1,7,9]
];
assert $sample -> deduceRemainingDigits <=$sample> 'completed puzzle unchanged'
assert [
[[5],3,4,6,7,8,9,1,2],
$sample(2..last)...] -> deduceRemainingDigits <=$sample> 'final digit gets placed'
assert [
[[],3,4,6,7,8,9,1,2],
$sample(2..last)...] -> deduceRemainingDigits <=[]> 'no remaining options returns empty'
assert [
[[5],3,4,6,[2,5,7],8,9,1,[2,5]],
$sample(2..last)...] -> deduceRemainingDigits <=$sample> 'solves 3 digits on row'
assert [
[5,3,4,6,7,8,9,1,2],
[[6,7,9],7,2,1,9,5,3,4,8],
[1,9,8,3,4,2,5,6,7],
[8,5,9,7,6,1,4,2,3],
[4,2,6,8,5,3,7,9,1],
[[7],1,3,9,2,4,8,5,6],
[[7,9],6,1,5,3,7,2,8,4],
[2,8,7,4,1,9,6,3,5],
[3,4,5,2,8,6,1,7,9]
] -> deduceRemainingDigits <=$sample> 'solves 3 digits on column'
assert [
[5,3,[4,6],6,7,8,9,1,2],
[[6],7,2,1,9,5,3,4,8],
[1,[4,6,9],8,3,4,2,5,6,7],
$sample(4..last)...
] -> deduceRemainingDigits <=$sample> 'solves 3 digits in block'
// This gives a contradiction if 3 gets chosen out of [3,5]
assert [
[[3,5],[3,4,6],[3,4,6],[3,4,6],7,8,9,1,2],
$sample(2..last)...] -> deduceRemainingDigits <=$sample> 'contradiction is backtracked'
end 'internal solver'
composer parseSudoku
[<section>=3]
rule section: <row>=3 (<'-+'>? <WS>?)
rule row: [<triple>=3] (<WS>?)
rule triple: <digit|dot>=3 (<'\|'>?)
rule digit: [<'\d'>]
rule dot: <'\.'> -> [1..9 -> '$;']
end parseSudoku
test 'input sudoku'
def parsed:
'53.|.7.|...
6..|195|...
.98|...|.67
-----------
8..|.6.|..3
4..|8.3|..1
7..|.2.|..6
-----------
.6.|...|28.
...|419|..5
...|.8.|.79' -> parseSudoku;
assert $parsed <[<[<[]>=9](9)>=9](9)> 'parsed sudoku has 9 rows containing 9 columns of lists'
assert $parsed(1;1) <=['5']> 'a digit'
assert $parsed(1;3) <=['1','2','3','4','5','6','7','8','9']> 'a dot'
end 'input sudoku'
templates solveSudoku
$ -> parseSudoku -> deduceRemainingDigits -> #
<=[]> 'No result found' !
<> def result: $;
[1..7:3 -> $result($..$+2) -> \section('$:1..11 -> '-';$#10;' ! $... ->
\row( def r: $;
[1..7:3 -> $r($..$+2) -> \triple('|' ! $... ! \triple)] -> '$(2..last)...;$#10;' !
\row)
!\section)] -> '$(2..last)...;' !
end solveSudoku
test 'sudoku solver'
assert
'53.|.7.|...
6..|195|...
.98|...|.67
-----------
8..|.6.|..3
4..|8.3|..1
7..|.2.|..6
-----------
.6.|...|28.
...|419|..5
...|.8.|.79'
-> solveSudoku <=
'534|678|912
672|195|348
198|342|567
-----------
859|761|423
426|853|791
713|924|856
-----------
961|537|284
287|419|635
345|286|179
'> 'solves sudoku and outputs pretty solution'
end 'sudoku solver'
</lang>
=={{header|Tcl}}==
| |||