Informatika gyűjtemény

Egy szinttel feljebb kb_sudoku.pas

2004050607080910

<<  5. óra  >>

<<  Sudoku  >>

NézetNyomtat

kb_sudoku.pas (Vissza)
Az alábbi letöltési lehetőségek közül választhatsz: (segítség)
Karakterkódolás:
Sortörés:
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: us-ascii
Méret: 7 KB
uses crt;

const FAJLNEV = 'sudoku9.be';

type    mezo = record
             szam:byte;
             leh:array[1..9] of boolean;
        end;
        Ttabla = array[1..9, 1..9] of mezo;

var tabla:Ttabla;

function MelyikNegyzet(a:byte):byte;
var negyzeta: byte;
begin
     if a mod 3 =  0 then negyzeta := a div 3 else
        negyzeta := a div 3+1;

     MelyikNegyzet := negyzeta;
end;

procedure Beolvas;
var f:text;
    i,p, k:byte;
    s:string;

begin
     Assign(f, FAJLNEV);
     Reset(f);
     for i:=1 to 9 do begin
         readln(f, tabla[1, i].szam, tabla[2, i].szam, tabla[3, i].szam, tabla[4, i].szam,
                   tabla[5, i].szam, tabla[6, i].szam, tabla[7, i].szam, tabla[8, i].szam,
                   tabla[9, i].szam);
         for p:=1 to 9 do begin
             for k:=1 to 9 do begin
                 tabla[i, p].leh[k] := true; {barmi lehet itt, a szam maga nem, de ezzel most nem foglalkozunk}
             end;
         end;
     end;
     Close(f);
end;

procedure MezoVizsgalat(x,y:byte);
var a, b, negyzetx, negyzety: byte;
begin
     {eloszor az oszlopokat/sorokat zarjuk ki}
     {1. oszlopok}
     if tabla[x, y].szam <> 0 then begin
        {-> itt mar van valami, akkor itt mar mas nem lehet}
        for a:=1 to 9 do begin
             tabla[x, y].leh[ a ] := false; {o nem lehet}
        end;
        exit;
     end;
     for a:=1 to 9 do begin
         if( tabla[a, y].szam <> 0 ) then begin
             tabla[x, y].leh[ tabla[a,y].szam ] := false; {o nem lehet}
         end;
     end;
     {2. sorok kilovese}
     for a:=1 to 9 do begin
         if( tabla[x, a].szam <> 0 ) then begin
             tabla[x, y].leh[ tabla[x,a].szam ] := false; {o nem lehet}
         end;
     end;
     {3. a 3x3-as negyzet kilovese}
     {melyik negyzetrol van szo?}
     negyzetx := MelyikNegyzet(x);
     negyzety := MelyikNegyzet(y);

     for a:=(negyzetx*3-2) to (negyzetx*3) do begin
         for b:=(negyzety*3-2) to (negyzety*3) do begin
             if( tabla[a, b].szam <> 0 ) then begin
                 {viszgaljuk a negyzet mezoit, ha van benne ertek, akkor}
                 tabla[x, y].leh[ tabla[a, b].szam ] := false;
             end;
         end;
     end;
end;

procedure Beallit;
var x,y:byte;
begin
     {toltsuk fel a lehetosegeket.}
     for x:=1 to 9 do begin
         for y:=1 to 9 do begin
             MezoVizsgalat(x, y);
         end;
     end;
end;

procedure MezoCheck_1(x, y: byte);
var i,a:byte;
begin
     a:=0;
     for i:=1 to 9 do begin
         if( tabla[x, y].leh[i] ) then inc(a); {ha talalunk lehetoseget, akkor noveljuk a-t}
     end;
     if a=1 then begin
        {ha csak egy lehetosegunk van, akkor azt kitoltjuk}
        for i:=1 to 9 do begin
            if( tabla[x, y].leh[i] ) then break;
        end;
        {most az i takarja a lehetseges szamot}
        tabla[x, y].szam := i;
        Beallit;
     end;
end;

procedure Feltolt_1;
var x,y:byte;
begin
     for x:=1 to 9 do begin
         for y:=1 to 9 do begin
             MezoCheck_1(x, y); {megnezzuk, hogy az adott mezo egyertelmuen kitoltheto-e}
         end;
     end;
end;

procedure MezoCheck_2(x,y:byte);
var a,i,z, b:byte;
    leh : array[1..9] of boolean;
    darab, save:byte;
    negyzetx, negyzety: byte;
