Sudoku: Difference between revisions

Content added Content deleted
m (→‎{{header|Tailspin}}: update to stricter typing)
m (→‎{{header|Tailspin}}: typed array indices)
Line 12,877: Line 12,877:
<lang tailspin>
<lang tailspin>
templates deduceRemainingDigits
templates deduceRemainingDigits
data row, col local
templates findOpenPosition
templates findOpenPosition
@:{options: 10};
@:{options: 10"1"};
$ -> \[i;j](when <[](..~$@findOpenPosition.options::raw)> do @findOpenPosition: {row: $i, col: $j, options: $::length}; \) -> !VOID
$ -> \[i;j](when <[](..~$@findOpenPosition.options::raw)> do @findOpenPosition: {row: $i, col: $j, options: ($::length)"1"}; \) -> !VOID
$@ !
$@ !
end findOpenPosition
end findOpenPosition
Line 12,887: Line 12,886:
def digit: $($pos.row;$pos.col) -> $(1);
def digit: $($pos.row;$pos.col) -> $(1);
$ -> \[i;j](
$ -> \[i;j](
when <?($i <=$pos.row::raw>)?($j <=$pos.col::raw>)> do $digit !
when <?($i <=$pos.row>)?($j <=$pos.col>)> do $digit !
when <[]?($i <=$pos.row::raw>)
when <[]?($i <=$pos.row>)
|[]?($j <=$pos.col::raw>)
|[]?($j <=$pos.col>)
|[]?(($i-1)~/3 <=($pos.row::raw-1)~/3>)?(($j-1)~/3 <=($pos.col::raw-1)~/3>)> do [$... -> \(when <~=$digit> do $! \)] !
|[]?(($i::raw-1)~/3 <=($pos.row::raw-1)~/3>)?(($j::raw-1)~/3 <=($pos.col::raw-1)~/3>)> do [$... -> \(when <~=$digit> do $! \)] !
otherwise $ !
when <> do $ !
\) !
\) !
end selectFirst
end selectFirst
Line 12,897: Line 12,896:
@: $;
@: $;
$ -> findOpenPosition -> #
$ -> findOpenPosition -> #
when <{options: <=0>}> do [] !
when <{options: <=0"1">}> do [] !
when <{options: <=10>}> do $@ !
when <{options: <=10"1">}> do $@ !
otherwise def next: $;
when <> do def next: $;
$@ -> selectFirst&{pos: $next} -> deduceRemainingDigits
$@ -> selectFirst&{pos: $next} -> deduceRemainingDigits
-> \(when <~=[]> do @deduceRemainingDigits: $; {options: 10} !
-> \(when <~=[]> do @deduceRemainingDigits: $; {options: 10"1"} !
when <=[]> do ^@deduceRemainingDigits($next.row;$next.col;1)
when <=[]> do ^@deduceRemainingDigits($next.row;$next.col;1)
-> { $next..., options: $next.options::raw-1} ! \) -> #
-> { $next..., options: $next.options-1"1"} ! \) -> #
end deduceRemainingDigits
end deduceRemainingDigits


test 'internal solver'
test 'internal solver'
def sample: [
def sample: row´1:[
[5,3,4,6,7,8,9,1,2],
col´1:[5,3,4,6,7,8,9,1,2],
[6,7,2,1,9,5,3,4,8],
col´1:[6,7,2,1,9,5,3,4,8],
[1,9,8,3,4,2,5,6,7],
col´1:[1,9,8,3,4,2,5,6,7],
[8,5,9,7,6,1,4,2,3],
col´1:[8,5,9,7,6,1,4,2,3],
[4,2,6,8,5,3,7,9,1],
col´1:[4,2,6,8,5,3,7,9,1],
[7,1,3,9,2,4,8,5,6],
col´1:[7,1,3,9,2,4,8,5,6],
[9,6,1,5,3,7,2,8,4],
col´1:[9,6,1,5,3,7,2,8,4],
[2,8,7,4,1,9,6,3,5],
col´1:[2,8,7,4,1,9,6,3,5],
[3,4,5,2,8,6,1,7,9]
col´1:[3,4,5,2,8,6,1,7,9]
];
];


assert $sample -> deduceRemainingDigits <=$sample> 'completed puzzle unchanged'
assert $sample -> deduceRemainingDigits <=$sample> 'completed puzzle unchanged'


assert [
assert row´1:[
[[5],3,4,6,7,8,9,1,2],
col´1:[[5],3,4,6,7,8,9,1,2],
$sample(2..last)...] -> deduceRemainingDigits <=$sample> 'final digit gets placed'
$sample(row´2..last)...] -> deduceRemainingDigits <=$sample> 'final digit gets placed'


