Math Is Fun Forum

program Sudoku_solver;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes
  { you can add units after this };

{$IFDEF WINDOWS}{$R Sudoku.rc}{$ENDIF}

const
  max=9;

type
  niz=array[1..max] of integer;
  matrica=array[1..max] of niz;

var
  a:matrica;
  i,j:integer;
  ok:boolean;

function row(a:matrica;i1,j1:integer):boolean;
var
  j:integer;
  b:boolean;
begin
  b:=true;
  for j:=1 to 9 do
    if j<>j1 then
      if a[i1][j]=a[i1][j1] then
        b:=false;
  red:=b;
end;

function column(a:matrica;i1,j1:integer):boolean;
var
  i:integer;
  b:boolean;
begin
  b:=true;
  for i:=1 to 9 do
    if i<>i1 then
      if a[i][j1]=a[i1][j1] then
        b:=false;
  vrsta:=b;
end;

function square(a:matrica;i1,j1:integer):boolean;
var
  i,j,k,l:integer;
  b:boolean;
begin
  b:=true;
  case i1 of
    1,2,3: begin
             k:=0;
             i:=3
           end;
    4,5,6: begin
             k:=3;
             i:=6;
           end;
    7,8,9: begin
             k:=6;
             i:=9;
           end;
  end;
  case j1 of
    1,2,3: begin
             l:=0;
             j:=3
           end;
    4,5,6: begin
             l:=3;
             j:=6;
           end;
    7,8,9: begin
             l:=6;
             j:=9;
           end;
  end;
  while (k<=i) do
  begin
    k:=k+1;
    while (l<=j) do
    begin
      l:=l+1;
      if (k<>i1) and (l<>j1) then
        if a[k][l]=a[i1][j1] then
          b:=false;
    end;
  end;
  kvadrat:=b;
end;

function pos(a:matrica;i,j:integer):boolean;
begin
  poz:=row(a,i,j) and column(a,i,j) and square(a,i,j);
end;

procedure sudoku(var a:matrica;n,i1,j1:integer;ok:boolean);
var
  i,j,k:integer;
  b:boolean;
begin
  i:=i1;
  j:=j1;
  a[i][j]:=n;
  ok:=false;
  b:=true;
  if poz(a,i,j) then
  begin
    ok:=true;
    i:=0;
    j:=0;
    while (b=true) and (i<=max) do
    begin
      i:=i+1;
      while (b=true) and (j<=max) do
      begin
        j:=j+1;
        if a[i][j]=0 then
          b:=false;
      end;
    end;
    if b=false then
    begin
      k:=0;
      ok:=false;
      while (k<=9) and not ok do
      begin
        k:=k+1;
        sudoku(a,k,i,j,ok);
      end;
    end;
  end;
end;

begin
  writeln('Enter the Sudoku: ');
  for i:=1 to 9 do
  begin
    for j:=1 to 9 do
      read(a[i][j]);
    readln;
  end;
  k:=0;
  ok:=false;
  while (k<=9) and not ok do
  begin
    k:=k+1;
    sudoku(a,k,i,j,ok);
  end;
  if ok then
  begin
    writeln('The solution is: ')
    for i:=1 to 9 do
    begin
      for j:=1 to 9 do
        write(a[i][j]);
      writeln;
    end;
  end
  else writeln('Sudoku cannot be solved!!!');
  readln;
end.