begin
     {1. oszlopok vizsgalata}
     {a lehetosegeken porgetunk vegig}
     for i:=1 to 9 do
         leh[i] := tabla[x, y].leh[i]; {mentsuk a dolgokat, mert ezen modositunk}

     for i:=1 to 9 do begin
         if( leh[i] ) then begin
          {HA van lehetoseg, akkor nezzuk a tobbit}
             for a:=1 to 9 do begin
                 if( ( tabla[a, y].szam = 0 ) and (x<>a) ) then begin
                     {az oszlopban talalunk 0-t, de nem a mi szamunk, akkor}
                     {megnezzuk, hogy itt van-e ilyen lehetoseg}
                     if( tabla[a, y].leh[i] = leh[i] ) then begin leh[i] := false; break; end;
                 end;
             end;
         end;
     end;

     {megnezzuk, hogy kizarhattunk-e valamit?}
     darab := 0;
     for i:= 1 to 9 do begin
         if( leh[i] ) then begin inc(darab); save:= i; end;
     end;

     if( darab = 1 ) then begin
         tabla[x, y].szam := save;
         Beallit;
     end else begin

         for i:=1 to 9 do
         leh[i] := tabla[x, y].leh[i]; {mentsuk a dolgokat, mert ezen modositunk}

         {nem tudtunk kizarni, tehat most vizsgaljuk a sorokat}
         for i:=1 to 9 do begin
             if( leh[i] ) then begin
             {HA van lehetoseg, akkor nezzuk a tobbit}
                 for a:=1 to 9 do begin
                     if( ( tabla[x, a].szam = 0 ) and (y<>a) ) then begin
                         {az sorban talalunk 0-t, de nem a mi szamunk, akkor}
                         {megnezzuk, hogy itt van-e ilyen lehetoseg}
                         if( tabla[x, a].leh[i] = leh[i] ) then begin leh[i] := false; break; end;
                     end;
                 end;
             end;
         end;

         {megnezzuk, hogy kizarhattunk-e valamit?}
         darab:=0;
         for i:= 1 to 9 do begin
             if( leh[i] ) then begin inc(darab); save:= i; end;
         end;

         if( darab = 1 ) then begin
             tabla[x, y].szam := save;
             Beallit;
         end else begin

             {ha mar sor, es oszlop alapjan sem tudjuk eldonteni, akkor jojjon a negyzet!}

             for i:=1 to 9 do
                 leh[i] := tabla[x, y].leh[i]; {mentsuk a dolgokat, mert ezen modositunk}

             {3. a 3x3-as negyzet kilovese}
             {melyik negyzetrol van szo?}
             negyzetx := MelyikNegyzet(x);
             negyzety := MelyikNegyzet(y);

             for i:=1 to 9 do begin
                 if( leh[i] ) then begin
                     for a:=(negyzetx*3-2) to (negyzetx*3) do begin
                         for b:=(negyzety*3-2) to (negyzety*3) do begin

                         {osszes mezok elemein vegig megyunk}

                             if( tabla[a, b].szam = 0 ) and ( (x<>a) or (y<>b) ) then begin
                                 {Ha nem onmaga, akkor vizsgaljunk}
                                 if( tabla[a, b].leh[i] = leh[i] ) then begin leh[i] := false; break; end;
                             end;
                         end;
                     end;
                 end;
             end;

             darab:=0;

             for i:= 1 to 9 do begin
                 if( leh[i] ) then begin inc(darab); save:= i; end;
             end;

             if( darab = 1 ) then begin
                 tabla[x, y].szam := save;
                 Beallit;
             end;

         end;

     end;

end;

procedure Feltolt_2;
var x,y:byte;
begin
     {lenyeg: minden helyen ahol 0 van vizsgalunk}
     {Nezzuk az adott sort, majd oszlopot, majd negyzetet}
     {A lehetosegeket vegig porgetjuk. Ha az a lehetoseg lehet meg mashol, akkor azt kivesszuk}
     {Ha kivettunk mindent, de 1 maradt, akkor az jo lehetoseg}
     for x:=1 to 9 do begin
         for y:=1 to 9 do begin
             if( tabla[x, y].szam = 0 ) then begin
                 MezoCheck_2(x, y);
             end;
         end;
     end;
end;

function VanMegUres:boolean;
var x,y: byte;
begin
     VanMegUres:=false;
     for x:=1 to 9 do begin
         for y:=1 to 9 do begin
             if( tabla[x, y].szam = 0 ) then begin
                 VanMegUres:=true;
                 exit;
             end;
         end;
     end;
end;

procedure MakeOutput;
var x, y:byte;
    f:text;
begin
     Assign(f, 'egyedi.ki');
     Rewrite(f);
     for y:=1 to 9 do begin
         for x:=1 to 9 do begin
             write(f, tabla[x, y].szam,' ');
         end;
         writeln(f);
     end;
     Close(f);
end;

var x,y:byte;

begin
     clrscr;
     Beolvas;
     Beallit;
     while VanMegUres do begin
        Feltolt_1;
        Feltolt_2;
     end;

     MakeOutput;
end.
(Vissza)