Cod sursa(job #584843)

Utilizator vladvaldezVlad Dimulescu vladvaldez Data 26 aprilie 2011 19:49:55
Problema Copii Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.11 kb
program part;
var f, g:text;
sol:array[1..100] of longint;
nc, n, lg:longint;
pe, oe, p:array[1..20] of longint;
procedure citire;
var i, j:longint;
s:string;
begin
readln(f,n);
for i:=1 to n do
begin
readln(f,s);
for j:=n downto 1 do
p[i]:=p[i]*2+ord(s[j])-ord('0');
end;
end;
procedure verificare;
var i, j:longint;
ok, gasit:boolean;
begin
for i:=1 to n do
begin
pe[i]:=0;
oe[i]:=0;
end;
for i:=1 to lg do
for j:=1 to n do
if sol[j]=i then
begin
pe[i]:=pe[i] or p[j];
oe[i]:=oe[i] or 1 shl (j-1);
end;
ok:=true;
for i:=1 to lg do
begin
gasit:=false;
for j:=1 to lg do
if (pe[i] and oe[j]=0) and (i<>j) then
begin
gasit:=true;
break;
end;
if gasit then
begin
ok:=false;
break;
end;
end;
if ok then
nc:=nc+1;
end;
procedure gen(k:longint);
var ii:longint;
begin
if k=n+1 then
begin
if lg>1 then
verificare;
end
else
begin
for ii:=1 to lg do
begin
sol[k]:=ii;
gen(k+1);
end;
sol[k]:=lg+1;
lg:=lg+1;
gen(k+1);
lg:=lg-1;
end;
end; 
begin
assign(f,'copii.in'); reset(f);
assign(g,'copii.out'); rewrite(g);
citire;
gen(1);
writeln(g,nc);
close(f);
close(g);
end.