initial commit, check in a sudoku verifierHEADmaster

1 files changed, 150 insertions, 0 deletions

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{$_}++ } @_};
+}