Informatika gyűjtemény

Egy szinttel feljebb komfel_javbit.pas

2004050607080910

<<  8. óra  >>

<<  Kömal fórum feladat  >>

NézetNyomtat

komfel_javbit.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: utf-8
Méret: 3 KB
program komfel; {Javította: EP 2009.11.15.}{bitműveletek param}

{$R+}

const   
    SIZE = 8;

var 
    a : array[1..336] of qword; {elemek}
    elemdb : integer; {lehetséges részhalmazok száma}
    tom : qword; {a pillanatnyilag fedett mezők}
    y : array[1..SIZE*SIZE div 4+1] of integer; {BT döntési változók: a beválogatott részhalmazok}
    tmp : qword;
    mdb : integer; {megoldások száma}



procedure dumpelem(ii:integer);
var i : byte;
    poz : integer;
    e : qword;
begin
    e := a[ii];
    poz := 1;
    write(ii:3,' : ');
    for i := 1 to SIZE*SIZE do
    begin
        if (e mod 2) = 1 then write(poz, ' ');
        poz := poz +1;
        e := e shr 1;
    end;
    writeln;
end;

procedure elemgen;
var i,j,k : integer; {nem használunk globális ciklusváltozókat!!!}
begin
    tmp := 1; {Ezt siftelgetjük majd...}
    for i:=1 to 336 do a[i]:=0; 
    
    j:=0; {ebben lesz az előállított részhalmazok száma}

    for k:=0 to SIZE-2 do begin 
    for i:=k*SIZE+1 to k*SIZE+SIZE-2 do 
    begin 
// ***
// *
        inc(j);
        {a[j,i]:=1; a[j,i+1]:=1; a[j,i+2]:=1; a[j,i+SIZE]:=1;}
        a[j] := (tmp shl (i-1)) or 
                (tmp shl i) or 
                (tmp shl (i+1)) or 
                (tmp shl (i+SIZE-1));
// ***
//   *              
        inc(j); 
        {a[j,i]:=1; a[j,i+1]:=1; a[j,i+2]:=1; a[j,i+SIZE+2]:=1;} 
        a[j] := (tmp shl (i-1)) or 
                (tmp shl i) or 
                (tmp shl (i+1)) or 
                (tmp shl (i+SIZE+1));
// *
// ***
        inc(j);   
        
        a[j] := (tmp shl (i-1)) or 
                (tmp shl (i-1+SIZE)) or 
                (tmp shl (i+SIZE)) or 
                (tmp shl (i+1+SIZE));                           
//   *
// ***
        inc(j);   
        
        a[j] := (tmp shl (i+1)) or 
                (tmp shl (i-1+SIZE)) or 
                (tmp shl (i+SIZE)) or 
                (tmp shl (i+1+SIZE));
                
    end; 
    end;     

    for k:=0 to SIZE-3 do begin 
    for i:=k*SIZE+1 to k*SIZE+SIZE-1 do 
    begin 
// *
// *
// **
        inc(j);   
        {a[j,i]:=1; a[j,i+SIZE]:=1; a[j,i+2*SIZE]:=1;a[j,i+2*SIZE+1]:=1; }
        a[j] := (tmp shl (i-1)) or 
                (tmp shl (i+SIZE-1)) or 
                (tmp shl (i+2*SIZE-1)) or 
                (tmp shl (i+2*SIZE));
// **
// *
// *
        inc(j);   
        {a[j,i]:=1; a[j,i+SIZE]:=1; a[j,i+2*SIZE]:=1;a[j,i+1]:=1; }
        a[j] := (tmp shl (i-1)) or 
                (tmp shl (i+SIZE-1)) or 
                (tmp shl (i+2*SIZE-1)) or 
                (tmp shl (i));
// **
//  *
//  *
        inc(j);   
        
        a[j] := (tmp shl (i-1)) or 
                (tmp shl (i+SIZE)) or 
                (tmp shl (i+2*SIZE)) or 
                (tmp shl (i));
//  *
//  *
// **
        inc(j);   
        {a[j,i]:=1; a[j,i+SIZE]:=1; a[j,i+2*SIZE]:=1;a[j,i+2*SIZE-1]:=1; }
        a[j] := (tmp shl (i)) or 
                (tmp shl (i+SIZE)) or 
                (tmp shl (i+2*SIZE-1)) or 
                (tmp shl (i+2*SIZE));
                
    end; 
    end;                                       

    elemdb := j;
    for i := 1 to elemdb do dumpelem(i);
end;

procedure init;
var i : integer;
begin
    elemgen;
    tom := 0;
    for i:=1 to SIZE*SIZE div 4 do y[i]:=0;
    mdb := 0;
    writeln('elemek száma: ',elemdb);
end;


procedure dump(lol:integer);
var i: integer;
begin
    writeln('mdb: ',mdb);
    for i:= 1 to lol do dumpelem(y[i]);
    writeln;        
    {readln;}   
end;

function joe(n:integer):boolean;
begin  
    if (a[y[n]] and tom) = 0 
        then joe := true
        else joe := false; 
end;

procedure ber(n:integer);
begin 
    tom := (tom OR a[n]);
end;

procedure kir(n:longint);
begin 
    tom := tom and (not a[n]);
end;




procedure helyez(lol:integer);
begin
    if lol<>0 then 
    begin
        if lol=(SIZE*SIZE div 4+1) then 
        begin
            inc(mdb);
            dump(SIZE*SIZE div 4);
            exit;
        end else 
        begin
            inc(y[lol]);
            while (y[lol] <= elemdb) do 
            begin
                if joe(lol) then 
                begin
                    ber(y[lol]); 
                    y[lol+1]:=y[lol];
                    
                    {dump(lol);}
                    helyez(lol+1);
                    
                    kir(y[lol]);
                end; 
                
                inc(y[lol]);
            end;
            
        end;
    end;
end;



begin
    init;
    helyez(1);
end.
(Vissza)