SudokuSolver, Pascal

SudokuSolver

program SudokuSolver;

const ONBEKEND = 0;

var sudoku: array[1..9,1..9] of integer;
    blokkade: array[1..9,1..9,1..9] of integer;
    rijwaarde: array [1..81] of integer;
    kolomwaarde: array [1..81] of integer;

{==============================================================================}

procedure Initialiseer;

var veld,
    rij, kolom: integer;
    waarde: integer;

begin
	for rij := 1 to 9 do
		for kolom := 1 to 9 do
			begin
				veld := (rij-1)*9 + kolom;
				rijwaarde[veld] := rij;
				kolomwaarde[veld] := kolom;
				for waarde := 1 to 9 do
					blokkade[rij,kolom,waarde] := 0;
			end;
end;

{==============================================================================}

procedure CorrigeerBlokkades(rij, kolom: integer;
                             waarde: integer;
							 correctie: integer);

var bovenkant,
    linkerkant: integer;
	r, k: integer;
	
begin
	bovenkant := rij - ( (rij-1) mod 3 );
	linkerkant := kolom - ( (kolom-1) mod 3 );
	
	for r := 1 to 9 do
		blokkade [r,kolom,waarde] := blokkade [r,kolom,waarde] + correctie;
	for k := 1 to 9 do
		blokkade [rij,k,waarde] := blokkade [rij,k,waarde] + correctie;
	for r := bovenkant to bovenkant+2 do
		for k := linkerkant to linkerkant+2 do
			blokkade[r,k,waarde] := blokkade[r,k,waarde] + correctie;
end;

{==============================================================================}

procedure LeesSudoku;

var rij, kolom: integer;
    waarde: integer;

begin
	for rij := 1 to 9 do
		begin
			for kolom := 1 to 9 do
				begin
					read(waarde);
					sudoku[rij,kolom] := waarde;
					if waarde <> ONBEKEND then
						CorrigeerBlokkades(rij, kolom, waarde, 1);
				end;
			readln;
		end;
end;

{==============================================================================}

procedure ToonOplossing;

var rij, kolom: integer;

begin
	for rij := 1 to 9 do
		begin
			for kolom := 1 to 9 do
				write(sudoku[rij,kolom],' ');
			writeln;
		end;
    writeln;
end;

{==============================================================================}

procedure VulVerplicht;

var ingevuld: boolean;
    rij, kolom: integer;
    waarde: integer;
    verplichte_waarde: integer;
    aantal: integer;

begin
    repeat
        ingevuld := false;
        for rij := 1 to 9 do
            for kolom := 1 to 9 do
                if sudoku[rij,kolom] = ONBEkEND then
                    begin
                        aantal := 0;                
                        for waarde := 1 to 9 do
                            if blokkade[rij,kolom,waarde]=0 then
                                begin
                                    verplichte_waarde := waarde;
                                    aantal := aantal+1;
                                end;
                        if aantal=1 then
                            begin
                                sudoku[rij,kolom] := verplichte_waarde;
                                CorrigeerBlokkades(rij, kolom, verplichte_waarde, 1);
                                ingevuld := true;
                            end;
                    end;
    until not ingevuld;
end;

{==============================================================================}

procedure ZoekOplossing (veld: integer);

var rij, kolom: integer;
    waarde: integer;

begin
	if veld>81 then
		ToonOplossing
	else
		begin
			rij := rijwaarde[veld];
			kolom := kolomwaarde[veld];
            
			if sudoku[rij,kolom] = ONBEKEND then
				begin
					for waarde := 1 to 9 do
						if blokkade[rij, kolom, waarde]=0 then
							begin
								sudoku[rij,kolom] := waarde;
								CorrigeerBlokkades (rij, kolom, waarde, 1);
								ZoekOplossing(veld+1);
								CorrigeerBlokkades (rij, kolom, waarde, -1);
							end;
					sudoku[rij,kolom] := ONBEKEND;
				end
			else
				ZoekOplossing(veld+1);
		end;
end;

{==============================================================================}
		
begin
	Initialiseer;
	LeesSudoku;
    VulVerplicht;  
	ZoekOplossing(1);
end.

(*
Testinvoer:
0 1 0 0 0 0 0 2 0
0 3 4 5 0 0 6 0 0
0 8 0 0 0 6 7 0 0
0 0 3 0 0 0 0 4 0
0 0 0 0 2 0 0 0 0
6 0 0 0 0 4 2 0 0
0 0 0 0 0 0 0 0 0
0 0 5 0 7 0 1 3 8
1 0 0 0 6 9 0 0 0
*)


run \| edit \| history \| help	0