Informatika gyűjtemény

Egy szinttel feljebb ep_jarvany.pas

2004050607080910

<<  11. óra  >>

<<  Járvány  >>

NézetNyomtat

ep_jarvany.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: 2 KB
program jarvany; {EP 2009.12.01.}

{$R+}

const   
    MAXSIZE = 30;
    MAXUT = 435;
    BEMENET = 'h1n1I.be';

var 
        N : byte;       {városok száma}
        M : integer;    {utak száma}
        ut: array[1..MAXUT,1..2] of byte; {utak}
        lefed: array[1..MAXSIZE] of longword; {előjel nélküli 32-bites}
        bitNULL, bitEGY, bitMEGOLDAS : longword; {lefedettséghez}       
        allomasok : array[1..MAXSIZE] of byte;
        adb : byte; {egy minimális megoldás állomásai}

procedure init; {beolvasás, kezdőértékek}
var i,j   : integer;
    be    : Text;
    bitek : longword;
begin
    bitNULL := 0;
    bitEGY := 1; {bitműveletekhez}

    assign(be,BEMENET);
    reset(be);
    readln(be,N,M);
    for i := 1 to M do
        readln(be, ut[i,1], ut[i,2]);
    close(be);
    
    for i := 1 to N do
    begin
        bitek := bitEGY shl (i-1);
        for j := 1 to M do
        begin
            if ut[j,1] = i then
                bitek := bitek or (bitEGY shl (ut[j,2]-1));
            if ut[j,2] = i then
                bitek := bitek or (bitEGY shl (ut[j,1]-1));             
        end;
        lefed[i] := bitek;
    end;
    
    bitMEGOLDAS := bitNULL;
    for i := 1 to N do
        bitMEGOLDAS := bitMEGOLDAS or (bitEGY shl (i-1));
        
    adb := 0;
    for i := 1 to N do allomasok[i] := 0;
    
end;

function joe(i:byte):boolean; {akkor jó, ha bővül vele a lefedettség}
var fedett : longword;
    j : byte;
begin  
    fedett := bitNULL;
    for j := 1 to i-1 do
        fedett := fedett or (lefed[allomasok[j]]);
    joe := (fedett < (fedett or lefed[allomasok[i]])); 
end;

function megoldas(i:byte):boolean; {mindent lefedtünk?}
var fedett : longword;
    j : byte;
begin
    fedett := bitNULL;
    for j := 1 to i do
        fedett := fedett or (lefed[allomasok[j]]);
    megoldas := (fedett = bitMEGOLDAS);
end;

procedure megold; {minimumkeresés back-track-kel}
var i : byte;
begin
    i := 1;
    while i > 0 do
    begin
        repeat
            inc(allomasok[i]);
        until (allomasok[i] > N) or joe(i);
        if allomasok[i] <= N then {előre}
        begin
            if megoldas(i) then {megoldás}
            begin
                if adb > 0 then 
                begin
                    if i < adb then adb := i; {jobb az eddigi legjobbnál}
                end else adb := i;
            end else
            begin
                i := i + 1;
                allomasok[i] := allomasok[i-1]; {növekvő sorrendben keressük a megoldást}
            end;
        end else
        begin {vissza}
            allomasok[i] := 0;
            i := i - 1;
        end;
    end;
end;

procedure kiir;
begin
    writeln('Állomások minimális száma: ', adb);
end;

begin
    init;
    megold;
    kiir;
end.
(Vissza)