Cod sursa(job #25621)

Utilizator coderninuHasna Robert coderninu Data 4 martie 2007 13:10:40
Problema Balanta Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.58 kb
program balanta;
type nr=0..1026;
var x:array[nr] of nr;
    fin,fout:text;
    i,n,m:word;
    greu,usor,rez:word;
{---------------------------}

procedure citire(a:nr);
begin
 reset(fin);
 for i:=1 to m-a+1 do
     readln(fin);
 read(fin,x[0]);
 for i:=1 to 2*x[0]+1 do
     read(fin,x[i]);
end;


{------------------------}
function verif(a,b:word):byte;
var aux1,aux2:0..2;
begin
 for i:=1 to 2*x[0] do
     begin
     if a=x[i] then
        if (i<=x[0]) then aux1:=1
                      else aux1:=2;
     if b=x[i] then
        if (i<=x[0]) then aux2:=1
                      else aux2:=2;
     end;
 if aux1=aux2 then verif:=aux1
              else verif:=0;
end;


{------------main-----------}


begin
 assign(fin,'balanta.in');
 reset(fin);
 read(fin,n,m);
 i:=1;
 rez:=0;
 while ((i<=m) and (rez=0)) do
     begin
     citire(i);
     if greu=0 then
         begin
         if ((x[2*x[0]+1]=1) and (x[0]=1)) then
             begin
             greu:=x[1];
             usor:=x[2];
             end;
         if ((x[2*x[0]+1]=2) and (x[0]=1)) then
             begin
             greu:=x[2];
             usor:=x[1];
             end;
         end;
     if verif(greu,usor)=1 then
         if x[2*x[0]+1]=1 then rez:=greu
                          else rez:=usor;
     if verif(greu,usor)=2 then
         if x[2*x[0]+1]=1 then rez:=usor
                          else rez:=greu;
     if verif(greu,usor)=0 then rez:=0;
     inc(i);
     end;
 assign(fout,'balanta.out'); rewrite(fout);
 write(fout,rez);
 close(fin);
 close(fout);
end.