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í.