{"id":18,"date":"2006-06-04T22:03:00","date_gmt":"2006-06-04T22:03:00","guid":{"rendered":"https:\/\/knielsen-hq.org\/w\/?p=18"},"modified":"2021-08-31T14:48:35","modified_gmt":"2021-08-31T14:48:35","slug":"suduko-solver","status":"publish","type":"post","link":"https:\/\/knielsen-hq.org\/w\/suduko-solver\/","title":{"rendered":"Suduko solver"},"content":{"rendered":"\n<p>There are probably tons of these already available, but here is a quick suduko solver (in Perl):<\/p>\n\n\n\n<pre class=\"wp-block-preformatted\">#! \/usr\/bin\/perl\n\n# Example:\n#\n# echo $'      2  \\n  1 9  4 \\n 2 1 5  9\\n3     6  \\n  68 41 5\\n  427 8  \\n   51    \\n     7 3 \\n79    5  '| perl suduko-solve.pl\n#\n\nuse strict;\nuse warnings;\n\nmy $s = read_soduku();\n\nmy $res= solve($s);\n\nif($res) {\n  print_soduku($res);\n  print \"Got it!\\n\";\n} else {\n  print \"Failed :-(\\n\";\n}\n\nexit 0;\n\nsub solve {\n  my ($s)= @_;\n\n  my $res= try_solve($s);\n\n  return $s if $res eq 'SOLVED';\n\n  return undef if $res eq 'FAIL';\n\n  # Make a guess, backtracking if we were wrong.\n  # Try to find some field where there are only two possibilities.\n  my ($a, $b);\n\n OUTER:\n  for my $i (0..8) {\n  INNER:\n    for my $j (0..8) {\n      next INNER if keys(%{$s-&gt;[$i][$j]}) == 1;\n      if(keys(%{$s-&gt;[$i][$j]}) == 2) {\n        ($a,$b)= ($i,$j);\n        last OUTER;\n      } elsif(!defined($a)) {\n        ($a,$b)= ($i,$j);\n      }\n    }\n  }\n\n  die \"Internal?!?\" unless defined($a);\n\n  for my $choice (keys %{$s-&gt;[$a][$b]}) {\n    my $s_copy = [ map { [ map { { %$_ } } @$_ ] } @$s ];\n    $s_copy-&gt;[$a][$b] = { $choice =&gt; 1 };\n    my $res= solve($s_copy);\n    return $res if defined($res); # Got it!\n  }\n  return undef;                 # Failed.\n}\n\nsub read_soduku {\n  my $s= [ ];\n\n  for(my $i = 0; $i &lt; 9; $i++) {\n    my $x = &lt;STDIN&gt;;\n    chomp($x);\n    if(length($x) &lt; 9) {\n      print STDERR \"Short line: '$x'\\n\";\n      redo;\n    }\n    for(my $j = 0; $j &lt; 9; $j++) {\n      my $entry= substr($x, $j, 1);\n      $s-&gt;[$i][$j] = { map(($_ =&gt; 1), ($entry eq ' ' ? (1..9) : ($entry))) };\n    }\n  }\n\n  return $s;\n}\n\nsub print_soduku {\n  my ($s) = @_;\n  for(my $i = 0; $i &lt; 9; $i++) {\n    print \"---------------------\\n\" unless $i % 3;\n    for(my $j= 0; $j &lt; 9; $j++) {\n      print \"|\" unless $j % 3;\n      print((keys(%{$s-&gt;[$i][$j]}) &gt; 1 ? ' ' : keys(%{$s-&gt;[$i][$j]})),\n            ($j == 8 ? \"|\\n\" : \" \"));\n    }\n  }\n  print \"---------------------\\n\";\n}\n\nsub try_solve {\n  my ($s)= @_;\n\n  my $done;\n  my $progress;\n\n  do {\n    $done = 1;                 # Set false when non-determined field found\n    $progress= undef;\n\n    for(my $i = 0; $i &lt; 9; $i++) {\n      for(my $j = 0; $j &lt; 9; $j++) {\n        my $x = $s-&gt;[$i][$j];\n        return 'FAIL' if keys(%$x) == 0;\n        $done = undef if keys(%$x) &gt; 1;\n        my $h1= { %$x };\n        my $h2= { %$x };\n        my $h3= { %$x };\n        for(my $a = 0; $a &lt; 9; $a++) {\n          if($a != $i) {\n            my $y = $s-&gt;[$a][$j];\n            delete $h1-&gt;{$_} for keys(%$y);\n            if(keys %$y == 1) {\n              $progress = 1 if delete $x-&gt;{(keys(%$y))[0]};\n            }\n          }\n          if($a != $j) {\n            my $y = $s-&gt;[$i][$a];\n            delete $h2-&gt;{$_} for keys(%$y);\n            if(keys %$y == 1) {\n              $progress = 1 if delete $x-&gt;{(keys(%$y))[0]};\n            }\n          }\n          my $b = 3*int($i\/3) + int($a \/ 3);\n          my $c = 3*int($j\/3) + $a % 3;\n          if($b != $i || $c != $j) {\n            my $y = $s-&gt;[$b][$c];\n            delete $h3-&gt;{$_} for keys(%$y);\n            if(keys %$y == 1) {\n              $progress = 1 if delete $x-&gt;{(keys(%$y))[0]};\n            }\n          }\n        }\n        return 'FAIL' if keys(%$h1) &gt; 1 || keys(%$h2) &gt; 1 || keys(%$h3) &gt; 1;\n        if(keys(%$h1) == 1) {\n          delete($x-&gt;{$_}) for grep(!$h1-&gt;{$_}, keys %$x);\n        } elsif(keys(%$h2) == 1) {\n          delete($x-&gt;{$_}) for grep(!$h2-&gt;{$_}, keys %$x);\n        } elsif(keys(%$h3) == 1) {\n          delete($x-&gt;{$_}) for grep(!$h3-&gt;{$_}, keys %$x);\n        }\n      }\n    }\n  } while(!$done &amp;&amp; $progress);\n\n  return $done ? 'SOLVED' : 'UNSOLVED';\n}\n<\/pre>\n\n\n\n<p>I wanted to use strategy rather than brute force (not sure what the complexity of that would be; the above seems to solve puzzles in a split second). Strategies are<\/p>\n\n\n\n<ul><li>If a digit is already in a row\/column\/square, it cannot occur a second time.<\/li><li>A digit is known to occur in a field if it cannot occur in any of the 8 other fields of a row\/column\/square.<\/li><\/ul>\n\n\n\n<p>These are not sufficient to solve (all) puzzles. Here is another example strategy: If we know in some 3&#215;3 square that some particular digit can only occur in a particular row\/column, then that digit can not occur in that digit\/column in any other square.<\/p>\n\n\n\n<p>However, at this point I just added a quick backtracking step. It seems the implemented strategies are sufficiently close to a full solution that only very little backtracking is needed, and a solution is usually arrived at instantly.<\/p>\n\n\n\n<p>This example took perhaps an hour to put together. It is a nice example of the usefulness of learning Perl. Because Perl is well suited for a very wide range of programming tasks, the investment needed to learn the language pays off very well. Perl can be used for 2-minute one-liners like this to massage a .h file:<\/p>\n\n\n\n<pre class=\"wp-block-preformatted\">perl -nle 'print \"#define prefix_$1 $1\" if \/^\\s*[a-zA-z0-9_ ]+\\s+([_a-zA-Z0-9]+)\\s*\\(\/ ' *.h\n<\/pre>\n\n\n\n<p>It can be used for quick hacks like this suduko solver. And it can be used for full-scale application development.<\/p>\n\n\n\n<p>If I were to use different languages for these different tasks, I would have less time to spend on learning each one, and thus would work less efficiently at <em>all<\/em> of them.<\/p>\n","protected":false},"excerpt":{"rendered":"<p>There are probably tons of these already available, but here is a quick suduko solver (in Perl): #! \/usr\/bin\/perl # Example: # # echo $&#8217; 2 \\n 1 9 4 \\n 2 1 5 9\\n3 6 \\n 68 41 5\\n 427 8 \\n 51 \\n 7 3 \\n79 5 &#8216;| perl suduko-solve.pl # use strict;&hellip; <a class=\"more-link\" href=\"https:\/\/knielsen-hq.org\/w\/suduko-solver\/\">Continue reading <span class=\"screen-reader-text\">Suduko solver<\/span><\/a><\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":[],"categories":[1],"tags":[7,8,6],"_links":{"self":[{"href":"https:\/\/knielsen-hq.org\/w\/wp-json\/wp\/v2\/posts\/18"}],"collection":[{"href":"https:\/\/knielsen-hq.org\/w\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/knielsen-hq.org\/w\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/knielsen-hq.org\/w\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/knielsen-hq.org\/w\/wp-json\/wp\/v2\/comments?post=18"}],"version-history":[{"count":1,"href":"https:\/\/knielsen-hq.org\/w\/wp-json\/wp\/v2\/posts\/18\/revisions"}],"predecessor-version":[{"id":19,"href":"https:\/\/knielsen-hq.org\/w\/wp-json\/wp\/v2\/posts\/18\/revisions\/19"}],"wp:attachment":[{"href":"https:\/\/knielsen-hq.org\/w\/wp-json\/wp\/v2\/media?parent=18"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/knielsen-hq.org\/w\/wp-json\/wp\/v2\/categories?post=18"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/knielsen-hq.org\/w\/wp-json\/wp\/v2\/tags?post=18"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}