Cod sursa(job #164009)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 23 martie 2008 13:49:26
Problema Oz Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.02 kb
program oz;
var f,g:text;
    v:array[1..10000,0..100]of byte;
    a,b,n,m,i,k,r,j,x,cx,cvv,t,ct,c:longint;
    cv:array[0..100]of byte;

procedure cmmdc(l:longint);
begin
  if (cv[0]>0)then
      begin
        k:=0;
        for j:=1 to cv[0] do
          k:=(10*k+cv[j])mod cx;
        cvv:=0;
        for j:=1 to cv[0] do cvv:=cvv*10+cv[j];
        while (k<>0)do
          begin
            cvv:=cx;
            cx:=k;
            k:=cvv mod cx;
          end;
        t:=0;
        for j:=v[l,0] downto 1 do
          begin
            v[l,j]:=v[l,j]*x+t;

            t:=v[l,j]div 10;
            v[l,j]:=v[l,j] mod 10;
          end;
        ct:=t;
        c:=0;
        while (ct>0)do
          begin
            inc(c);
            ct:=ct div 10;
          end;
        for j:=v[l,0] downto 1 do
          v[l,j+c]:=v[l,j];
        j:=c+1;
        while (t>0)do
          begin
            dec(j);
            v[l,j]:=t mod 10;
            t:=t div 10;
          end;
        v[l,0]:=v[l,0]+c;
        r:=0;
        for j:=1 to v[l,0] do
          begin
            k:=10*r+v[l,j];
            v[l,j]:=k div cx;
            r:=k mod cx;
          end;
        j:=1;
        while (v[l,j]=0)do
          inc(j);
        c:=j-1;
        for j:=c+1 to v[l,0] do
          v[l,j-c]:=v[l,j];
        v[l,0]:=v[l,0]-c;
      end else
        begin
          cx:=x;
          while (cx>0)do
            begin
              inc(v[l,0]);
              v[l,v[l,0]]:=cx mod 10;
              cx:=cx div 10;
            end;
        end;
  end;
begin
assign(f,'oz.in');
assign(g,'oz.out');
reset(f);
rewrite(g);
read(f,n,m);
for i:=1 to m do
  begin
    read(f,a,b,x);
    cv[0]:=v[a,0];
    for j:=1 to v[a,0] do
      cv[j]:=v[a,j];
    cx:=x;
    cmmdc(a);
    cv[0]:=v[b,0];
    for j:=1 to v[b,0] do
      cv[j]:=v[b,j];
    cx:=x;
    cmmdc(b);
  end;
for i:=1 to n do
  begin
    for j:=1 to v[i,0] do write(g,v[i,j]);
    write(g,' ');
  end;
close(f);
close(g);
end.