Keskustelu: Koodit: PL/I: Sudokun ratkaisu

*PROCESS MARGINS(1,120) LIBS(SINGLE,STATIC);
*PROCESS OPTIMIZE(2) DFT(REORDER);


 sudoku: proc(parms) options(main);
   dcl parms char (100) var;

   define alias bits bit(9) aligned;
   dcl total(81) type bits;
   dcl matrix(9, 9) type bits based(p);
   dcl p pointer;
   dcl box(9, 3, 3) type bits defined (total(trunc((1sub-1)/3) * 27 +
       mod(1sub-1, 3) * 3 + (2sub-1) * 9 + 3sub));

   dcl posbit(0:9) type bits
       init('000000000'b, '100000000'b, '010000000'b, '001000000'b,
            '000100000'b, '000010000'b, '000001000'b, '000000100'b,
            '000000010'b, '000000001'b);

   dcl solutions(81) type bits controlled;

   dcl (i, j) fixed bin(31);
   dcl temp bit(1);
   dcl (start, finish) float bin(53);
   dcl result fixed dec(15,4);

   dcl buffer char(81);
   dcl in file;

   /* ON UNIT for the Sudoku data conversion */
   on conversion
     begin;
       put skip
         list('Sudoku data not valid.');
       stop;
     end;

   /* ON UNIT to display info about the usage */
   on undefinedfile(in)
     begin;
       put skip
         list('Usage: ' || procedurename() || ' /filename');
       stop;
     end;

   open file(in)
     title ('/'||parms||',type(fixed), recsize(81)') record input;

   /* Ignore the endfile condition */
   on endfile(in);

   /* Read the Sudoku data into buffer as one record */
   read file(in) into(buffer);
   close file(in);

   /* Convert numbers -> position bit presentation   */
   /* and assign into the Sudoku board               */
   do i = 1 to 81;
     total(i) = posbit(substr(buffer, i, 1));
   end;

   p = addr(total);

   /* Start solving the Sudoku */
   start = secs();
   temp = solve();
   finish = secs();
   result = finish - start + 0.00005;
   put skip list('Number of solutions: ' || trim(allocation(solutions)));
   put skip(2) list('Time: ' || trim(result) || ' seconds');

   /* display the solved Sudoku, if solution exist */
   p = addr(solutions);
   if allocation(solutions) > 0 then
     do while(allocation(solutions) ^= 0);
       put skip(4);
       do i = 1 to 9;
         do j = 1 to 9;
           put edit(trim(index(matrix(i, j), '1'b))) (a(3));
           if mod(j,3) = 0 then put edit(" ") (a(1));
         end;
         if mod(i,3) = 0 then
           put skip(3);
         else
           put skip(2);
       end;
       free solutions;
       p = addr(solutions);
     end;
   else put skip(2) list('Impossible!');


   /*************************************/
   /* Solve Sudoku                      */
   /*************************************/
   solve: proc recursive returns(bit(1));
     dcl (i, j, k) fixed bin(31);
     dcl result type bits;

     /* find free cell */
     do i = 1 to 9;
       do j = 1 to 9;
         if matrix(i, j) = posbit(0) then goto skip;
       end;
     end;

     /* Validate fully filled Sudoku. */
     do i = 1 to 9;
       do j = 1 to 9;
         k = index(matrix(i, j), '1'b);
         matrix(i, j) = posbit(0);
         result = ^(any(matrix(i, *)) | any(matrix(*, j)) |
                  any(box(numbox(i, j), *, *)));
         matrix(i, j) = posbit(k);
         if index(result, '1'b) ^= k then return('0'b);
       end;
     end;

     return('1'b);
    skip:

     result = ^(any(matrix(i, *)) | any(matrix(*, j)) |
              any(box(numbox(i, j), *, *)));
     k = 0;
     do forever;
       k = search(result, '1'b, k+1);
       if k = 0 then return('0'b);
       matrix(i, j) = posbit(k);
       if solve() then
         do;
           allocate solutions;
           solutions = total;
         end;
       matrix(i, j) = posbit(0);
     end;
   end solve;


   /************************************************/
   /* Returns the box number for the sudoku coords */
   /************************************************/
   numbox: proc(i, j) returns(fixed bin(31));
     dcl (i, j) fixed bin(31);

     dcl lookup (9, 9) fixed bin(31) static init( (3)1, (3)2, (3)3,
                                                  (3)1, (3)2, (3)3,
                                                  (3)1, (3)2, (3)3,
                                                  (3)4, (3)5, (3)6,
                                                  (3)4, (3)5, (3)6,
                                                  (3)4, (3)5, (3)6,
                                                  (3)7, (3)8, (3)9,
                                                  (3)7, (3)8, (3)9,
                                                  (3)7, (3)8, (3)9 );

     return(lookup(i, j));
   end numbox;

 end sudoku;