Sudoku: Difference between revisions

Content added Content deleted
m (→‎{{header|Picat}}: Added {{out}})
m (→‎{{header|Tailspin}}: update to stricter typing)
Line 12,877: Line 12,877:
<lang tailspin>
<lang tailspin>
templates deduceRemainingDigits
templates deduceRemainingDigits
data row <"1">, col <"1"> local
data row, col local
templates findOpenPosition
templates findOpenPosition
@:{options: 10};
@:{options: 10};
$ -> \[i;j](when <[](..~$@findOpenPosition.options)> do @findOpenPosition: {row: $i, col: $j, options: $::length}; \) -> !VOID
$ -> \[i;j](when <[](..~$@findOpenPosition.options::raw)> do @findOpenPosition: {row: $i, col: $j, options: $::length}; \) -> !VOID
$@ !
$@ !
end findOpenPosition
end findOpenPosition

templates selectFirst&{pos:}
templates selectFirst&{pos:}
def digit: $($pos.row;$pos.col) -> $(1);
def digit: $($pos.row;$pos.col) -> $(1);
$ -> \[i;j](
$ -> \[i;j](
when <?($i <=$pos.row>)?($j <=$pos.col>)> do $digit !
when <?($i <=$pos.row::raw>)?($j <=$pos.col::raw>)> do $digit !
when <[]?($i <=$pos.row>)
when <[]?($i <=$pos.row::raw>)
|[]?($j <=$pos.col>)
|[]?($j <=$pos.col::raw>)
|[]?(($i-1)~/3 <=($pos.row-1)~/3>)?(($j-1)~/3 <=($pos.col-1)~/3>)> do [$... -> \(when <~=$digit> do $! \)] !
|[]?(($i-1)~/3 <=($pos.row::raw-1)~/3>)?(($j-1)~/3 <=($pos.col::raw-1)~/3>)> do [$... -> \(when <~=$digit> do $! \)] !
otherwise $ !
otherwise $ !
\) !
\) !
end selectFirst
end selectFirst

@: $;
@: $;
$ -> findOpenPosition -> #
$ -> findOpenPosition -> #
Line 12,905: Line 12,905:
-> { $next..., options: $next.options::raw-1} ! \) -> #
-> { $next..., options: $next.options::raw-1} ! \) -> #
end deduceRemainingDigits
end deduceRemainingDigits

test 'internal solver'
test 'internal solver'
def sample: [
def sample: [
Line 12,918: Line 12,918:
[3,4,5,2,8,6,1,7,9]
[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 [
[[5],3,4,6,7,8,9,1,2],
[[5],3,4,6,7,8,9,1,2],
$sample(2..last)...] -> deduceRemainingDigits <=$sample> 'final digit gets placed'
$sample(2..last)...] -> deduceRemainingDigits <=$sample> 'final digit gets placed'

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

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

assert [
assert [
[5,3,4,6,7,8,9,1,2],
[5,3,4,6,7,8,9,1,2],
Line 12,944: Line 12,944:
[3,4,5,2,8,6,1,7,9]
[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 [
[5,3,[4,6],6,7,8,9,1,2],
[5,3,[4,6],6,7,8,9,1,2],
Line 12,951: Line 12,951:
$sample(4..last)...
$sample(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 [
Line 12,957: Line 12,957:
$sample(2..last)...] -> deduceRemainingDigits <=$sample> 'contradiction is backtracked'
$sample(2..last)...] -> deduceRemainingDigits <=$sample> 'contradiction is backtracked'
end 'internal solver'
end 'internal solver'

composer parseSudoku
composer parseSudoku
[<section>=3]
[<section>=3]
Line 12,966: Line 12,966:
rule dot: <'\.'> -> [1..9 -> '$;']
rule dot: <'\.'> -> [1..9 -> '$;']
end parseSudoku
end parseSudoku

test 'input sudoku'
test 'input sudoku'
def parsed:
def parsed:
Line 12,980: Line 12,980:
...|419|..5
...|419|..5
...|.8.|.79' -> parseSudoku;
...|.8.|.79' -> parseSudoku;

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(1;1) <=['5']> 'a digit'
assert $parsed(1;3) <=['1','2','3','4','5','6','7','8','9']> 'a dot'
assert $parsed(1;3) <=['1','2','3','4','5','6','7','8','9']> 'a dot'
end 'input sudoku'
end 'input sudoku'

templates solveSudoku
templates solveSudoku
$ -> parseSudoku -> deduceRemainingDigits -> #
$ -> parseSudoku -> deduceRemainingDigits -> #
Line 12,994: Line 12,994:
\) -> '$...;' !
\) -> '$...;' !
end solveSudoku
end solveSudoku

test 'sudoku solver'
test 'sudoku solver'
assert
assert