Cod sursa(job #39440)

Utilizator coderninuHasna Robert coderninu Data 26 martie 2007 18:54:28
Problema Bowling Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.5 kb
program bowling;
type binar=-1..2;
var fin,fout:text;
    t,i,l:byte;
    n,c:array[0..50000] of binar
    ;
    nr,j,k:word;
    nume:array[0..1] of string[10];

{-----------------------------}
procedure citire;
begin
 read(fin,nr);
 for j:=1 to nr do read(fin,n[j]);
 n[0]:=0;
 for j:=1 to nr do c[j]:=-1;
 readln(fin);
end;

{-------------------------------}
function cauta(a:word):word;
var b:word;
begin
 b:=a;
 while c[b-1]=-1 do dec(b);
 if b-2>=1 then
 if c[b-2]=c[b-1] then cauta:=1-c[b-1]
                  else cauta:=c[b-1]
 else cauta:=c[b-1];
end;

{-------------------------------}
procedure calcul;
begin
 j:=1;
 while n[j]=0 do inc(j);
 c[j]:=0;
 inc(j);
 for i:=j to nr do
     begin
     if n[i]=1 then
         begin
         k:=i;
         while i-k+1<=3 do
             if n[k-1]=1 then dec(k)
                         else break;
         case i-k of
             0: c[i]:=1-cauta(i-1);
             1: c[i]:=c[k];
             2: c[i]:=1-c[k];
             3: c[i]:=c[k];
         end;
         end;
     end;
end;

{---------------main--------------}
begin
 assign(fin,'bowling.in'); reset(fin);
 readln(fin,t);
 assign(fout,'bowling.out'); rewrite(fout);
 nume[0]:='Nargy';
 nume[1]:='Fumeanu';
 for l:=1 to t do
     begin
     read(fin,nr);
     for j:=1 to nr do read(fin,n[j]);
     n[0]:=0;
     for j:=1 to nr do c[j]:=-1;
     readln(fin);
     calcul;
     writeln(fout,nume[c[nr]]);
     end;
 close(fout);
 close(fin);
end.