Cod sursa(job #421562)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 21 martie 2010 14:39:29
Problema Copii Scor 0
Compilator fpc Status done
Runda Algoritmiada 2010, Runda 4, Clasele 9-10 Marime 4.14 kb
program alex;
var  f:text;
     s:array[1..10]of string;
     st:array[1..10]of integer;
     b,c:array[1..10]of integer;
     as,ev,e,z:boolean;
     n,i,k,v,u,q,j,h,d,nr:longint;
begin
assign(f,'copii.in');reset(f);
readln(f,n);
for i:=1 to n do
    readln(f,s[i]);
close(f);
nr:=0;
k:=1;
st[k]:=0;
while k>0 do
      begin
      repeat
      if st[k]<n then begin
                      as:=true;
                      st[k]:=st[k]+1;
                      end
                 else as:=false;
      if as then ev:=true;
      until(as and ev)or(not as);
      if as then begin
                 if k=n then begin
                             e:=true;
                             for i:=1 to n do
                                 begin
                                 k:=0;
                                 for j:=1 to n do
                                     if st[j]=i then begin
                                                     k:=k+1;
                                                     c[k]:=j;
                                                     end;
                                 v:=0;
                                 for j:=1 to k do
                                     begin
                                     for h:=1 to n do
                                         if s[c[j]][h]='1' then begin
                                                              z:=false;
                                                              for q:=1 to v do
                                                                  if b[q]=h then begin
                                                                                 z:=true;
                                                                                 break;
                                                                                 end;
                                                              if z=false then begin
                                                                              v:=v+1;
                                                                              b[v]:=h;
                                                                              end;
                                                              end;
                                     end;
                                 for q:=1 to n do
                                     if q<>i then begin
                                                     k:=0;
                                                     d:=0;
                                                     for j:=1 to n do
                                                         if st[j]=q then begin
                                                                        k:=k+1;
                                                                        c[k]:=j;
                                                                        for h:=1 to v do
                                                                            if b[h]=c[k] then begin
                                                                                              d:=d+1;
                                                                                              break;
                                                                                              end;
                                                                        end;

                                                   if d=0 then e:=false;
                                                  end;
                                 end;
                             if e=true then nr:=nr+1;
                             end
                        else begin
                             k:=k+1;
                             st[k]:=0;
                             end;
                 end
            else k:=k-1;
      end;
assign(f,'copii.out');rewrite(f);
if n=1 then writeln(f,0)
       else if n=2 then begin
                        if(s[1][2]='1')and(s[2][1]='1')then writeln(f,1)
                                                       else writeln(f,0);
                        end
                   else writeln(f,n);
close(f);
end.