Informatika gyűjtemény

Egy szinttel feljebb elfchk2.pas

2004050607080910

<<  16. óra  >>

<<  Elfogó  >>

NézetNyomtat

elfchk2.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: 3 KB
{$R+} {$Q+}
PROGRAM elfogo_chk;
CONST
    maxK = 200; {max. keresztezodesek}
    maxU = 10000; {max. utca}

VAR
    utc, ker: INTEGER;

    map: ARRAY [1..maxK, 1..maxK] OF BOOLEAN;

    dests: ARRAY [1..maxK] OF INTEGER;

    tmp: ARRAY [1..maxK] OF BOOLEAN;


    inputFile, probaFile: STRING;

PROCEDURE LoadBe;
VAR
    T: Text;
    i, j: INTEGER;
    a, b: INTEGER;
BEGIN
    Assign(T, inputFile);
    Reset(T);
    ReadLn(T, ker);
    ReadLn(T, utc);
    FOR i:= 1 TO ker DO
    BEGIN
        FOR j:= 1 TO ker DO
        BEGIN
            map[i, j]:= FALSE;
        END;
    END;

    FOR i:= 1 TO utc DO
    BEGIN
        ReadLn(T, a, b);
        map[a, b]:= TRUE; map[b, a]:= TRUE;
    END;
    Close(T);
END; {LoadBe}

FUNCTION GetDest(a: INTEGER): INTEGER;
VAR
    i, x, res: INTEGER;
BEGIN
    IF dests[a] <> -20 THEN
    BEGIN
        GetDest:= dests[a];
        EXIT;
    END;
    
    res:= -1;
    
    IF tmp[a] THEN
    BEGIN
        Write('[kor]');
        GetDest:= -10;
        EXIT;
    END;
    
    tmp[a]:= TRUE;
    FOR i:= 1 TO ker DO
    BEGIN
        IF map[a, i] THEN
        BEGIN
            x:= GetDest(i);
            IF (x = -10) THEN
            BEGIN
                GetDest:= -10;
                EXIT;
            END;
            IF (res = -1) THEN res:= x
            ELSE IF (res <> -1) THEN
            BEGIN
                IF (res <> x) THEN
                BEGIN
                    Write('[tobb celpont]');
                    GetDest:= -10;
                    EXIT;
                END;
            END;
        END;
    END;
    tmp[a]:= FALSE;
    
    IF res = -1 THEN res:= a;
    dests[a]:= res;
    GetDest:= res;
END; {GetDest}

PROCEDURE GetDests;
VAR
    i, j: INTEGER;
BEGIN
    FOR i:= 1 TO ker DO dests[i]:= -20;
    
    FOR i:= 1 TO ker DO
    BEGIN
        FOR j:=1 TO ker DO tmp[j]:= FALSE;
        dests[i]:= GetDest(i);
    END;
END; {GetDests}

PROCEDURE Chk2Way;
VAR
    i, j: INTEGER;
    good: BOOLEAN;
BEGIN
    good:= TRUE;
    FOR i:= 1 TO ker DO
    BEGIN
        FOR j:= 1 TO ker DO
        BEGIN
            good:= good AND NOT ( map[i, j] AND (map[j, i]) );
        END;
    END;
    IF NOT good THEN WriteLn('[HIBA]: nem minden ut 1 iranyu!')
    ELSE WriteLn('[OKAY]: minden ut 1 iranyu');
END; {Chk2Way}

PROCEDURE LoadKi;
VAR
    T: Text;
    i, j, n: INTEGER;
    a, b: INTEGER;
    jo: BOOLEAN;
BEGIN
    Assign(T, probaFile);
    Reset(T);
    ReadLn(T, n);

    Read(T, a);
    FOR i:= 2 TO n DO
    BEGIN
        Read(T, b);
        {Write(a, ' ', b);}
        IF map[a, b] THEN
        BEGIN
            IF map[b, a] THEN
            BEGIN
                map[a, b]:= FALSE;
                {WriteLn(' DEL');}
            END; {ELSE WriteLn(' KEEP');}
        END; {ELSE WriteLn(' ERROR');}

        a:= b;
    END;
    Close(T);

{    FOR i:= 1 TO ker DO
    BEGIN
        Write(i, ': ');
        FOR j:= 1 TO ker DO
        BEGIN
            IF map[i, j] THEN Write(j, ' ');
        END;
        WriteLn;
    END;}

    a:= -1;
    Chk2Way;
    GetDests;
    WriteLn('Melyik keresztezodes hova vezet: ');
    FOR i:= 1 TO ker DO
    BEGIN
        Write(i, '-> ', dests[i], '; ');
        IF dests[i] = i THEN a:= i;
    END;
    WriteLn;
    IF a < 0 THEN WriteLn('[HIBA]: nincs lehetseges vegpont')
    ELSE
    BEGIN
        WriteLn('[OKAY]: a lehetseges vegpont sorszama: ', a);

        jo:= TRUE;
        FOR i:= 1 TO ker DO
        BEGIN
            jo:= jo AND ( (i = a) OR (dests[i] = a));
        END;
        IF jo THEN WriteLn('[OKAY]: jo vegpont: ', a)
        ELSE WriteLn('[HIBA]: nem vezet minden ut az ', a, ' sorszamu keresztezodesbe');
    END;

    IF ParamCount = 0 THEN
    BEGIN
        Write('uss entert');
        ReadLn;
    END;
END; {LoadKi}

PROCEDURE Init;
VAR
    ch: CHAR;
BEGIN
    IF ParamCount = 0 THEN
    BEGIN
        WriteLn('A sorszamot parameterkent is meg lehet adni...');
        Write('Bemenet sorszama: '); ReadLn(ch);

    END
    ELSE ch:= ParamStr(1)[1];

    WriteLn('Ellenorzes: elfogo.be',ch, ' elfogo.k_', ch);
    
    inputFile:= 'elfogo.be'+ch;
    probaFile:= 'elfogo.k_'+ch;
END; {Init}

BEGIN
    Init;
    LoadBe;
    LoadKi;
END.
(Vissza)