All pastes #916318 Raw Edit

Miscellany

public text v1 · immutable
#916318 ·published 2008-02-24 15:07 UTC
rendered paste body
program feszitofa;
var
koltseg,j,n,m,i:integer;
a:array[1..100,1..100] of integer;
v,u:array[1..100] of integer;
function strazsa_helye(bal,jobb:integer):integer;
var
csere,strazsa,i,j,r:integer;
begin
     strazsa:=a[3,bal];
     i:=bal-1;
     j:=jobb+1;
     repeat
           repeat
           dec(j);
           until strazsa>=a[3,j];

           repeat
           inc(i);
           until strazsa<=a[3,i];
     if i<j then

     for r:=1 to 3 do begin
     csere:=a[r,i];
     a[r,i]:=a[r,j];
     a[r,j]:=csere;
     end;

     until i>=j;
     strazsa_helye:=j;

end;

procedure rendez(bal,jobb:integer);
var
m:integer;
begin
     if bal<jobb then begin
     m:=strazsa_helye(bal,jobb);
     rendez(bal,m);
     rendez(m+1,jobb);
     end;
end;

procedure minfesz;
var
t,i,j,ed:integer;
begin
     rendez(1,m);
     for i:=1 to n do
     v[i]:=i;
     i:=0;

     for j:=1 to m do begin
     if v[a[1,j]]<>v[a[2,j]] then begin
     inc(i);
     u[i]:=j; {a j. el a legtobbet igero,tehat berakjuk a vektorba!}
     koltseg:=koltseg+a[3,j];
                             if i=n-1 then break;
     ed:=a[2,j];
     for t:=1 to n do
     if ed=v[t] then v[t]:=a[1,j];

     end;
     writeln('A graf nem osszefuggo!');
     end;
end;

begin
     writeln('Kerem az elek szamat!');
     readln(m);
     writeln('Kerem a csucsok szamat!');
     readln(n);
     for i:=1 to m do begin
     writeln('Milyen csucsok kozott?');
     readln(a[1,i],a[2,i]);
     writeln('Mennyi a sulya ennek az elnek?');
     readln(a[3,i]);
     end;
     minfesz;
     writeln('A matrix igy:');
     for i:=1 to 3 do begin
         for j:=1 to m do
         write(a[i,j]:4);
     writeln;
     end;
     writeln('Az osszkoltseg:',koltseg);
     writeln('Az elek:');
     for i:=1 to n-1 do
     write(u[i],' ');


end.