Listing: APM.PAS {$M 65000,0,655360} program graf_apm; const fin='apm.in'; fout='apm.out'; max=100; type muchie= record i,j:Byte; c:Integer end; sir=array[1..max*max div 2] of Integer; var a:array[1..3*max] of muchie; sel:array[1..max] of Boolean; inceput,sfarsit:array[0..max] of Integer; b:array[1..max*max div 2] of muchie; v:^sir; n,m,pz:Integer; procedure citire; var f:Text; i:Integer; begin Assign(f,fin); Reset(f); Readln(f,n); for i:=1 to n-1 do begin Readln(f,a[i].i,a[i].j,a[i].c); a[i+n-1].i:=a[i].j; a[i+n-1].j:=a[i].i; a[i+n-1].c:=a[i].c; a[i+2*n-2]:=a[i] end; m:=0; New(v); while not Seekeof(f) do begin Inc(m); Read(f,v^[m]) end; Close(f) end; procedure sort1(l,r:Integer); var i,j,x:Byte; y:muchie; begin i:=l; j:=r; x:=a[(l+r) div 2].i; repeat while a[i].i<x do Inc(i); while x<a[j].i do Dec(j); if i<=j then begin y:=a[i]; a[i]:=a[j]; a[j]:= y; Inc(i); Dec(j) end until i>j; if l<j then sort1(l,j); if i<r then sort1(i,r) end; procedure recurs(nivel,st,op:Byte; val:Integer); var i:Integer; begin if (st<op) and (nivel>2) then begin Inc(pz); b[pz].i:=st; b[pz].j:=op; b[pz].c:=val end; for i:=inceput[op] to sfarsit[op] do if not(sel[a[i].j]) then begin sel[a[i].j]:=true; if val<a[i].c then recurs(nivel+1,st,a[i].j,a[i].c) else recurs(nivel+1,st,a[i].j,val); sel[a[i].j]:=false end end; procedure calcul_muchii; var i,j:Integer; begin j:=0; for i:=1 to 2*n-2 do if a[i].i<>j then begin inceput[a[i].i]:=i; sfarsit[j]:=i-1; j:=a[i].i end; sfarsit[j]:=2*n-2; pz:=0; Fillchar(sel,Sizeof(sel),false); for i:=1 to n do begin sel[i]:=true; recurs(1,i,i,0); sel[i]:=false end end; procedure sort2(l,r:Integer); var i,j,x:Integer; y:muchie; begin i:=l; j:=r; x:=b[(l+r) div 2].c; repeat while b[i].c<x do Inc(i); while x<b[j].c do Dec(j); if i<=j then begin y:=b[i]; b[i]:=b[j]; b[j]:=y; Inc(i); Dec(j) end until i>j; if l<j then sort2(l,j); if i<r then sort2(i,r) end; procedure sort3(l,r:Integer); var i,j,x,y:Integer; begin i:=l; j:=r; x:=v^[(l+r) div 2]; repeat while v^[i]<x do Inc(i); while x<v^[j] do Dec(j); if i<=j then begin y:=v^[i]; v^[i]:=v^[j]; v^[j]:=y; Inc(i); Dec(j) end until i>j; if l<j then sort3(l,j); if i<r then sort3(i,r) end; procedure solutie; var f:Text; k,i:Integer; begin Assign(f,fout); Rewrite(f); k:=m; for i:=pz downto 1 do if b[i].c<=v^[k] then begin Writeln(f,b[i].i,' ',b[i].j,' ',v^[k]); Dec(k); if k<1 then begin Close(f); Halt end end; Close(f) end; Begin citire; sort1(1,2*n-2); calcul_muchii; sort2(1,pz); sort3(1,m); solutie End. [cuprins] |