usaco 2.2 lamps 2008.6.20

usaco 2.2 lamps 2008.6.20

{

ID:  

PROG: lamps

LANG: PASCAL

}

program p_lamps;

var x:array[1..4,1..6]of string;

      y:array[1..4]of longint;

      a,s:string;

      i,j,k,w,n,t,l1,l2,c:longint;

      b:array[1..18]of string;

      f1,f2:text;

      on1,off1:array[1..100]of longint;

procedure qsort(i1,j1:longint);

var

 l1,r1:longint;x1,y1:string;

   begin

      l1:=i1;r1:=j1;

      x1:=b[(l1+r1) div 2];

      repeat

      while b[l1]<x1 do inc(l1);

      while b[r1]>x1 do dec(r1);

       if l1<=r1 then

                 begin

                       y1:=b[l1];b[l1]:=b[r1];b[r1]:=y1;inc(l1);dec(r1);

                 end;

      until l1>r1;

      if r1>i1 then qsort(i1,r1);

      if l1<j1 then qsort(l1,j1);

      end;

 procedure put;

 begin

  y[1]:=4;y[2]:=6;y[3]:=4;y[4]:=1;

  x[1,1]:='1';x[1,2]:='2';x[1,3]:='3';x[1,4]:='4';

  x[2,1]:='12';x[2,2]:='13';x[2,3]:='14';x[2,4]:='23';x[2,5]:='24';x[2,6]:='34';

  x[3,1]:='123';x[3,2]:='124';x[3,3]:='134';x[3,4]:='234';

  x[4,1]:='1234';

 end;

 procedure deal(var ch:char);

 begin

   ifch='0' then ch:='1' else ch:='0';

 end;

procedure doit;

var i,j,m,v:longint;flag:boolean;

begin

  if(k=0)and(l2=0)(*****1****) then begin inc(t);b[t]:=s;inc(k,2);end;

 while k<=4 do

    begin

      for i:=1 to y[k] do

        begin

          a:=s;

          for j:=1 to k do

            case x[k,i,j]of

               '1':for m:=1 to n do deal(a[m]);

               '2':for m:=1 to (n div 2) dodeal(a[m*2]);

               '3':for m:=1 to ((n+1)div 2) dodeal(a[2*m-1]);

               '4':for m:=1 to ((n+2)div 3) dodeal(a[3*m-2]);

               end;

          flag:=true;v:=0;

          if l1<>0 then begin

          repeat inc(v);until (a[on1[v]]<>'1')or(v=l1);

          if a[on1[v]]<>'1' then flag:=false;end;

          if (flag)and(l2<>0) then

              begin v:=0;repeat inc(v);until(a[off1[v]]<>'0')or(v=l2);

              if a[off1[v]]<>'0' thenflag:=false;

              end;

              if flag then begin inc(t);b[t]:=a;end;

        end;{for i}

        inc(k,2);

    end;{while }

    end;

{-------------------main--------------------}

begin

 put;

 assign(f1,'lamps.in');reset(f1);

 assign(f2,'lamps.out');rewrite(f2);

 readln(f1,n);readln(f1,c);l1:=0;l2:=0;

 repeat

    read(f1,w);inc(l1);on1[l1]:=w;

 until w=-1;

 repeat

   read(f1,w);inc(l2);off1[l2]:=w;

 until w=-1;

 dec(l2);dec(l1);s:='';for i:=1 to n do s:=s+'1';

if c<>0 then

begin

 k:=c mod 2;

 t:=0;

 doit;

 qsort(1,t);

 i:=0;

  ift<>0 then

 repeat

    inc(i);

      for j:=1 to n do

        write(f2,b[i,j]);

        writeln(f2);

 until(i>=t) else writeln(f2,'IMPOSSIBLE');

end else

 begin

   if l2<>0 then writeln(f2,'IMPOSSIBLE') else writeln(f2,s);

 end;(******2*****)

     close(f1);

     close(f2);

end.