Cod sursa(job #39792)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 26 martie 2007 22:55:43
Problema Balanta Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.1 kb
Program cel;
Type vector=array[1..1030] of integer;
var f,h:text;
    g,u,d,s:vector;
    n,m,i,j,nr,r,k,a,b:integer;
    stop:boolean;
Begin
Assign(f,'balanta.in');Reset(f);
Assign(h,'balanta.out');Rewrite(h);
Readln(f,n,m);
For i:=1 to n do
 Begin
  g[i]:=i;
  u[i]:=i;
 end;
For i:=1 to m do
 Begin
  Read(f,nr);
  For j:=1 to nr do Read(f,s[j]);
  For j:=1 to nr do Read(f,d[j]);
  Readln(f,r);
  If r=0 then For j:=1 to nr do
                Begin
                 g[s[j]]:=0;
                 g[d[j]]:=0;
                 u[d[j]]:=0;
                 u[s[j]]:=0;
                end;
  If r=1 then For k:=1 to n do
                Begin
                 If g[k]<>0 then Begin
                                  stop:=false;
                                  For j:=1 to nr do
                                   If k=s[j] then Begin
                                                      stop:=true;
                                                      break;
                                                     end;
                                  If not stop then g[k]:=0;
                                 end;
                 If u[k]<>0 then Begin
                                  stop:=false;
                                  For j:=1 to nr do
                                   If k=d[j] then Begin
                                                      stop:=true;
                                                      break;
                                                     end;
                                  If not stop then u[k]:=0;
                                 end;
                end;
  If r=2 then For k:=1 to n do
                Begin
                 If g[k]<>0 then Begin
                                  stop:=false;
                                  For j:=1 to nr do
                                   If k=d[j] then Begin
                                                      stop:=true;
                                                      break;
                                                     end;
                                  If not stop then g[k]:=0;
                                 end;
                 If u[k]<>0 then Begin
                                  stop:=false;
                                  For j:=1 to nr do
                                   If k=s[j] then Begin
                                                      stop:=true;
                                                      break;
                                                     end;
                                  If not stop then u[k]:=0;
                                 end;
                end;
 end;
j:=0;
k:=0;
For i:=1 to n do
 Begin
  If g[i]<>0 then Begin
                   inc(j);
                   a:=i;
                  end;
  If u[i]<>0 then Begin
                   inc(k);
                   b:=i;
                  end;
 end;
If (j=1) and (k=0) then Writeln(h,a)
                   else If (j=0) and (k=1) then Writeln(h,b)
                                           else Writeln(h,0);
Close(f);
Close(h);
end.