lb_feszitofa.pas

Letöltés: lb_feszitofa.pas

{$R+}
PROGRAM graf;
USES crt;
VAR
    n: INTEGER;
    el: ARRAY[1..40,1..40] OF INTEGER;
    mar: ARRAY[1..40,1..40] OF BOOLEAN;
        
PROCEDURE beolvas(honnan: STRING);
    VAR
        f: TEXT;
        i,j: INTEGER;
    BEGIN
        ASSIGN(f,honnan);
        RESET(f);
        i:=0;
        REPEAT
            READLN(f);
            i:=i+1;
        UNTIL EOF(f);
        n:=i;
        CLOSE(f);
        RESET(f);
        FOR i:=1 TO n DO
            BEGIN
                FOR j:=1 TO n DO
                    BEGIN
                        READ(f,el[i,j]);
                    END;
            END;
        CLOSE(f);
    END;

FUNCTION kor(a,b: INTEGER): BOOLEAN;
    VAR
        fogl: ARRAY [1..40] OF BOOLEAN;
        i,j,ss,sm,tmp: INTEGER;
        sor: ARRAY[1..40] OF INTEGER;
        joe: BOOLEAN;
    BEGIN
        FOR i:=1 TO 40 DO
            BEGIN
                fogl[i]:=FALSE;
            END;
        i:=1;
        ss:=0;
        fogl[a]:=TRUE;
        sor[1]:=a;
        sm:=1;
        WHILE ss<>sm DO
            BEGIN
                ss:=ss+1;
                tmp:=sor[ss];
                FOR i:=1 TO n DO
                    BEGIN
                        joe:=TRUE;
                        j:=1;
                        WHILE ((j<=sm) AND (joe)) DO
                            BEGIN
                                IF sor[j]=i THEN
                                    joe:=FALSE;
                                j:=j+1;
                            END;
                        IF ((mar[tmp,i]) AND (joe)) THEN
                            BEGIN
                                sm:=sm+1;
                                sor[sm]:=i;
                                fogl[i]:=TRUE;
                            END;
                    END;
            END;
        kor:=fogl[b];
    END;

PROCEDURE kruskal;
    VAR
        i,j,k,min,s1,s2: INTEGER;
        ps,sum: LONGINT;
    BEGIN
        sum:=0;
        ps:=0;
        FOR i:=1 TO n DO
            BEGIN
                FOR j:=1 TO n DO
                    BEGIN
                        mar[i,j]:=FALSE;
                        IF el[i,j]<>-1 THEN
                            sum:=sum+el[i,j];
                    END;
            END;
        FOR k:=1 TO n-1 DO
            BEGIN
                min:=1001;
                s1:=0;
                s2:=0;
                FOR i:=1 TO n DO
                    BEGIN
                        FOR j:=1 TO n DO
                            BEGIN
                                IF (((el[i,j]<>-1) AND (el[i,j]<min)) AND NOT(kor(i,j))) THEN
                                    BEGIN
                                        min:=el[i,j];
                                        s1:=i;
                                        s2:=j;
                                    END;
                            END;
                    END;
                mar[s1,s2]:=TRUE;
                mar[s2,s1]:=TRUE;
                ps:=ps+el[s1,s2];
            END;
        sum:=ROUND((sum/2)-ps);
        WRITELN(sum);
    END;

PROCEDURE foprogram;
    BEGIN
        beolvas('network.txt');
        kruskal;
    END;
    
BEGIN
    foprogram;
END.