Cod sursa(job #1391699)

Utilizator mariusadamMarius Adam mariusadam Data 18 martie 2015 09:18:16
Problema Evaluarea unei expresii Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.48 kb
program angrenaj_tarina;
type fractie=record
        p,q:longint;
end;
const inf=maxlongint;
var     n,m:integer;
        a:array[1..201,1..201] of integer;
        viz,mark:array[1..200] of integer;
        bipartit:boolean;

function cmmdc(a,b:longint):longint;
begin
 if b<>0 then
        cmmdc:=cmmdc(b,a mod b)
 else
        cmmdc:=a;
end;

procedure citire;
var     i,j,k,x,y,dp,dq:integer;
        f:text;
begin
 assign(f,'9-angrenaj.in'); reset(f);
 readln(f,n,m);
 for k:=1 to m do begin
        readln(f,i,j,x,y);
        if a[i,j]<>0 then begin
                if (a[i,j]*y<>a[j,i]*x) then begin
                        a[i,j]:=-1;
                        a[j,i]:=-1;
                end
        end
        else begin
                a[i,j]:=x;
                a[j,i]:=y;
        end;
 end;
 close(f);
end;

procedure depth(nod,v:integer);
var     i:integer;
begin
 viz[nod]:=1;
 mark[nod]:=v;
 v:=-v;
 for i:=1 to n do
        if (a[nod,i]>0) then begin
                if (viz[i]=0) then
                        depth(i,v)
                else
                if (mark[i]<>v) or (a[nod,i]=-1) then
                        bipartit:=false;
        end;
end;

procedure bfs(nod:integer; var g:text);
var     cd:array[1..201] of integer;
        v:array[1..201] of fractie;
        st,sf,i,prec,d:integer;
begin
 viz[nod]:=1;
 st:=1; sf:=1;
 cd[st]:=1;
 v[1].p:=1;
 v[1].q:=1;
 while (st<=sf) do begin
        prec:=cd[st];
        for i:=1 to n do
                if (a[prec,i]>0) and (viz[i]=0) then begin
                        viz[i]:=1;
                        sf:=sf+1;
                        cd[sf]:=i;
                        v[i].p:=v[prec].p*a[prec,i] mod 10000000;
                        v[i].q:=v[prec].q*a[i,prec] mod 10000000;
                        d:=cmmdc(v[i].p,v[i].q);
                        v[i].p:=v[i].p div d;
                        v[i].q:=v[i].q div d;
                end;
        st:=st+1;
 end;
 for i:=1 to n do
        if viz[i]=0 then
                writeln(g,0,' ',1)
        else
                writeln(g,mark[i]*v[i].p,' ',v[i].q);
end;

procedure rezolva;
var     i:integer;
        g:text;
begin
 assign(g,'angrenaj.out'); rewrite(g);
 bipartit:=true;
 depth(1,1);
 if bipartit then begin
        for i:=1 to n do
                viz[i]:=0;
        bfs(1,g);
 end
 else
        for i:=1 to n do
                writeln(g,0,' ',1);
 close(g);
end;

begin
 citire;
 rezolva;
end.