assert [
assert row´1:[
[[],3,4,6,7,8,9,1,2],
col´1:[[],3,4,6,7,8,9,1,2],
$sample(2..last)...] -> deduceRemainingDigits <=[]> 'no remaining options returns empty'
$sample(row´2..last)...] -> deduceRemainingDigits <=[]> 'no remaining options returns empty'


assert [
assert row´1:[
[[5],3,4,6,[2,5,7],8,9,1,[2,5]],
col´1:[[5],3,4,6,[2,5,7],8,9,1,[2,5]],
$sample(2..last)...] -> deduceRemainingDigits <=$sample> 'solves 3 digits on row'
$sample(row´2..last)...] -> deduceRemainingDigits <=$sample> 'solves 3 digits on row'


assert [
assert row´1:[
[5,3,4,6,7,8,9,1,2],
col´1:[5,3,4,6,7,8,9,1,2],
[[6,7,9],7,2,1,9,5,3,4,8],
col´1:[[6,7,9],7,2,1,9,5,3,4,8],
[1,9,8,3,4,2,5,6,7],
col´1:[1,9,8,3,4,2,5,6,7],
[8,5,9,7,6,1,4,2,3],
col´1:[8,5,9,7,6,1,4,2,3],
[4,2,6,8,5,3,7,9,1],
col´1:[4,2,6,8,5,3,7,9,1],
[[7],1,3,9,2,4,8,5,6],
col´1:[[7],1,3,9,2,4,8,5,6],
[[7,9],6,1,5,3,7,2,8,4],
col´1:[[7,9],6,1,5,3,7,2,8,4],
[2,8,7,4,1,9,6,3,5],
col´1:[2,8,7,4,1,9,6,3,5],
[3,4,5,2,8,6,1,7,9]
col´1:[3,4,5,2,8,6,1,7,9]
] -> deduceRemainingDigits <=$sample> 'solves 3 digits on column'
] -> deduceRemainingDigits <=$sample> 'solves 3 digits on column'


assert [
assert row´1:[
[5,3,[4,6],6,7,8,9,1,2],
col´1:[5,3,[4,6],6,7,8,9,1,2],
[[6],7,2,1,9,5,3,4,8],
col´1:[[6],7,2,1,9,5,3,4,8],
[1,[4,6,9],8,3,4,2,5,6,7],
col´1:[1,[4,6,9],8,3,4,2,5,6,7],
$sample(4..last)...
$sample(row´4..last)...
] -> deduceRemainingDigits <=$sample> 'solves 3 digits in block'
] -> deduceRemainingDigits <=$sample> 'solves 3 digits in block'


// This gives a contradiction if 3 gets chosen out of [3,5]
// This gives a contradiction if 3 gets chosen out of [3,5]
assert [
assert row´1:[
[[3,5],[3,4,6],[3,4,6],[3,4,6],7,8,9,1,2],
col´1:[[3,5],[3,4,6],[3,4,6],[3,4,6],7,8,9,1,2],
$sample(2..last)...] -> deduceRemainingDigits <=$sample> 'contradiction is backtracked'
$sample(row´2..last)...] -> deduceRemainingDigits <=$sample> 'contradiction is backtracked'
end 'internal solver'
end 'internal solver'


composer parseSudoku
composer parseSudoku
[<section>=3]
row´1:[<section>=3]
rule section: <row>=3 (<'-+'>? <WS>?)
rule section: <row>=3 (<'-+'>? <WS>?)
rule row: [<triple>=3] (<WS>?)
rule row: col´1:[<triple>=3] (<WS>?)
rule triple: <digit|dot>=3 (<'\|'>?)
rule triple: <digit|dot>=3 (<'\|'>?)
rule digit: [<'\d'>]
rule digit: [<'\d'>]
Line 12,982: Line 12,981:


assert $parsed <[<[<[]>=9](9)>=9](9)> 'parsed sudoku has 9 rows containing 9 columns of lists'
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(row´1;col´1) <=['5']> 'a digit'
assert $parsed(1;3) <=['1','2','3','4','5','6','7','8','9']> 'a dot'
assert $parsed(row´1;col´3) <=['1','2','3','4','5','6','7','8','9']> 'a dot'
end 'input sudoku'
end 'input sudoku'


Line 12,990: Line 12,989:
when <=[]> do 'No result found' !
when <=[]> do 'No result found' !
when <> do $ -> \[i](
when <> do $ -> \[i](
'$(1..3)...;|$(4..6)...;|$(7..9)...;$#10;' !
'$(col´1..col´3)...;|$(col´4..col´6)...;|$(col´7..col´9)...;$#10;' !
$i -> \(when <=3|=6> do '-----------$#10;' !\) !
$i -> \(when <=row´3|=row´6> do '-----------$#10;' !\) !
\) -> '$...;' !
\) -> '$...;' !
end solveSudoku
end solveSudoku
Retrieved from "https://rosettacode.org/wiki/Sudoku"