Đang tải... (xem toàn văn)
CONST MAXV=100;MAXE=(MAXV-1)*MAXV DIV 2; TYPE CANH=RECORD U,V,C:INTEGER; MARK:BOOLEAN; END; VAR E:ARRAY[1..MAXE]OF CANH; LAB:ARRAY[1..MAXV]OF INTEGER; M,N:INTEGER;CONNECTED:BOOLEAN;F1,F2:TEXT; {====================================================================} PROCEDURE NHAP; VAR I:INTEGER; BEGIN READLN(F1,N,M); FOR I:=1 TO M DO WITH E[I] DO READLN(F1,U,V,C); END;
CONST MAXV=100;MAXE=(MAXV-1)*MAXV DIV 2; TYPE CANH=RECORD U,V,C:INTEGER; MARK:BOOLEAN; END; VAR E:ARRAY[1 MAXE]OF CANH; LAB:ARRAY[1 MAXV]OF INTEGER; M,N:INTEGER;CONNECTED:BOOLEAN;F1,F2:TEXT; {========================================================== ==========} PROCEDURE NHAP; VAR I:INTEGER; BEGIN READLN(F1,N,M); FOR I:=1 TO M DO WITH E[I] DO READLN(F1,U,V,C); END; {========================================================== ==========} PROCEDURE TAORONG; VAR I:INTEGER; BEGIN FOR I:=1 TO N DO LAB[I]:=-1; FOR I:=1 TO M DO E[I].MARK:=FALSE; END; {========================================================== ==========} FUNCTION GETROOT(V:INTEGER):INTEGER;{LAY GOC CUA CAY CHUA V} BEGIN WHILE LAB[V]>0 DO V:=LAB[V]; GETROOT:=V; END; {========================================================== ==========} PROCEDURE UNION(R1,R2:INTEGER); VAR X:INTEGER; BEGIN X:=LAB[R1]+LAB[R2]; IF LAB[R1]>LAB[R2] THEN BEGIN LAB[R1]:=R2; LAB[R2]:=X; END ELSE BEGIN LAB[R1]:=X; LAB[R2]:=R1; END; END; {========================================================== ==========} PROCEDURE AH(ROOT,LAST:INTEGER); VAR KEY:CANH;CON:INTEGER; BEGIN KEY:=E[ROOT]; WHILE ROOT*2<=LAST DO BEGIN CON:=ROOT*2; IF (CON<LAST)AND(E[CON+1].C<E[CON].C) THEN INC(CON); IF KEY.C<=E[CON].C THEN BREAK; E[ROOT]:=E[CON]; ROOT:=CON; END; E[ROOT]:=KEY; END; {========================================================== ==========} PROCEDURE KRUSKAL; VAR I,R1,R2,COUNT,A:INTEGER;TMP:CANH; BEGIN COUNT:=0; CONNECTED:=FALSE; FOR I:=M DIV 2 DOWNTO 1 DO AH(I,M); FOR I:=M-1 DOWNTO 1 DO BEGIN TMP:=E[1];E[1]:=E[I+1];E[I+1]:=TMP;AH(1,I); R1:=GETROOT(E[I+1].U);R2:=GETROOT(E[I+1].V); IF R1<>R2 THEN BEGIN E[I+1].MARK:=TRUE; INC(COUNT); IF COUNT=N-1 THEN BEGIN CONNECTED:=TRUE;EXIT; END; UNION(R1,R2); END; END; END; {========================================================== ==========} PROCEDURE XUAT; VAR I,COUNT,W:INTEGER; BEGIN IF NOT CONNECTED THEN WRITELN(F2,'DO THI KHONG LIEN THONG') ELSE BEGIN WRITELN(F2,'CAY KHUNG NHO NHAT LA:'); COUNT:=0;W:=0; FOR I:=1 TO M DO WITH E[I] DO BEGIN IF MARK THEN BEGIN WRITELN(F2,'(',U,',',V,')=',C); INC(COUNT); W:=W+C; END; IF COUNT=N-1 THEN BREAK; END; WRITELN(F2,'TONG =',W); END; END; {========================================================== ==========} BEGIN ASSIGN(F1,'D:\Pascal\File\khung.txt');RESET(F1); ASSIGN(F2,'D:\Pascal\Kruskalout.txt');REWRITE(F2); NHAP;TAORONG;KRUSKAL;XUAT;CLOSE(F1);CLOSE(F2); END. . ==========} PROCEDURE KRUSKAL; VAR I,R1,R2,COUNT,A:INTEGER;TMP:CANH; BEGIN COUNT:=0; CONNECTED:=FALSE; FOR I:=M DIV 2 DOWNTO 1 DO AH(I,M); FOR I:=M-1 DOWNTO 1 DO. ASSIGN(F1,'D:PascalFilekhung.txt');RESET(F1); ASSIGN(F2,'D:PascalKruskalout.txt');REWRITE(F2); NHAP;TAORONG ;KRUSKAL; XUAT;CLOSE(F1);CLOSE(F2); END.