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.