Sudoku en Delphi

Enviado por admin el Vie, 04/27/2007 - 00:05

El Sudoku es un pasatiempo que últimamente se ha hecho muy popular. El objetivo es rellenar una cuadrícula de 9×9 celdas (81 casillas) dividida en subcuadrículas de 3×3 (también llamadas "cajas" o "regiones") con las cifras del 1 al 9, partiendo de algunos números ya dispuestos en algunas de las celdas. El objetivo es rellenar las celdas vacías, con un número en cada una de ellas, de tal forma que cada columna, fila y región contenga los números del 1 al 9 sólo una vez.

Resolver este problema con un ordenador resulta relativamente sencillo. Usando un simple método de backtracking podríamos llegar a la solución, pero el probar multitud de combinaciones no parece ser un método muy eficiente. Por eso vamos a darle una vuelta de tuerca y primero vamos a simplificar el puzzle rellenando los huecos en los que solo puede colocarse un numero (los que yo llamo obvios). Aplicamos la simplificación varias veces hasta que no existan más números obvios. Muchos sudokus quedaran resueltos después de este paso, son los llamados de "solución única", sin embargo, existen otros en los que no queda mas remedio que aplicar backtracking para averiguar la solución.

El corazón de este programa lo forman las siguientes funciones:

type
  TTablero = Array[0..8,0..8] of Integer; 
 
const
  NUM_FILAS = 9;
  NUM_COLUMNAS = 9;
 
function Fila(Tablero: TTablero; y,n: Integer): boolean;
var
  x: Integer;
begin
  Result:= TRUE;
  x:= 0;
  while (x < NUM_COLUMNAS) and Result do
  begin
    if Tablero[x,y] = n then
      Result:= FALSE;
    inc(x);
  end;
end;
 
function Columna(Tablero: TTablero; x,n: Integer): boolean;
var
  y: Integer;
begin
  Result:= TRUE;
  y:= 0;
  while (y < NUM_FILAS) and Result do
  begin
    if Tablero[x,y] = n then
      Result:= FALSE;
    inc(y);
  end;
end;
 
function Cuadrante(Tablero: TTablero; x,y,n: Integer): boolean;
var
 i,j: Integer;
begin
 Result:= TRUE;
 x:= (x div 3)*3;
 y:= (y div 3)*3;
 for j:= y to y + 2 do
   for i:= x to x + 2 do
     if Tablero[i,j] = n then
     begin
       Result:= FALSE;
       Exit;
     end;
end;
 
function Valido(Tablero: TTablero; x,y,n: Integer): boolean;
begin
  Result:= Fila(Tablero,y,n) and Columna(Tablero,x,n)
    and Cuadrante(Tablero,x,y,n);
end;
 
function Obvio(Tablero: TTablero; x,y: Integer): Integer;
var
 i,j,n: Integer;
begin
 j:= 0; n:= 0;
 for i:=1 to 9 do
   if Valido(Tablero,x,y,i) then
   begin
     n:= i;
     inc(j);
   end;
 if j=1 then
   Result:= n
 else
   Result:= 0;
end;
 
procedure Reducir(var Tablero: TTablero);
var
 x,y: Integer;
 Repetir: Boolean;
begin
 repeat
   Repetir:= FALSE;
   for y:= 0 to NUM_FILAS - 1 do
     for x:= 0 to NUM_COLUMNAS - 1 do
       if Tablero[x,y] = 0 then
       begin
         Tablero[x,y]:= Obvio(Tablero,x,y);
         if Tablero[x,y] > 0 then
           Repetir:= TRUE;
       end;
 until not Repetir;
end;
 
function Resolver(var Tablero: TTablero): Boolean;
var
 x,y,i: Integer;
begin
  Result:= TRUE;
  for y:= 0 to NUM_FILAS - 1 do
   for x:= 0 to NUM_COLUMNAS - 1 do
     if Tablero[x,y] = 0 then
     begin
       Result:= FALSE;
       for i:= 1 to 9 do
         if Valido(Tablero,x,y,i) then
         begin
           Tablero[x,y]:= i;
           if Resolver(Tablero) then
           begin
             Result:= TRUE;
             Exit;
           end else Tablero[x,y]:= 0;
         end;
       Exit;
     end;
end;
 
function Ayudita(var Tablero: TTablero): Boolean;
var
  i,j: Integer;
  T: TTablero;
begin
  Result:= FALSE;
  T:= Tablero;
  if Resolver(T) then
  begin
    for j:= 0 to NUM_FILAS - 1 do
      for i:= 0 to NUM_COLUMNAS - 1 do 
        if Tablero[i,j] <> T[i,j] then
        begin
          Tablero[i,j]:= T[i,j];
          Result:= TRUE;
          Exit;
        end;
  end;
end;
 
procedure GenerarTablero(var Tablero: TTablero; Dificultad: Integer);
var
  i,j,k,l: integer;
begin
  FillChar(Tablero,Sizeof(Tablero),0);
  Randomize;
  i:= 0;
  while i < NUM_COLUMNAS do
  begin
    j:= Random(9)+1;
    if Valido(Tablero, i, 0, j) then
    begin
      Tablero[i,0]:= j;
      inc(i)
    end;
  end;
  Resolver(Tablero);
  k:= 0;
  // Quitamos algunos obvios
  while k < 30 do
  begin
    i:= Random(NUM_COLUMNAS);
    j:= Random(NUM_FILAS);
    if Tablero[i,j] <> 0 then
    begin
      l:= Tablero[i,j];
      Tablero[i,j]:= 0;
      if Obvio(Tablero,i,j)>0 then
        inc(k)
      else
        Tablero[i,j]:= l;
    end;
  end;
  k:= 0;
  // Quitamos algunos que no son obvios
  while k < Dificultad do
  begin
    i:= Random(NUM_COLUMNAS);
    j:= Random(NUM_FILAS);
    if Tablero[i,j] <> 0 then
    begin
      l:= Tablero[i,j];
      Tablero[i,j]:= 0;
      if Obvio(Tablero,i,j)=0 then
        inc(k)
      else
        Tablero[i,j]:= l;
    end;
  end;
end;
 
function TableroValido(Tablero: TTablero): boolean;
var
  i,j,k: Integer;
begin
  for i:= 0 to NUM_COLUMNAS - 1 do
    for j:= 0 to NUM_FILAS - 1 do
    if Tablero[i,j] <> 0 then
      begin
        k:= Tablero[i,j];
        Tablero[i,j]:= 0;
        if not Valido(Tablero,i,j,k) then
        begin
          Tablero[i,j]:= k;
          Result:= FALSE;
          Exit;
        end;
        Tablero[i,j]:= k;
      end;
  Result:= TRUE;
end;

El código completo lo puedes bajar de aquí. Y el programa ya compilado de aquí.