(* http://www.makam.org/ *)
program tarea2 (input,output);
type
  rango = 1..9;
	digito = '0'..'9';
	ttable = array[1..9,1..9] of digito;
	conjdedigito = array[1..10] of char;
	tcand = array[1..9,1..9] of conjdedigito;

procedure inicializar_sudoku(var original:ttable);
const
	veces = 9;
var
	i,j:integer;
begin
	for i:= 1 to veces do
            begin
                 for j:= 1 to veces do
                     read(original[i,j]);
                 readln
            end
end;

procedure inicializar_matriz_candidato( var candidato:tcand);
const
	centinela = '@';
        veces = 9;
var
	i,j,k:integer;
begin
	for i:= 1 to veces do
		for j:= 1 to veces do
                    begin
				for k:= 1 to veces do
                                        candidato[i,j,k]:= chr(k + 48);
                                candidato[i,j,10]:= centinela
                    end
end;

function comienzoRegion(i:rango): Rango;
begin
	comienzoregion:= (i - 1) div 3 * 3 + 1
end;

function finRegion (i:rango): Rango;
begin
	finRegion:= ((i - 1) div 3 + 1) * 3
end;

procedure actualizar_candidato(i,j:integer; original:ttable; var candidato:tcand);
const
     centinela = '@';
var
        temp,temp1:integer;
	fin:boolean;
	k,p,t:integer;

begin
        fin:= false;
        temp:= j;
	temp1:= i;
	j:= 1;
	repeat
		(* CHEQUEO DE FILA *)
		while (j <= 9) and (original[i,j] = '0') do
			j:= j + 1;
		if (j > 9) then
			fin:= true
		else
			begin
				k:= 1;
				while (candidato[temp1,temp,k] <> centinela ) and ( candidato[temp1,temp,k] <> original[i,j] ) do
					k:= k + 1;
				if (candidato[temp1,temp,k] <> centinela) then
				(* QUITA ELEMENTO *)
					repeat
						candidato[temp1,temp,k]:= candidato[i,temp,k+1];
						k:= k + 1
					until
						(candidato[temp1,temp,k-1] = centinela);
                                j:= j + 1
			end
	until
        	(fin);
	(* CHEQUEO DE COLUMNA *)
	fin:= false;
	i:= 1;
	repeat
		while(i <= 9) and (original[i,temp] = '0') do
			i:= i + 1;
		if (i > 9) then
			fin:= true
		else
			begin
				k:= 1;
				while  (candidato[temp1,temp,k] <> centinela) and ( candidato[temp1,temp,k] <> original[i,temp] ) do
					k:= k + 1;
				if (candidato[temp1,temp,k] <> centinela) then
                                                repeat
							candidato[temp1,temp,k]:= candidato[temp1,temp,k+1];
							k:= k + 1
						until
							(candidato[temp1,temp,k-1] = centinela);
                                i:= i + 1

			end
	until
		(fin);
        (* CHEQUEO POR REGION *)
	for t:= comienzoRegion(temp1) to finRegion(temp1) do
		for p:= comienzoRegion(temp) to finRegion(temp) do
                    begin
                         if ( original[t,p] <> '0') then
			    begin
				k:= 1;
				while (candidato[temp1,temp,k] <> centinela) and (candidato[temp1,temp,k] <> original[t,p]) do
					k:= k + 1;
				if (candidato[temp1,temp,k] <> centinela) then
					begin
						repeat
							candidato[temp1,temp,k]:= candidato[temp1,temp,k+1];
							k:= k + 1;
						until
							(candidato[temp1,temp,k-1] = centinela)
					end
                            end
                    end
end;
procedure actualizar_matriz_candidato(original:ttable; var candidato:tcand);
var
	i,j:integer;
begin
     for i:= 1 to 9 do
		for j:= 1 to 9 do
                    begin
                         if (original[i,j] = '0') then
                            actualizar_candidato(i,j,original,candidato)
                    end;
end;
function es_unico(i,j:integer; candidato:tcand):boolean;
const
	centinela = '@';
begin
	if (candidato[i,j,2] = centinela) then
		es_unico:= true
	else
		es_unico:= false
end;

procedure obtener_unico(i,j:integer; candidato:tcand; var original:ttable);
begin
	original[i,j]:= candidato[i,j,1]
end;

procedure desplegar_unico(i,j:integer; original:ttable);
begin
	writeln('(',i,',',j,') -> ',original[i,j],' (unico)')
end;

procedure es_fila_exc(i,j:integer; original:ttable; candidato:tcand; var esta_fila_exc:boolean; var aux1:integer);
const
	centinela = '@';
var
	cambio_cand: boolean;
	k,aux:integer;
begin
	k:= 1;
	aux:= j;
	aux1:= k;
	j:= 1;
	esta_fila_exc:= (j > 9);
	cambio_cand:= false;
	(* CHEQUEO DE EN FILA *)
	repeat
		repeat
			while (not esta_fila_exc) and ((aux = j) or (original[i,j] <> '0')) do
				begin
					j:= j + 1;
					esta_fila_exc:= (j > 9)
				end;
			if (not esta_fila_exc) then
				begin
					while (candidato[i,j,k] <> centinela) and (candidato[i,aux,aux1] <> candidato[i,j,k]) do
						k:= k + 1;
					if (candidato[i,j,k] <> centinela) then
						cambio_cand:= true;
					j:= j + 1;
					k:= 1;
					esta_fila_exc:= (j > 9)
				end
		until
			(esta_fila_exc) or (cambio_cand);
		if (cambio_cand) then
			begin
				aux1:= aux1 + 1;
				j:= 1;
				cambio_cand:= false;
				esta_fila_exc:= (j > 9)
			end;
	until
		(esta_fila_exc) or (candidato[i,aux,aux1] = centinela)
end;

procedure es_columna_exc(i,j:integer; original:ttable; candidato:tcand; var esta_col_exc:boolean; var aux1:integer);
const
	centinela = '@';
var
	cambio_cand: boolean;
	k,aux:integer;
begin
	k:= 1;
	aux:= i;
	aux1:= k;
	i:= 1;
        esta_col_exc:= (i > 9);
	cambio_cand:= false;
	(* CHEQUEO EN COLUMNA  *)
	repeat
		repeat
			while (not esta_col_exc) and ((aux = i) or (original[i,j] <> '0')) do
                              begin
                                   i:= i + 1;
                                   esta_col_exc:= (i > 9)
                              end;
			if (not esta_col_exc) then
				begin
					while (candidato[i,j,k] <> centinela) and (candidato[aux,j,aux1] <> candidato[i,j,k]) do
						k:= k + 1;
					if (candidato[i,j,k] <> centinela) then
						cambio_cand:= true;
					i:= i + 1;
					k:= 1;
					esta_col_exc:= (i > 9)
				end
		until
			(esta_col_exc) or (cambio_cand);
		if (cambio_cand) then
			begin
				aux1:= aux1 + 1;
				i:= 1;
				cambio_cand:= false;
                                esta_col_exc:= (i > 9)
                        end;
	until
		(esta_col_exc) or (candidato[aux,j,aux1] = centinela)
end;

procedure es_region_exc(i,j:integer; original:ttable; candidato:tcand; var esta_reg_exc:boolean; var aux1:integer);
const
     centinela = '@';
var
        camb_fila,cambio_cand:boolean;
	temp,temp1,m,n,k:integer;
begin
	temp:= i;
	temp1:= j;
	esta_reg_exc:= (i > finRegion(temp));
	cambio_cand:= false;
	i:= comienzoRegion(temp);
	j:= comienzoRegion(temp1);
        k:= 1;
	aux1:= k;
        (* CHEQUEO EN REGION *)
	repeat
		repeat
			while (j <= finRegion(temp1)) and ( ((i = temp) and (j = temp1)) or (original[i,j] <> '0') ) do
				j:= j + 1;
			if (j > finRegion(temp1)) then
				camb_fila:= true
			else
				begin
					while (candidato[i,j,k] <> centinela) and (candidato[temp,temp1,aux1] <> candidato[i,j,k]) do
				 		k:= k + 1;
					if (candidato[m,n,k] <> centinela) then
						cambio_cand:= true;
					j:= j + 1;
					k:= 1
                                end
		until
			(camb_fila) or (cambio_cand);
		if (camb_fila) then
			begin
				i:= i + 1;
				j:= comienzoRegion(temp1);
                                camb_fila:= false
			end
		else
			begin
				aux1:= aux1 + 1;
				i:= comienzoRegion(temp);
				j:= comienzoRegion(temp1);
				cambio_cand:= false
			end
	until
		(esta_reg_exc) or (candidato[temp,temp1,aux1] = centinela)
end;

procedure obtener_exclusivo(i,j,aux1:integer; candidato:tcand; var original:ttable);
begin
	original[i,j]:= candidato[i,j,aux1]
end;

procedure desplegar_exclusivo(i,j,aux1:integer; original:ttable);
begin
	writeln('(',i,',',j,') -> ',original[i,j],' (exclusivo)')
end;

procedure cont_celdas_vacias(original:ttable; var celdas_vacias:integer);
var
	i,j:integer;
begin
	celdas_vacias:= 0;
	for i:= 1 to 9 do
		for j:= 1 to 9 do
			if (original[i,j] = '0') then
				celdas_vacias:= celdas_vacias + 1

end;

function sudoku_completo(celdas_vacias:integer):boolean;
begin
	if (celdas_vacias = 0) then
		sudoku_completo:= true
	else
		sudoku_completo:= false
end;

function no_hubo_cambios(celdas_vacias,temp:integer):boolean;
begin
	if (celdas_vacias = temp) then
		no_hubo_cambios:= true
	else
		no_hubo_cambios:= false
end;

procedure recorrida_sudoku(var recorrida:integer);
begin
	recorrida:= recorrida + 1
end;

procedure desplegar_recorrida_sudoku(recorrida:integer);
begin
	writeln('Recorrida: ',recorrida)
end;

procedure desplegar_sudoku(original:ttable);
var
	i,j:integer;
begin
	for i:= 1 to 9 do
		begin
			for j:= 1 to 9 do
				write(original[i,j],' ');
			writeln
		end
end;

var
	i,j,aux1,celdas_vacias,temp,recorrida:integer;
        original:ttable;
	candidato:tcand;
	esta_fila_exc,esta_col_exc,esta_reg_exc:boolean;

(* PROGRAMA PRINCIPAL *)
begin
	inicializar_sudoku(original);
	inicializar_matriz_candidato(candidato);
     	actualizar_matriz_candidato(original,candidato);
        cont_celdas_vacias(original,celdas_vacias);
	recorrida:= 0;
	repeat
                recorrida_sudoku(recorrida);
		desplegar_recorrida_sudoku(recorrida);
		temp:= celdas_vacias;
		for i:= 1 to 9 do
			for j:= 1 to 9 do
                            if (original[i,j] = '0') then
                            	if ( es_unico(i,j,candidato) ) then
					begin
						obtener_unico(i,j,candidato,original);
						desplegar_unico(i,j,original);
                                                actualizar_matriz_candidato(original,candidato)
					end
				else
					begin
                                                es_fila_exc(i,j,original,candidato,esta_fila_exc,aux1);
                                        	if (esta_fila_exc) then
							begin
								obtener_exclusivo(i,j,aux1,candidato,original);
								desplegar_exclusivo(i,j,aux1,original);
								actualizar_matriz_candidato(original,candidato)
							end
						else
                                                        begin
                                                             es_columna_exc(i,j,original,candidato,esta_col_exc,aux1);
							     if (esta_col_exc) then
                                                                begin
                                                                	obtener_exclusivo(i,j,aux1,candidato,original);
                                                                	desplegar_exclusivo(i,j,aux1,original);
									actualizar_matriz_candidato(original,candidato)
								end
							     else
                                                                	begin
										es_region_exc(i,j,original,candidato,esta_reg_exc,aux1);
										if (esta_reg_exc) then
											begin
												obtener_exclusivo(i,j,aux1,candidato,original);
												desplegar_exclusivo(i,j,aux1,original);
												actualizar_matriz_candidato(original,candidato)
											end
									end
							end
					end;
		cont_celdas_vacias(original,celdas_vacias)
	until
		( sudoku_completo(celdas_vacias) ) or ( no_hubo_cambios(celdas_vacias,temp) );
	if (sudoku_completo(celdas_vacias) ) then
		desplegar_sudoku(original)
	else
		begin
			writeln('No se encontro candidato unico o exclusivo');
			desplegar_sudoku(original)
		end
end.