Re: OT: A bit of Sudoku

[Brad Moore <brad.moore@shaw.ca>]

On 14-06-05 05:39 PM, Adam Beneschan wrote:
> On Thursday, June 5, 2014 4:12:55 PM UTC-7, Robert A Duff wrote:
>
>> In any case, if you need to jump out of many layers of (recursive?)
>> calls, an exception might well be the best way.  Checking error
>> codes at each level might be verbose and error prone.
>
> I don't like it.  But if you do something like this, I'd suggest that this use be limited to an exception that you declare inside a subprogram, so that you raise and handle it only inside that subprogram or nested subprograms.  Otherwise, someone could look at a subprogram that is called in between, and never guess that the subprogram might not complete normally (A calls B, B calls C, C raises an exception that gets passed over B's head back to A; a programmer trying to read B might not suspect that B may not complete in a non-error situation.)  In other words, keep such usages as localized as possible.
>
> Another thing to keep in mind is that exceptions cause overhead.  I've seen implementations that have to do some stuff any time a subprogram or a block with an exception handler is entered.  I've seen other implementations that, in order to eliminate this overhead in "normal" (non-exception) cases, perform table lookups on each address in the stack until it finds a handler; this is a relatively expensive operation that those implementations have decided is justified because exceptions aren't supposed to happen in "normal" cases.  Whether this overhead is less than the expense of going through a number of returns, I don't know--I'm sure it depends on various factors.  But efficiency should not be a reason to use exceptions instead of straight returns, because it may well make things slower.
>

Another point to keep in mind is that although the exception mechanism 
may or may not be technically faster than the normal recursion exit, 
depending on implementation, it may not be noticeably faster. A 
guideline I try to follow generally is to write the code naturally and 
simply, and let the compiler worry about performance, and then only look 
at using different constructs if there is still a performance problem 
that needs to be addressed.

I have actually written a sudoku solver, that executes in Parallel.
My approach was to just let the recursion unwind naturally.

In my parallelism framework, workers tasks catch and handle exceptions,
where if exceptions are raised in multiple worker threads, only one of 
those exceptions is saved, and gets reraised in the calling thread 
before returning from the parallel call.

Here exceptions are generally used to report failures, but could 
probably be used to report a solution in this case. However if a 
different exception occurs in a worker thread (such as a constraint 
error), that may or may not be the exception that ends up getting reported.

I suspect that trying to use exceptions to report solutions for Sudoku, 
would not noticeably improve performance, as most of the time is spent 
trying to find a solution, not report it.

My Sudoku solver uses a brute force approach. (I was mostly interested 
in trying out the parallelism). I believe the performance could be 
improved significantly by updating local cells to maintain a list of 
possible values, thus ruling out trial values much more sooner.
I would think such an approach would improve performance far more than 
using exceptions to exit recursion, so that would be where I would 
suggest programming effort be spent.

I have several versions of the solver.
(A sequential version,
  A load balancing version,
  A load balanciong version that adds some stack safety (prevents stack 
overflow)

Here is my sequential version. I'd be happy to share the other versions 
also....

Brad

generic
    N : Positive := 3;
package Sequential_Sudoku is

    Max_Range : constant Positive := N**2;

    subtype Sudoku_Value is
      Natural range 0 .. Max_Range;

    Null_Value : constant Sudoku_Value := 0;

    subtype Sudoku_Solution_Value is Sudoku_Value range 1 .. Max_Range;

    subtype Sudoku_Index is Sudoku_Solution_Value;

    type Sudoku_Board is private;

    procedure Initialize (Board : in out Sudoku_Board);

    function Get
      (Board : Sudoku_Board;
       Row, Column : Sudoku_Index) return Sudoku_Value;

    procedure Set
      (Board : in out Sudoku_Board;
       Row, Column : Sudoku_Index;
       Value : Sudoku_Solution_Value)
    with Pre => Is_Valid (Board, Row, Column, Value),
         Post => Get (Board, Row, Column) = Value;

    function Is_Valid (Board : Sudoku_Board;
                       Row, Column : Sudoku_Index;
                       Value : Sudoku_Solution_Value) return Boolean;

    procedure Generate (Board : out Sudoku_Board);

    procedure Solve (Board : in out Sudoku_Board);

private

    type Sudoku_Value_Array is
      array (Sudoku_Index, Sudoku_Index) of Sudoku_Value;

    type Sudoku_Board is
       record
          Initialized : Boolean := False;
          Values : Sudoku_Value_Array;
       end record;

    function Get (Board : Sudoku_Board;
                  Row, Column : Sudoku_Index) return Sudoku_Value is
      (Board.Values (Row, Column));

    function Value_In_Row
      (Board : Sudoku_Board;
       Row : Sudoku_Index;
       Value : Sudoku_Solution_Value) return Boolean is
       (for some I in Board.Values'Range (2) => Board.Values (Row, I) = 
Value);

    function Value_In_Column
      (Board : Sudoku_Board;
       Col : Sudoku_Index;
       Value : Sudoku_Solution_Value) return Boolean is
       (for some I in Board.Values'Range (1) => Board.Values (I, Col) = 
Value);

    function On_Diagonal
      (Board : Sudoku_Board;
       Row, Col : Sudoku_Index) return Boolean is
      (Row = Col or else Row + Col = Max_Range + 1);

    function Value_In_Diagonal
      (Board : Sudoku_Board;
       Row, Col : Sudoku_Index;
       Value : Sudoku_Solution_Value) return Boolean;

    --     function Value_In_Diagonal
--       (Board : Sudoku_Board;
--        Row, Col : Sudoku_Index;
--        Value : Sudoku_Solution_Value) return Boolean is
--       (if Row = Col then
--          (for some I in Board.Values'Range (1) =>
--              Board.Values (I, I) = Value)
--        or else
--          (for some I in Board.Values'Range (1) =>
--           Board.Values (Max_Range + 1 - I, I) = Value));

    function Value_In_Sector
      (Board : Sudoku_Board;
       Row, Col : Sudoku_Index;
       Value : Sudoku_Solution_Value) return Boolean;

    function Is_Valid (Board : Sudoku_Board;
                       Row, Column : Sudoku_Index;
                       Value : Sudoku_Solution_Value) return Boolean is
      (Board.Initialized and then
         not Value_In_Row (Board, Row, Value) and then
         not Value_In_Column (Board, Column, Value) and then
         not Value_In_Sector (Board, Row, Column, Value)
--        and then
--          (not On_Diagonal (Board, Row, Column) or else not
       --             Value_In_Diagonal (Board, Row, Column, Value))
      );

end Sequential_Sudoku;
with Ada.Numerics.Discrete_Random;

package body Sequential_Sudoku is

    package Random_Index is new Ada.Numerics.Discrete_Random
      (Result_Subtype => Sudoku_Index);

    procedure Random_Solution
      (Board : out Sudoku_Board);

    function Multiple_Solutions_Exist
      (Board : Sudoku_Board) return Boolean;

    Generator : Random_Index.Generator;

    procedure Generate (Board : out Sudoku_Board)
    is
       Scratch_Board : Sudoku_Board;
    begin

       Random_Solution (Board);

       Filter_Loop : loop
          declare
             Delete_Row : constant Sudoku_Index :=
               Random_Index.Random (Generator);
             Delete_Column : constant Sudoku_Index :=
               Random_Index.Random (Generator);

             Delete_Value : constant Sudoku_Value :=
               Board.Values (Delete_Row, Delete_Column);
          begin

             if Delete_Value /= 0 then

                Board.Values (Delete_Row, Delete_Column) := 0;
                Scratch_Board := Board;

                if Multiple_Solutions_Exist (Board => Scratch_Board) then
                   Board.Values (Delete_Row, Delete_Column) :=
                        Delete_Value;
                   exit Filter_Loop;
                end if;
             end if;
          end;
       end loop Filter_Loop;

    end Generate;

    ----------------
    -- Initialize --
    ----------------

    procedure Initialize (Board : in out Sudoku_Board) is
    begin
       for I in Board.Values'Range (1) loop
          for J in Board.Values'Range (2) loop
             Board.Values (I, J) := Null_Value;
          end loop;
       end loop;

       Board.Initialized := True;
    end Initialize;

    function Multiple_Solutions_Exist
      (Board : Sudoku_Board) return Boolean is

       --  Note: We do not need to worry about deallocating scratch boards
       --  that were allocated from the heap, since they will all get
       --  automatically deallocated when this access type goes out of 
scope,
       --  i.e. before returning from Solve
       type Board_Access is access all Sudoku_Board;

       type Sudoku_Work is
          record
             Row, Column   : Sudoku_Index'Base;
             Scratch_Board : Board_Access;
          end record;

       Multiple_Solutions : Boolean := False;

       protected Solution_Checker is
          procedure Note_Solution;
       private
          Solved : Boolean := False;
       end Solution_Checker;

       protected body Solution_Checker is
          procedure Note_Solution is
          begin
             if Solved then
                Multiple_Solutions := True;
             else
                Solved := True;
             end if;
          end Note_Solution;
       end Solution_Checker;

       function Next_Work (Row : Sudoku_Index'Base := 0;
                           Column : Sudoku_Index'Base := 1;
                           Board : Board_Access) return Sudoku_Work
       is
          Next_Row : Sudoku_Index'Base := Row;
          Next_Column : Sudoku_Index'Base := Column;
       begin

          Search_Loop : loop
             Next_Row := Next_Row + 1;

             if Next_Row > Max_Range then
                Next_Row := 1;
                Next_Column := Next_Column + 1;

                if Next_Column > Max_Range then

                   Solution_Checker.Note_Solution;

                   return (Row => Sudoku_Index'Last,
                           Column => Sudoku_Index'Last,
                           Scratch_Board => null);
                end if;
             end if;

             exit Search_Loop when Get (Board.all,
                                        Next_Row,
                                        Next_Column) = 0;
          end loop Search_Loop;

          return (Row => Next_Row,
                  Column => Next_Column,
                  Scratch_Board => Board);

       end Next_Work;

       procedure Solution_Check_Sequential (Work : Sudoku_Work) is
       begin

          if Multiple_Solutions or else Work.Scratch_Board = null then

             --  No need to worry about deleting any outstanding boards,
             --  Once we return from Solve, all boards get deleted, 
since the
             --  access type gets finalized
             return;

          end if;

          --  Try all values
          for I in Sudoku_Index'Range loop

             if Is_Valid (Board  => Work.Scratch_Board.all,
                          Row    => Work.Row,
                          Column => Work.Column,
                          Value  => I) then

                --  Same worker proceeds to continue work on same board

                --  Try another solution
                Work.Scratch_Board.all.Values
                  (Work.Row, Work.Column) := I;

                Solution_Check_Sequential
                  (Next_Work (Row    => Work.Row,
                              Column => Work.Column,
                              Board  => Work.Scratch_Board));

                --  Solution didn't work, undo
                Work.Scratch_Board.all.Values
                  (Work.Row, Work.Column) := 0;

             end if;
          end loop;

       end Solution_Check_Sequential;

       Scratch_Board : aliased Sudoku_Board := Board;

    begin

       Solution_Check_Sequential
         (Work => Next_Work (Board => Scratch_Board'Access));

       return Multiple_Solutions;

    end Multiple_Solutions_Exist;

    ---------------------------------------------------------------

    procedure Random_Solution (Board : out Sudoku_Board) is

       --  Note: We do not need to worry about deallocating scratch boards
       --  that were allocated from the heap, since they will all get
       --  automatically deallocated when this access type goes out of 
scope,
       --  i.e. before returning from Solve
       type Board_Access is access all Sudoku_Board;

       type Sudoku_Work is
          record
             Row, Column   : Sudoku_Index'Base;
             Scratch_Board : Board_Access;
          end record;

       Done : Boolean := False;

       protected Store_Result is
          procedure Store (Result : Sudoku_Board);
       end Store_Result;

       protected body Store_Result is
          procedure Store (Result : Sudoku_Board) is
          begin
             Board := Result;
             Done   := True;
          end Store;
       end Store_Result;

       function Next_Work (Row : Sudoku_Index'Base := 0;
                           Column : Sudoku_Index'Base := 1;
                           Board : Board_Access) return Sudoku_Work;

       procedure Generate_Random_Solution (Work : Sudoku_Work)
       is
          Start_Value : constant Sudoku_Solution_Value :=
            Random_Index.Random (Generator);
       begin

          if Done then

             --  No need to worry about deleting any outstanding boards,
             --  Once we return from Solve, all boards get deleted, 
since the
             --  access type gets finalized
             return;

          end if;

          --  Try all values
          for I in Sudoku_Index'Range loop
             declare
                Value : constant Sudoku_Solution_Value :=
                  (if I + Start_Value - 1 > Max_Range then
                   I + Start_Value - 1 - Max_Range else I + Start_Value 
- 1);
             begin

                if Is_Valid (Board  => Work.Scratch_Board.all,
                             Row    => Work.Row,
                             Column => Work.Column,
                             Value  => Value) then

                   --  Same worker proceeds to continue work on same board

                   --  Try another solution
                   Work.Scratch_Board.all.Values
                     (Work.Row, Work.Column) := Value;

                   Generate_Random_Solution
                     (Next_Work (Row    => Work.Row,
                                 Column => Work.Column,
                                 Board  => Work.Scratch_Board));

                   --  Solution didn't work, undo
                   Work.Scratch_Board.all.Values
                     (Work.Row, Work.Column) := 0;

                end if;
             end;
          end loop;

       end Generate_Random_Solution;

       function Next_Work (Row : Sudoku_Index'Base := 0;
                           Column : Sudoku_Index'Base := 1;
                           Board : Board_Access) return Sudoku_Work
       is
          Next_Row : Sudoku_Index'Base := Row;
          Next_Column : Sudoku_Index'Base := Column;
       begin

          Search_Loop : loop
             Next_Row := Next_Row + 1;

             if Next_Row > Max_Range then
                Next_Row := 1;
                Next_Column := Next_Column + 1;

                if Next_Column > Max_Range then

                   Store_Result.Store (Board.all);

                   return (Row => Sudoku_Index'Last,
                           Column => Sudoku_Index'Last,
                           Scratch_Board => null);
                end if;
             end if;

             exit Search_Loop when Get (Board.all,
                                        Next_Row,
                                        Next_Column) = 0;
          end loop Search_Loop;

          return (Row => Next_Row,
                  Column => Next_Column,
                  Scratch_Board => Board);

       end Next_Work;

       Scratch_Board : aliased Sudoku_Board := Board;

    begin

       Initialize (Scratch_Board);

       Generate_Random_Solution (Next_Work (Board => Scratch_Board'Access));

    end Random_Solution;

    ---------------------------------------------------------------

    procedure Set
      (Board       : in out Sudoku_Board;
       Row, Column : Sudoku_Index;
       Value       : Sudoku_Solution_Value) is
    begin
       Board.Values (Row, Column) := Value;
    end Set;

    ---------------------------------------------------------------

    procedure Solve (Board : in out Sudoku_Board) is

       --  Note: We do not need to worry about deallocating scratch boards
       --  that were allocated from the heap, since they will all get
       --  automatically deallocated when this access type goes out of 
scope,
       --  i.e. before returning from Solve
       type Board_Access is access all Sudoku_Board;

       type Sudoku_Work is
          record
             Row, Column   : Sudoku_Index'Base;
             Scratch_Board : Board_Access;
          end record;

       Done : Boolean := False;

       protected Store_Result is
          procedure Store (Result : Sudoku_Board);
       private
          Solved : Boolean := False;
       end Store_Result;

       protected body Store_Result is
          procedure Store (Result : Sudoku_Board) is
          begin
             if not Solved then
                Board := Result;
                Solved := True;
                Done   := True;
             end if;
          end Store;
       end Store_Result;

       function Next_Work (Row : Sudoku_Index'Base := 0;
                           Column : Sudoku_Index'Base := 1;
                           Board : Board_Access) return Sudoku_Work
       is
          Next_Row : Sudoku_Index'Base := Row;
          Next_Column : Sudoku_Index'Base := Column;
       begin

          Search_Loop : loop
             Next_Row := Next_Row + 1;

             if Next_Row > Max_Range then
                Next_Row := 1;
                Next_Column := Next_Column + 1;

                if Next_Column > Max_Range then

                   Store_Result.Store (Board.all);

                   return (Row => Sudoku_Index'Last,
                           Column => Sudoku_Index'Last,
                           Scratch_Board => null);
                end if;
             end if;

             exit Search_Loop when Get (Board.all,
                                        Next_Row,
                                        Next_Column) = 0;
          end loop Search_Loop;

          return (Row => Next_Row,
                  Column => Next_Column,
                  Scratch_Board => Board);

       end Next_Work;

       procedure Solve_Sequential (Work : Sudoku_Work) is
       begin

          if Done then

             --  No need to worry about deleting any outstanding boards,
             --  Once we return from Solve, all boards get deleted, 
since the
             --  access type gets finalized
             return;

          end if;

          --  Try all values
          for I in Sudoku_Index'Range loop

             if Is_Valid (Board  => Work.Scratch_Board.all,
                          Row    => Work.Row,
                          Column => Work.Column,
                          Value  => I) then

                --  Same worker proceeds to continue work on same board

                --  Try another solution
                Work.Scratch_Board.all.Values
                  (Work.Row, Work.Column) := I;

                Solve_Sequential (Next_Work (Row    => Work.Row,
                                             Column => Work.Column,
                                             Board  => Work.Scratch_Board));

                --  Solution didn't work, undo
                Work.Scratch_Board.all.Values
                  (Work.Row, Work.Column) := 0;

             end if;
          end loop;

       end Solve_Sequential;

       Scratch_Board : aliased Sudoku_Board := Board;

    begin
       Solve_Sequential (Next_Work (Board => Scratch_Board'Access));
    end Solve;

    ---------------------------------------------------------------

    function Value_In_Diagonal
      (Board    : Sudoku_Board;
       Row, Col : Sudoku_Index;
       Value    : Sudoku_Solution_Value) return Boolean is
    begin

       if Row = Col then
          return
            (for some I in Board.Values'Range (1) =>
               Board.Values (I, I) = Value);
       else
          return
            (for some I in Board.Values'Range (1) =>
               Board.Values (Max_Range + 1 - I, I) = Value);
       end if;

    end Value_In_Diagonal;

    ---------------------------------------------------------------

    function Value_In_Sector
      (Board : Sudoku_Board;
       Row, Col : Sudoku_Index;
       Value : Sudoku_Solution_Value)
       return Boolean
    is
       Start_Row : constant Sudoku_Index :=
         1 + ((Sudoku_Index'Base (Row) - 1) / N) * N;
       Start_Col : constant Sudoku_Index :=
         1 + ((Sudoku_Index'Base (Col) - 1) / N) * N;
    begin
       for I in Start_Row .. Start_Row + N - 1 loop
          for J in Start_Col .. Start_Col + N - 1 loop
             if Board.Values (I, J) = Value then
                return True;
             end if;
          end loop;
       end loop;

       return False;

    end Value_In_Sector;

end Sequential_Sudoku;