Recursive algorithm to solve sudoku

A Pascal edition of a solution presented in a YouTube video. The solution presented was in Python and is the simplest brute force solution possible.

The search for a solution is very dependent on the number of possible values in each cell. The more, in the early cells, the longer the back-tracking. I realised that it isn't necessary to progress linearly in the grid. You can go in any order. It can be optimised by sorting the grid cells based on how many possible values each cell can have. The fewer, the earlier they get tried out. It finds the first solution faster, but finding all solutions will take the same time. First comes the simple solution, then the optimised one.

Simple Pascal edition

{$L1500 - Stack size in bytes }
{ Solve sudoku with recursive algoritm }
PROGRAM sudoko;

VAR
  grid : ARRAY [0..8,0..8] OF integer;

PROCEDURE fillgrid;
VAR
  i,j : integer;
BEGIN
  FOR j := 0 TO 8 DO
      FOR i := 0 TO 8 DO
         grid[j,i] := 0;

  grid[0,0] := 5; grid[0,1] := 3; grid[0,4] := 7;
  grid[1,0] := 6; grid[1,3] := 1; grid[1,4] := 9; grid[1,5] := 5;
  grid[2,1] := 9; grid[2,2] := 8; grid[2,7] := 6;
  grid[3,0] := 8; grid[3,4] := 6; grid[3,8] := 3;
  grid[4,0] := 4; grid[4,3] := 8; grid[4,5] := 3; grid[4,8] := 1;
  grid[5,0] := 7; grid[5,4] := 2; grid[5,8] := 6;
  grid[6,1] := 6; grid[6,6] := 2; grid[6,7] := 8;
  grid[7,3] := 4; grid[7,4] := 1; grid[7,5] := 9; grid[7,8] := 5;
  grid[8,4] := 8; grid[8,7] := 7; grid[8,8] := 9
END;

PROCEDURE printgrid;
VAR
  i,j : integer;

BEGIN
  FOR j := 0 TO 8 DO
    BEGIN
      FOR i := 0 TO 8 DO
         write(grid[j,i]:2);
      writeln
    END;
    writeln
END;

FUNCTION possible(y,x,n : integer):boolean;
LABEL
  100;
VAR
  i,j,x0,y0 : integer;
BEGIN
  possible := false;
  FOR i := 0 TO 8 DO
    IF grid[y,i] = n THEN
      GOTO 100;
  FOR i := 0 TO 8 DO
    IF grid[i,x] = n THEN
      GOTO 100;
  x0 := (x DIV 3) * 3;
  y0 := (y DIV 3) * 3;
  FOR i := 0 TO 2 DO
    FOR j := 0 TO 2 DO
      IF grid[y0+i,x0+j] = n THEN
        GOTO 100;
  possible := true;
100:
END;

PROCEDURE solve;
LABEL 200;
VAR
  n,x,y : integer;
BEGIN
   FOR y := 0 TO 8 DO
     FOR x := 0 TO 8 DO
       IF grid[y,x] = 0 THEN
         BEGIN
           FOR n := 1 TO 9 DO
             IF possible(y,x,n) THEN
               BEGIN
                 grid[y,x] := n;
                 solve;
                 grid[y,x] := 0
               END;
           GOTO 200
         END;
   printgrid;
200:
END;

BEGIN
  fillgrid;
  writeln('Initial grid:');
  printgrid;
  writeln('Solutions:');
  solve
END.

Edition with sorting of the grid

{$L5500 - Stack size in bytes }
{ Solve sudoku with recursive algoritm.
  But first sort the grid on number of guides to
  shorten the search.
}
PROGRAM sudoko;

TYPE
  valset = SET OF 1..9;
  state = RECORD
    row,col,numelm : integer;
    guides : valset
  END;
  statearr = ARRAY [0..80] OF state;

VAR
  grid : ARRAY [0..8,0..8] OF integer;
  scanorder : statearr;

{ Bubble sort of 81 values }
PROCEDURE sort(VAR list: statearr);
VAR
  i,j: integer;
  t: state;
