¿Cómo se programa la calculadora de Sudoku?
Rellena los espacios en blanco con espacios (subraya cada vez)
Se puede ingresar por archivo (abre el archivo con un programa compilado) o por teclado.
Compile con Turbo Pascal con parche CRT o utilice Free Pascal (no se garantiza que funcione correctamente)
El tiempo de espera de la muestra no se agota, pero puede que se agote el tiempo de espera para datos especiales (Aún no tengo los datos, es demasiado simple para escribirlo usted mismo, pero los datos especiales básicamente no excederán 0,01 s)
El programa es el siguiente:
programa sdjsq;{Solucionador de Sudoku}
{-------------Llamar a la biblioteca-------------------- -------------- ------------------USES}
usa CRT,Dos;{Usar CRT Dos biblioteca}
{----- --------Definición de tipo de datos--------------------------------- --------------- ---TYPE}
tipo
sz=0..9;{Número, el sublímite del tipo de byte ocupa un byte}
sy=1.9;{igual que sz}
sd=array
para i:=1 a 9 hazlo si; i<>x entonces s:=s-[a[i, y]];
para i:=1 a 9 hazlo si i<>y entonces s:=s-[a[x, i]];
para i:= 1 a 3 hacer para j:=1 a 3 hacer
if ((x-1)div 3*3+i<>x ) y ((y-1)div 3*3+j< >y)
luego s:=s-[a[(x-1)div 3*3+i,(y-1 )div 3*3+j]];
s:=s-[0]
fin
{======= ======Imprimir datos======= ===================================== =PRINT}
procedimiento print( xn,yn,color:byte);
comenzar
gotoxy(2*xn,2*yn); p>
textcolor(color);
textbackground(5+ord(not ((x=xn)y(y=yn)))*(-4-ord(((xn-1) ) div 3+(yn-1) div 3) mod 2=0)));
si a[xn,yn]<>0 entonces escribe(a[xn,yn]) si no, escribe( #32);
gotoxy( 1,1);
fin
{==============Leer; datos usando el teclado========== =================ENTRADA POR TECLADO}
procedimiento inputbkb(var a:sd)
etiqueta 1;
var
xi,yi:byte
c:char; s:ss;i:byte;
comenzar
printk
fillchar(a,sizeof(a),0);x:=1;y :=1;print(1,1,0);
textcolor(15);textfondo(0
s:=[1..9];gotoxy(1); ,20);para i:=1 a 9 escriba( i:2);
/p>
repetir
c:=readkey;
xi:=x;yi:=y
caso c de
;(*#13{Entrar}, #27{Esc}*)
#27:detener
(*#72{Arriba}, #75{Izquierda} , #77{Derecha}, #80{Abajo}*)
#0:begin
c:=readkey
caso c de
#75:si x<>1 entonces x:=x-1 más escribe('');
#72:si y<>1 entonces y:=y-1 más escribe ('');
#80:si y<>9 entonces y:=y+1 else write(''); x:=x+1 else write('');
#83:a[x,y]:=0
fin
end;
#48..#58:if (ord(c)-48 en s) o (c=#48)
entonces a[x,y]:=ord (c)-48 else write('');
end;
print(xi,yi,12);print(x,y,12);
ky(a,x,y,s);
gotoxy(1,20);
color de texto(15);fondo de texto(0);delline; >
para i:=1 a 9, haga si i en s y luego escriba(i:2)
hasta c=#13
x:=0;y; :=0;print(xi,yi,12);
fin;
procedimiento noans;
comenzar
gotoxy(1) ,20);
textbackground(0);delline;textcolor(143);
write('¡No hay respuesta!'); p>
p>
detener;
fin
{=============Leer datos del archivo==== ==== =======================ENTRADA POR ARCHIVO}
procedimiento inputbf(var a:sd;const path:string
procedimiento inputbf(var a:sd;const ruta:cadena
p>
función Exist(Ruta:cadena):boolean; p>var
S: PathStr;
comenzar
S := FSearch(Ruta, GetEnv('')); Existe := S <> '';
fin;
var
x,y:byte
c:char;
f:text;
comenzar
si no existe (ruta), entonces comienza
inputbkb(a);
fin si no comenzar
assign(f,ruta);reset(f);printk
f;
o y:=1 a 9 comienzan
for x:=1 a 9 comienzan
read(f,c
si no (c); en [#48..#58,#32]) luego comience
inputbkb(a);exit
end
if c=#32; entonces a[x,y]:=0 else a[x,y]:=ord(c)-48;print(x,y,12
end
fin
fin;
fin
{========= ====Completar datos fijos=========================================== == ==TC}
procedimiento tc;
var
x,y,i,t,n,f:byte
<; p> s:ss;función tct:byte;
var
i,j,k,l:byte
s1, s2,s3:ss;
n1,n2,n3:matriz [1..9] de byte
comenzar
tct:=0;
para i:=1 a 9 comience
fillchar(n1,sizeof(n1),0);fillchar(n3,sizeof(n3),0);fillchar( n2, sizeof(n2),0);
para j:=1 a 9 comience
ky(a,i,j,s);if a[i,j ]< >0 entonces comienza s:=[a[i,j]]; n1[a[i,j]]:=10
para k:=1 a 9 hazlo si k; en s entonces si n1[k]=0 entonces n1[k]:=j else n1[k]:=10
ky(a,j,i,s);if a[j, i] <>0 entonces comienza s:=[a[j,i]]; n2[a[j,i]]:=10;
for k:=1 a 9 hazlo si; k en s entonces si n2[k]=0 entonces n2[k]:=j else n2[k]:=10
ky(a,((i-1) mod 3)*3; +( (j-1) mod 3+1),((i-1) div 3)*3+((j-1) div 3+1),s); (( i-1) mod 3)*3+((j-1) mod 3+1),((i-1) div 3)*3+((j-1) div 3+1)]<> 0 luego comienza
s:=[a[((i-1) mod 3)*3+((j-1) mod 3+1),((i-1) div 3)* 3+ ((j-1) div 3+1)]];
n3[a[((i-1) mod 3)*3+((j-1) mod 3+1) ,( (i-1) div 3)*3+((j-1) div 3+1)]]:=10
fin
para k:= 1 a 9 si k en s entonces si n3[k]=0 entonces n3[k]:=j else n3[k]:=10
end
>para k:=1 a 9 comience
j:=n1[k]
si j en [1..9] entonces comience
a[i,j]:=k;print(i,j,6);tct:=1;salir;
fin
fin; >para k:=1 a 9 comience
j:=n2[k]
si j en [1..9] entonces comience
a[j,i]:=k;print(j,i,6);tct:=1;salir;
fin
fin; >para k:=1 a 9 comience
j:=n3[k]
si j en [1..9] entonces comience
a[((i-1) mod 3)*3+((j-1) mod 3+1),((i-1) div 3)*3+((j-1) div 3+1)] :=k;
imprimir(((i-1) mod 3)*3+((j-1) mod 3+1),((i-1) div 3)*3+( (j-1) div 3+1),6);
tct:=1;salir
fin
fin;
fin;
fin;
verificación del procedimiento;
var
i,j,k:byte; >
s,s1,s2,s3:ss;
comenzar
para i:=1 a 9 comenzar
s1:=[] ;s2:=[];s3:=[];
para j:=1 a 9 comience
si a[i,j]=0 entonces comience ky(a ,i,j,s);s1:=s1+s; finalice else s1:=s1+[a[i,j]];
si a[j,i]=0 entonces comience ky( a,j,i,s);s2:=s2+s; end else s2:=s2+[a[j,i]];
if a[((i-1) mod 3) *3+((j-1) mod 3+1),((i-1) div 3)*3+((j-1) div 3+1)]=0 luego comenzar
ky(a,((i-1) mod 3)*3+((j-1) mod 3+1),((i-1) div 3)*3+((j-1) div 3+1 ),s);s3:=s3+s;
fin else s3:=s3+[a[((i-1) mod 3)*3+((j-1) mod 3+1 ),((i-1) div 3)*3+((j-1) div 3+1)]];
fin
para j:=1 a 9 comience
si no (j en s1) entonces noans
si no (j en s2) entonces noans
si no (j en s3); ) entonces noans;
finalizar
finalizar
finalizar
repetir
f:=0;
para x:=1 a 9 haz
para y:=1 a 9 haz
si a[x ,y]=0 entonces b
comenzar
ky(a,x,y,s);t:=0;
si s=[] entonces
noans;
para i:=1 a 9, hazlo si i en s y luego comienza
t:=t+1;n:=i
end
<; p>si t=1 entonces comienza a[x,y]:=n;print(x,y,14);f:=f+1; p>f:=f+tct;verificarhasta f=0
finalizar
{========== ===Solución recursiva=============================================== === ==TRY}
respuesta de función:boolean;
var
ans:boolean;
procedimiento try(num: byte);
var
i,j,n,x,y:byte
s:ss
comenzar
si se presiona la tecla, entonces se lee la tecla mayúscula de #27:halt;#0:if readkey=#107 entonces se detiene;
if num<=list.num entonces comienza
x:=list.dat[num].x;y:=list.dat[num].y
ky(a,x,y,s);if s=[] luego salga
n:=random(8)+1;
para j:=n a n+8 comience
i:=j mod; 9+1 ;
si estoy en s entonces comienzo
a[x,y]:=i;print(x,y,10); try(num +1);
a[x,y]:=0;print(x,y,0)
end
end
fin sino comenzar
gotoxy(1,20);textcolor(15);textbackground(0);delline;write('¡Completo!');answer:=true;ans:= true;
caso readkey de #27:halt;#0:if readkey=#107 entonces detener
textcolor(15);textbackground(0);gotoxy(1 ,20) ;delline;writeln('Intentando...');
finalizar
finalizar
comenzar
respuesta; :=falso ;ans:=falso;
prueba(1)
fin
procedimiento crtinit; >
OrigMode: Word;
comenzar
OrigMode:=LastMode; { Recordar modo de vídeo original }
TextMode(Lo(LastMode)+Font8x8) ; { use 43 o 50 líneas en EGA/VGA }
es
d;
procedimiento px;
var
l:matriz [1..9] de registro
num:byte <; /p>
dat:array [1..81] de punto
end;
i,j,k:byte
d; :punto;
comenzar
para i:=1 a 9 hacer l[i].num:=0
para i:=1 a 9; hacer para j:=1 a 9 hacer si a[i,j]=0 entonces comenzar
d.x:=i;d.y:=j;ky(a,i,j,d.s);d.n: =0;para k:=1 a 9 hacer si k en d.s entonces inc(d.n
inc(l[d.n].num);l[d.n].dat[l[d.n]. num]:=d;
end;
list.num:=0
para i:=1 a 9 hacer para j:=1 a l[i].num comienza
inc(list.num);list.dat[list.num]:=l[i].dat[j]; ;
fin;
comenzar
aleatorio;
crtinit
textbackground(0);clrscr;
si ParamCount=0 entonces inputbkb(a) else inputbf(a,ParamStr(1));
textcolor(15);textbackground(0);gotoxy(1,20) ;delline;writeln('Pensando...');tc;
textcolor(15);textbackground(0);gotoxy(1,20);delline;writeln('Comprobando...') ;px;
textcolor(15);textbackground(0);gotoxy(1,20);delline;writeln('Intentando...');gotoxy(1,1);
si no responde, entonces noans;
textcolor(15);textbackground(0);gotoxy(1,20);delline;writeln('¡Eso es todo!');readkey; /p>
fin.