Cod sursa(job #37917)

Utilizator coderninuHasna Robert coderninu Data 25 martie 2007 13:04:04
Problema Bowling Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.16 kb
program bowling;
type binar=0..1;
var fin,fout:text;
    t,i:byte;
    n:array[1..50000] of binar;
    nr,j:word;
    c:array[0..1,1..50000] of word;

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

{-------------------------------}
procedure calcul;
var k:binar;
    pas:word;
begin
 j:=1;
 while n[j]=0 do inc(j);
 c[0,j]:=1;
 if n[j+1]=1 then c[0,j+1]:=1;
 for j:=1 to nr-1 do
     begin
     pas:=1;
     while n[j+pas]=0 do inc(pas);
     for k:=0 to 1 do
         if c[k,j]<>0 then
             begin
             c[1-k,j+pas]:=c[k,j]+1;
             if n[j+pas+1]=1 then
                 c[1-k,j+pas+1]:=c[k,j]+1;
             end;
     end;
end;

{---------------main--------------}
begin
 assign(fin,'bowling.in'); reset(fin);
 readln(fin,t);
 assign(fout,'bowling.out'); rewrite(fout);
 for i:=1 to t do
     begin
     citire;
     calcul;
     if (c[0,nr]<>0) and (c[0,nr]<c[1,nr]) then
         writeln(fout,'Nargy')
     else writeln(fout,'Fumeanu');
     end;
 close(fout);
 close(fin);
end.