Cod sursa(job #421162)

Utilizator lianaliana tucar liana Data 21 martie 2010 11:51:57
Problema Copii Scor 100
Compilator fpc Status done
Runda Algoritmiada 2010, Runda 4, Clasele 5-8 Marime 1.62 kb
program part;
var f, g:text;
    sol:array[1..100] of longint;
    nc, n, lg, ne: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 i:longint;
  begin
    if k=n+1 then
      begin
        if lg>1 then
          verificare;
      end
     else
       begin
         for i:=1 to lg do
           begin
             sol[k]:=i;
             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.