DUzun's Web
Programare, proiecte personale, divertisment

{-----------------------------------------------------------

  Aceasta este prima versiune a programului.

  Programul deschide fisierul 'Exemplu.sdk' si il rezolva,

  aplicand doar o metoda logica (prin excludere), ceea ce ii

  permite sa rezolve multe exemple, dar NU toate.

 -----------------------------------------------------------}

uses crt,dos,windos,strings;

type cub3=array[1..9,1..9,1..9] of byte;

var tabla:cub3;

    ex,ey,mx,my:byte;

    all:boolean;

    FN:string;

    k:char;

​

    Procedure PCs(n,ex,ey,x,y,z:byte);

begin

gotoxy(ex-n*n+2*x,ey-n*n+2*y);write(z);

end;

​

    Procedure Fereastra(n,ex,ey:byte);

 var e:array[0..24] of char;

     x,y:array[1..100] of byte;

     i,j:byte;

 procedure writeif(x,y:byte;c:char);

 var mx,my:byte;

begin

  mx:=lo(windmax)+1;my:=hi(windmax)+1;

  if (x in [1..mx])and(y in [1..my])and(x+y<mx+my)then begin gotoxy(x,y);write(c);end;

end;

    begin

e[0]:=#201; e[5]:=#186; e[10]:=#199; e[15]:=#204; e[20]:=#200;

e[1]:=#205; e[6]:=#32;  e[11]:=#196; e[16]:=#205; e[21]:=#205;

e[2]:=#209; e[7]:=#179; e[12]:=#197; e[17]:=#216; e[22]:=#207;

e[3]:=#203; e[8]:=#186; e[13]:=#215; e[18]:=#206; e[23]:=#202;

e[4]:=#187; e[9]:=#186; e[14]:=#182; e[19]:=#185; e[24]:=#188;

​

 for i:=1 to 2*n*n do

  begin x[i]:=((i-1)mod 2)+1+(((i-1)mod(2*n))+1)div(2*n)+i div(2*n*n);y[i]:=5*x[i];end;

  writeif(ex-n*n+1,ey-n*n+1,e[0]);

 for i:=1 to 2*n*n do begin

  writeif(ex-n*n+i+1,ey-n*n+1,e[x[i]]);

  writeif(ex-n*n+1,ey-n*n+i+1,e[y[i]]);

                      end;

 for i:=1 to 2*n*n do for j:=1 to 2*n*n do writeif(ex-n*n+i+1,ey-n*n+j+1,e[x[i]+y[j]]);

    end;

​

  Function ix(x,y,i:byte):byte;

 var nx:byte;

begin

 nx:=((x-1)div 3)*3;

 ix:=nx+(x+i-nx)mod 3+1;

end;

  Function iy(x,y,i:byte):byte;

 var nx,ny:byte;

begin

 nx:=((x-1)div 3)*3;

 ny:=((y-1)div 3)*3;

 iy:=ny+((x+i-nx)div 3+y-1-ny)mod 3+1;

end;

   Function unicax(x,y:byte;c:char):byte;

  var i,z,n,v:byte;

 begin

    z:=0;n:=0;

  for i:=1 to 9 do begin

   case c of

    'x':v:=tabla[i,x,y];

    'y':v:=tabla[y,i,x];

    'z':v:=tabla[x,y,i];

   end;

        if v=2 then begin

if z=0 then z:=i;n:=i;end;

if z=n then unicax:=z else unicax:=0;

   end;

 end;

    Function unicp(p,z:byte):byte;

  var i,n,o,x,y:byte;

 begin

   n:=0;o:=0;x:=((p-1)mod 3+1)*3;y:=(p-1)div 3+1;

  for i:=1 to 9 do

  if tabla[ix(x,y,i-2),iy(x,y,i-2),z]=2 then begin

                      if o=0 then o:=i;n:=i; end;

  if o=n then unicp:=o else unicp:=0;

 end;

​

    Procedure bif(x,y,z:byte);

   var i:byte;

  Begin

 tabla[x,y,z]:=1;

for i:=0 to 7 do begin

  tabla[(x+i)mod 9+1,y,z]:=0;

  tabla[x,(y+i)mod 9+1,z]:=0;

  tabla[x,y,(z+i)mod 9+1]:=0;

  tabla[ix(x,y,i),iy(x,y,i),z]:=0;

  PCs(3,ex,ey,x,y,z);

  all:=false;

end;

  End;

    Procedure verunic;

   var x,y,z:byte;

  begin

   for x:=1 to 9 do for y:=1 to 9 do

 begin

  if unicax(x,y,'x')<>0 then bif(unicax(x,y,'x'),x,y);

  if unicax(x,y,'y')<>0 then bif(y,unicax(x,y,'y'),x);

  if unicax(x,y,'z')<>0 then bif(x,y,unicax(x,y,'z'));

 end;

  end;

​

    Function Arg(n:byte):string;

 var

  ArgN: PChar;

begin

  GetMem(ArgN, 20);

  GetArgStr(ArgN, n, 19);

  Arg:=StrPas(ArgN);

end;

    Procedure OpenF(fl:string);

 Var f:text;

     n:longint;

     i,j,h:byte;

  Begin

if fl='' then fn:='Exemplu.sdk' else fn:=fl;

Assign(f,fn);reset(f);

j:=0;

repeat

inc(j);

i:=10;

 readln(f,n);

 Repeat

dec(i);

h:=n mod 10;

if h<>0 then bif(i,j,h);

n:=n div 10;

 until i=1;

until eof(f);

close(f);

   end;

​

​

begin

textmode(258);textattr:=$1f;clrscr;

mx:=lo(windmax)+1;

my:=hi(windmax)+1;

ex:=mx div 2;ey:=my div 2;

fereastra(3,ex,ey);

OpenF(arg(1));

 Repeat

  Repeat

  All:=true;

If keypressed then k:=readkey;

  verunic;

  UNtil (k=#27);

 Until (k=#27);

Readkey;

end.

​

​