BEGIN
  FOR i := 80 DOWNTO 2 DO
    FOR j := 0 TO i - 1 DO
      IF list[j].numelm < list[j + 1].numelm THEN
      BEGIN
        t := list[j];
        list[j] := list[j + 1];
        list[j + 1] := t;
      END;
END;

PROCEDURE fillgrid;
VAR
  i,j : integer;
BEGIN
  FOR j := 0 TO 8 DO
      FOR i := 0 TO 8 DO
         grid[j,i] := 0;

  grid[0,0] := 5; grid[0,1] := 3; grid[0,4] := 7;
  grid[1,0] := 6; grid[1,3] := 1; grid[1,4] := 9; grid[1,5] := 5;
  grid[2,1] := 9; grid[2,2] := 8; grid[2,7] := 6;
  grid[3,0] := 8; grid[3,4] := 6; grid[3,8] := 3;
  grid[4,0] := 4; grid[4,3] := 8; grid[4,5] := 3; grid[4,8] := 1;
  grid[5,0] := 7; grid[5,4] := 2; grid[5,8] := 6;
  grid[6,1] := 6; grid[6,6] := 2; grid[6,7] := 8;
  grid[7,3] := 4; grid[7,4] := 1; grid[7,5] := 9; grid[7,8] := 5;
  grid[8,4] := 8; grid[8,7] := 7; grid[8,8] := 9
END;

PROCEDURE printgrid;
VAR
  i,j : integer;
BEGIN
  FOR j := 0 TO 8 DO
    BEGIN
      FOR i := 0 TO 8 DO
         write(grid[j,i]:2);
      writeln
    END;
    writeln
END;

PROCEDURE scancell(y,x : integer; VAR n : valset);
VAR
  i,j,x0,y0 : integer;
BEGIN
  n := [];
  FOR i := 0 TO 8 DO
    IF grid[y,i] <> 0 THEN
      n := n + [grid[y,i]];
  FOR i := 0 TO 8 DO
    IF grid[i,x] <> 0 THEN
      n := n + [grid[i,x]];
  x0 := (x DIV 3) * 3;
  y0 := (y DIV 3) * 3;
  FOR i := 0 TO 2 DO
    FOR j := 0 TO 2 DO
      IF grid[y0+i,x0+j] <> 0 THEN
        n := n + [grid[y0+i,x0+j]];
END;

PROCEDURE scangrid;
VAR
  n,x,y,z : integer;
BEGIN
  FOR y := 0 TO 8 DO
    FOR x := 0 TO 8 DO
      BEGIN
        z := y*9 + x;
        scanorder[z].col := x;
        scanorder[z].row := y;
        scancell(y,x,scanorder[z].guides);
        scanorder[z].numelm := 0;
        FOR n := 1 TO 9 DO
          IF n IN scanorder[z].guides THEN
            scanorder[z].numelm := scanorder[z].numelm + 1;
      END;
  sort(scanorder);
END;

FUNCTION possible(y,x,n : integer):boolean;
LABEL
  100;
VAR
  i,j,x0,y0 : integer;
BEGIN
  possible := false;
  FOR i := 0 TO 8 DO
    IF grid[y,i] = n THEN
      GOTO 100;
  FOR i := 0 TO 8 DO
    IF grid[i,x] = n THEN
      GOTO 100;
  x0 := (x DIV 3) * 3;
  y0 := (y DIV 3) * 3;
  FOR i := 0 TO 2 DO
    FOR j := 0 TO 2 DO
      IF grid[y0+i,x0+j] = n THEN
        GOTO 100;
  possible := true;
100:
END;

PROCEDURE solve;
LABEL 200;
VAR
  n,x,y,z : integer;
BEGIN
   FOR z := 0 TO 80 DO
     BEGIN
       x := scanorder[z].col;
       y := scanorder[z].row;
       IF grid[y,x] = 0 THEN
         BEGIN
           FOR n := 1 TO 9 DO
             IF possible(y,x,n) THEN
               BEGIN
                 grid[y,x] := n;
                 solve;
                 grid[y,x] := 0
               END;
           GOTO 200
         END
     END;
   printgrid;
200:
END;

BEGIN
  fillgrid;
  writeln('Initial grid:');
  printgrid;
  writeln('Solutions:');
  scangrid;
  solve
END.