Informatika gyűjtemény

Egy szinttel feljebb elfchk.pas

2004050607080910

<<  16. óra  >>

<<  Elfogó  >>

NézetNyomtat

elfchk.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
program elfogo_chk;
{$APPTYPE CONSOLE}
USES SysUtils;
CONST
    inputFile = 'ELFOGO.BE5';
    probaFile = 'ELFOGO.KI5';

    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;


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
    res:= -1;

    tmp[a]:= TRUE;
    FOR i:= 1 TO ker DO
    BEGIN
        IF map[a, i] THEN
        BEGIN
            IF tmp[i] THEN x:= 0
            ELSE
            BEGIN
                x:= GetDest(i);
                IF x = -1 THEN x:= i;
            END;

            IF (res = -1) OR (res > 0) THEN
            BEGIN
                IF x > 0 THEN
                BEGIN
                    IF res = -1 THEN res:= x
                    ELSE IF (res <> x) THEN res:= 0;
                END
                ELSE res:= 0;
            END;
        END;

        IF res = 0 THEN BREAK;
    END;
    tmp[a]:= FALSE;

    GetDest:= res;
END; {GetDest}

PROCEDURE GetDests;
VAR
    i, j: INTEGER;
BEGIN
    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('[ERROR]: 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;
    FOR i:= 1 TO ker DO
    BEGIN
        WriteLn(i, ': ', dests[i]);
        IF dests[i] = -1 THEN a:= i;
    END;
    IF a < 0 THEN WriteLn('[ERROR]: nincs lehetseges vegpont')
    ELSE
    BEGIN
        WriteLn('[OKAY]: lehetseges vegpont: ', 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('[ERROR]: rossz vegpont: ', a);
    END;


    ReadLn;
END; {LoadKi}

BEGIN
    LoadBe;
    LoadKi;
END.
(Vissza)