[an error occurred while processing this directive]
Listing SAH.PAS 
 Program game; 
 const ni='game.in'; 
 no='game.out'; 
 type board=array [1..4,1..4] of Word; 
 vector=array [1..12870] of Word; 
 pvector=^vector; 
 var f:Text; 
 c:array [1..16,0..16] of Word; 
 v,t:vector; s:pvector; 
 drum:array [1..48] of Word; 
 n,i,j,k,codini,codfin,p,u,l,aux: 
 Word; 
 a,ini,fin,now,next:board; 
 ch:Char; eg,found:boolean; 
 
  procedure load; 
 begin 
 Assign(f,ni); 
 Reset(f); 
 for i:=1 to 4 
do 
 begin
 for j:=1 to 4 
do 
 begin
 Read(f,ch); 
 if ch='1' then ini[i,j]:=1 
 else ini[i,j]:=0 
 end; 
 Readln(f) 
 end; 
 Readln(f); 
 for i:=1 to 4 
do 
 begin
 for j:=1 to 4 
do 
 begin
 Read(f,ch); 
 if ch='1' then fin[i,j]:=1 
 else fin[i,j]:=0 
 end; 
 Readln(f) 
 end; 
 Close(f) 
 end; 
 
 procedure egale; 
 begin 
 eg:=true; 
 for i:=1 to 4 do 
 for j:=1 to 4 do 
 if ini[i,j]<>fin[i,j] 
then 
eg:=false; 
 if eg 
then 
 begin
 Assign(f,no); Rewrite(f); 
 Writeln(f,0); 
 Close(f); Halt 
 end 
 end; 
 
 procedure calc_comb; 
 begin 
 c[1,0]:=1; c[1,1]:=1; 
 for i:=2 to 16 
do 
 begin
 c[i,0]:=1; c[i,i]:=1; 
 for j:=1 to i-1 do 
 c[i,j]:=c[i-1,j-1]+c[i-1,j] 
 end 
 end; 
 
  procedure board_to_number(a:board; 
 var n:Word); 
 var i,j,s,u:Word; 
 begin 
 s:=16; 
 u:=8; 
 n:=0; 
 for i:=1 to 4 do 
 for j:=1 to 4 
do 
 begin
 if a[i,j]=0 then 
 n:=n+c[s-1,u-1] 
 else u:=u-1; 
 s:=s-1; 
 if u=0 
then 
 begin
 j:=4; 
 i:=4 
 end 
 end; 
 n:=n+1 
 end; 
 
 procedure number_to_board(n:Word; 
 var a:board); 
 var i,j,s,u:Word; 
 begin 
 s:=16; 
 u:=8; 
 for i:=1 to 4 do 
 for j:=1 to 4 do 
 a[i,j]:=0; 
 for i:=1 to 4 do 
 for j:=1 to 4 do 
 if not ((i=4) and (j=4)) 
then 
 begin
 if n>c[s-1,u-1] 
then 
n:=n-c[s-1,u-1] 
 
else 
 begin
 a[i,j]:=1; 
 u:=u-1 
 end; 
 s:=s-1; 
 if u=0 
then 
 begin
 j:=4; 
 i:=4; 
 end 
 end 
 else 
 if n>0 then a[i,j]:=1 
 else a[i,j]:=0 
 end; 
 
 procedure init; 
 begin 
 New(s); 
 for i:=1 to c[16,8] do 
 s^[i]:=0; 
 board_to_number(ini,n); 
 v[1]:=n; 
 t[1]:=0; 
 s^[n]:=1; 
 p:=1; 
 u:=1; 
 board_to_number(ini,n); 
 codini:=n; 
 board_to_number(fin,n); 
 codfin:=n 
 end; 
 
 procedure move; 
 begin 
 for i:=1 to 4 do 
 for j:=1 to 3 do 
 if a[i,j]<>a[i,j+1] 
then 
 begin
 a[i,j]:=1-a[i,j]; 
 a[i,j+1]:=1-a[i,j+1]; 
 board_to_number(a,n); 
 a[i,j]:=1-a[i,j]; 
 a[i,j+1]:=1-a[i,j+1]; 
 if s^[n]=0 
then 
 begin
 s^[n]:=1; u:=u+1; 
 v[u]:=n; t[u]:=p; 
 if n=codfin 
then 
 begin
 found:=true; 
 j:=3; i:=4 
 end; 
 end; 
 end; 
 if not found then 
 for i:=1 to 3 do 
 for j:=1 to 4 do 
 if a[i,j]<>a[i+1,j] 
then 
 begin
 a[i,j]:=1-a[i,j]; 
 a[i+1,j]:=1-a[i+1,j]; 
 board_to_number(a,n); 
 a[i,j]:=1-a[i,j]; 
 a[i+1,j]:=1-a[i+1,j]; 
 if s^[n]=0 
then 
 begin
 s^[n]:=1; u:=u+1; 
 v[u]:=n; t[u]:=p; 
 if n=codfin 
then 
 begin
 found:=true; j:=4; i:=3 
 end 
 end 
 end 
 end; 
 procedure work; 
 begin 
 found:=false; 
 while (p<=u) and (not found) 
do 
 begin
 n:=v[p]; 
 number_to_board(n,a); 
 move; 
 if not found then p:=p+1 
 else write 
 end 
 end; 
 
 procedure reconst; 
 begin 
 l:=0; 
 while u>0 
do 
 begin
 l:=l+1; drum[l]:=v[u]; 
 u:=t[u] 
 end; 
 p:=1; u:=l; 
 while p<u 
do 
 begin
 aux:=drum[p]; 
 drum[p]:=drum[u]; 
 drum[u]:=aux; 
 p:=p+1; u:=u-1 
 end 
 end; 
 
 procedure scrie; 
 begin 
 Assign(f,no); Rewrite(f); 
 Writeln(f,l-1); 
 for k:=1 to l-1 
do 
 begin
 n:=drum[k]; 
 number_to_board(n,a); 
 now:=a; n:=drum[k+1]; 
 number_to_board(n,a); 
 next:=a; 
 for i:=1 to 4 do 
 for j:=1 to 4 do 
 if now[i,j]<>next[i,j] 
then 
write(f,i,' ',j,' '); 
 Writeln(f) 
 end; 
 Close(f) 
 end; 
 
 Begin  
 Load; 
 egale; 
 calc_comb; 
 init; 
 work; 
 reconst; 
 scrie 
 End. 

[cuprins]