From d2f180c59dafe641ed3b6058831c849fcabfecc6 Mon Sep 17 00:00:00 2001 From: Calvin Morrison Date: Sun, 4 Aug 2024 20:46:03 -0400 Subject: initial commit, check in a sudoku verifier --- sudoku.pl | 150 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 150 insertions(+) create mode 100644 sudoku.pl diff --git a/sudoku.pl b/sudoku.pl new file mode 100644 index 0000000..4c195b3 --- /dev/null +++ b/sudoku.pl @@ -0,0 +1,150 @@ + +use DD; +use v5.36; + + +# my $box = 3; +# my $l = $box*$box; +# my @s= map { 1 + int(rand($l)) } 0..($l*$l-1); + +my @s = (4,3,5,2,6,9,7,8,1, + 6,8,2,5,7,1,4,9,3, + 1,9,7,8,3,4,5,6,2, + 8,2,6,1,9,5,3,4,7, + 3,7,4,6,8,2,9,1,5, + 9,5,1,7,4,3,6,2,8, + 5,1,9,3,2,6,8,7,4, + 2,4,8,9,5,7,1,3,6, + 7,6,3,4,1,8,2,5,9); + + # my @s = (1,2,3,4,5,6,7,8,9, + # 4,5,6,5,6,7,8,9,1, + # 7,8,9,6,7,8,9,1,2, + # 4,5,6,7,8,9,1,2,3, + # 5,6,7,8,9,1,2,3,4, + # 6,7,8,9,1,2,3,4,5, + # 7,8,9,1,2,3,4,5,6, + # 8,9,1,2,3,4,5,6,7, + # 9,1,2,3,4,5,6,7,8); + +# my @s = map { $_ } 1..81; + +# my @s = map { 0 } 0..($l * $l-1); + + print_s(@s); + if(check_s(@s)) { + print "valid sudoku!\n"; + } + +sub print_s { + say scalar(@_); + + my $size = sqrt scalar @_; + my $box = sqrt sqrt scalar @_; + + say ($size); + say ($box); + + print "┌" . "─" x (($size * $box) + 7) . "┐\n"; + + + my $rows=0; + for (my $x = 0; $x < scalar @_; $x+=$size) { + $rows++; + print "│"; + for(my $y = 0; $y < $size; $y++) { + print " " . $_[$x+$y] . " " if $_[$x+$y] != 0; + print " - " if $_[$x+$y] == 0; + print " │ " if ($y + 1) % $box == 0; + } + print "\n"; + + print "├" . "─" x (($size*$box)+7) . "┤\n" if ($rows % $box == 0 && $rows != $size); + } + + print "└" . "─" x (($size * $box) + 7) . "┘\n"; +} + +sub check_s { + + my $size = sqrt scalar @_; + my $box = sqrt sqrt scalar @_; + + my @correct = map { $_ } 1..$size; + + # check rows + for(my $i = 0; $i < $size; $i++) { + my @row = sort { $a <=> $b } uniq(get_row($i, @_)); + unless (@row ~~ @correct) { + say "row $i is invalid"; + return 0; + } + + my @col = sort { $a <=> $b } uniq(get_col($i, @_)); + unless (@col ~~ @correct) { + say "col $i is invalid"; + return 0; + } + + my @box = sort { $a <=> $b } uniq(get_box($i, @_)); + unless (@box ~~ @correct) { + say "box $i is invalid"; + return 0; + } + } + return 1; + +} + +sub get_col { + my ($col, @s) = @_; + + my $size = sqrt scalar @s; + my $box = sqrt sqrt scalar @s; + + my @col; + + @col = map { @_[($size*$_+1) + $col] } 0..$size-1; + + return @col; + +} +sub get_row { + + my ($row, @s) = @_; + + my $size = sqrt scalar @s; + my $box = sqrt sqrt scalar @s; + + my @row; + + @row = @_[$row*$size+1..($row*$size+$size)]; + + return @row; + +} + +sub get_box { + + my ($bnum, @s) = @_; + + my $size = sqrt scalar @s; + my $box = sqrt sqrt scalar @s; + + my $nboxes = $size; + + my $row = int($bnum / 3); + my $row_start = $row*($size*3)+1; + my $start = $row_start + (($bnum % 3)*3); + + + my @box = map { my $x = $_; + map { $s[($start+$_) + ($size*$x-1)] } 0..$box-1 + } 0..$box-1; + + return @box; +} + +sub uniq { + return do { my %seen; grep { !$seen{$_}++ } @_}; +} -- cgit v1.2.3