Courses/CS 460/Fall 2005/Simplified Sudoku Solver

From CSWiki

FD.distinctD makes Sudoku a snap for Oz.

declare
A B C Vars = [A B C]
Vars ::: 1#3
{FD.distinctD Vars}
{Browse Vars}

A \=: 3
B \=: 3

Revised from Basic Sudoku solver

local
   % Generate thread bombs that ensure that all the members
   % of Xs are distinct.
   proc {AllDistinct Xs}
      case Xs of X|Xr then
	  for Y in Xr do
 	     thread X==Y = false end
	  end
	  {AllDistinct Xr}
      else skip end
   end

   % Returns a copy of L, which is assumed be either an atom, a variable, or
   % a list, whose elements are themselves either atoms, variables, or lists.
   % Re-uses the atoms and reproduces the list structures. Creates new variables 
   % in place of the variables. Anything that is not a variable or a list is 
   % treated as an atom and put into the returned result.
   fun {CloneList L}
      if {IsDet L} then 
         case L of
            X|Xs then {CloneList X} | {CloneList Xs}
         else L
         end
      else _
      end
   end

   proc {DefineElements Row}
      if Style == fd then Row ::: 1#9
      elseif Style == threadBomb then skip
      elseif Style == naive then {Permute Elts Row}
      end
   end

   fun {GetCol Grid I}
      {FoldR Grid fun {$ Row Prev} {Nth Row I}|Prev end nil}
   end

   % Make and return a list of the elements in subgrid X Y.
   fun {GetSubgrid Grid X Y}
      {FoldR
       % Get the rows in the X subgrid.
       {List.filterInd Grid fun {$ I Row} I >= 1+X*3 andthen I =< 3+X*3 end}
       fun {$ Row Prev}
	    {Append
	     % Get the elements in the Y columns.
	     {List.filterInd Row fun {$ I Elt} I >= 1+Y*3 andthen I =< 3+Y*3 end} 
	     Prev
	    }
       end
       nil}
   end

   proc {IsIn X Xs}
      XHead XRest in
      Xs = XHead | XRest
      choice
	  X = XHead
      []
	  {IsIn X XRest}
      end
   end

   proc {MakeDistinct Xs}
      if Style == fd then {FD.distinctD Xs}
      elseif Style == threadBomb then {AllDistinct Xs}
      elseif Style == naive then skip
      elseif Style == naive then {Permute Elts Xs}
      end
   end

   % Assumes the elements of L are distinct.
   proc {Permute L Perm}
      Perm = {MakeList {Length L}}
      {ForAll L proc {$ Elt} {IsIn Elt Perm} end}
   end

   proc {Search Grid}
      if Style == fd then {FD.distribute ff {Flatten Grid}}
      elseif Style == threadBomb then 
	    {ForAll Grid proc {$ Row} {Permute Elts Row} end}
      % Search done at the beginning for naive
      elseif Style == naive then skip
      end
   end

   % Solve the Sudoku in Grid
   fun {Sudoku Grid}

      % Define the elements in the Grid, row-by-row, and
      % require that each row consist of distinct elements.
      {ForAll Grid
       proc {$ Row}
          {DefineElements Row}
          {MakeDistinct Row}
       end}
      
      % Require that all elements in each column be distinct.
      for I in 1; I =< 9; I+1 do {MakeDistinct {GetCol Grid I}} end
      
      % Require that all elements in each 3x3 subgrid be distinct.
      for I in 0; I =< 2; I+1 do 
	  for J in 0; J =< 2; J+1 do
	     {MakeDistinct {GetSubgrid Grid I J}}
	  end
      end
      
      % Search...
      {Search Grid}

      % Return Grid.
      Grid
   end

   Elts = [1 2 3 4 5 6 7 8 9]

   Spec = 
          [
	    [_ 9 _  3 _ _  _ 1 _]
	    [2 _ 3  _ _ 1  _ _ _]
	    [_ _ _  _ 7 5  _ 8 _]

	    [_ _ 2  _ _ _  _ 5 6]
	    [_ _ _  7 _ 8  _ _ _] 
	    [7 1 _  _ _ _  2 _ _]

	    [_ 2 _  4 9 _  _ _ _]
	    [_ _ _  8 _ _  5 _ 1]
 	    [_ 7 _  _ _ 2  _ 9 _]
	   ]

% This is listed as an "outlaw" Sudoku on Paul's Pages
%	  [
%	   [4 _ _  _ _ _  _ 6 _]
%	   [5 _ _  _ 8 _  9 _ _]
%	   [3 _ _  _ _ 1  _ _ _]
%	   
%	   [_ 2 _  7 _ _  _ _ 1]
%	   [_ 9 _  _ _ _  _ 4 _]
%	   [8 _ _  _ _ 3  _ 5 _]
%	   
%	   [_ _ _  2 _ _  _ _ 7]
%	   [_ _ 6  _ 5 _  _ _ 8] 
%	   [_ 1 _  _ _ _  _ _ 6]
%	  ]

% Another "outlaw" Sudoku puzzle.
%          [
%	   [_ 5 _  _ 4 _  _ _ 7]
%	   [_ _ _  1 _ _  _ _ 3]
%	   [_ 9 _  _ _ 8  _ 6 _]
%	   
%	   [_ _ 2  _ _ _  8 _ _]
%	   [_ 6 _  _ _ 9  _ 5 _]
%	   [_ _ 1  _ 7 _  4 _ _]
%	   
%	   [_ 3 _  2 _ _  _ 9 _]
%	   [8 _ _  _ _ 6  _ _ _] 
%	   [4 _ _  _ 3 _  _ 1 _]
%	  ]

  % Statistics 
  % Example | Style | time     | choices | depth
  %    1    |  fd   |  < 1 ms  |     0   |    1
  %    1    |  thB  |  1.2 min |   62K   |  407
  %    2    |  fd   |  31 ms   |     2   |    3
  %    2    |  thB  |  6.1 min |  381K   |  407
  %    3    |  fd   |  1 ms    |     1   |    2
  %    3    |  thB  |  1.2 min |   52K   |  412

   Style = 
           fd
%           threadBomb 
%           naive

in
   % Must clone the input since the variables in it
   % are defined outside SearchAll/ExploreAll and
   % cannot be assigned from inside.

   {ExploreAll fun {$} {Sudoku {CloneList Spec}} end}
   {Browse {SearchAll fun {$} {Sudoku {CloneList Spec}} end}}
end