Đề thi Hai hàng số kỳ ảo

Bài 74/2001 - Hai hàng số kỳ ảo 
(Dành cho học sinh THCS và PTTH)
Tổng các số từ 1 đến 2n: 1 + 2 + … + 2n = (2n*(2n+1))/2 = n*(2n+1).
Do đó, để hai hàng có tổng bằng nhau thì tổng của mỗi hàng phải là: (n*(2n+1))/2, như vậy n phải là số chẵn thì mới tồn tại hai hàng số kì ảo.
Tổng của n cột bằng nhau nên tổng của mỗi cột sẽ là: 2n+1.
ứng với một số A[i] (A[i] = 1, 2, …, 2n) chỉ tồn tại duy nhất một số B[i] = 2n -(A[i] -1) sao cho: A[i] + B[i] = 2n + 1;
Toàn bộ chương trình lời giải:
Program bai74;
uses crt;
var n:byte;
 a:array[1..100]of 0..1;
 th:array[0..50]of byte;
 ok:boolean;
 s:integer;
Procedure xet;
var i,j,tong:integer;
 duoc:boolean;
Begin
tong:=0;
for j:=1 to n do tong:=tong+th[j];
if tong=s div 2 then
begin
 duoc:=true;
 for j:=1 to n-1 do
 for i:=j+1 to n do
 if th[j]+th[i]=(s div n) then duoc:=false;
 if duoc then
 begin
 for i:=1 to n do write(th[i]:3);
 writeln;
 for i:=1 to n do write(((s div n)-th[i]):3);
 ok:=true;
 end;
 end;
end;
Procedure try(i:byte);
 var j:byte;
Begin
 if i>n then xet
 else if not ok then
 for j:=th[i-1]+1 to 2*n do
 begin
 th[i]:=j;
 try(i+1);
 end;
End;
Procedure xuli;
var i:byte;
Begin
 th[0]:=0;
 ok:=false;
 s:=n*(2*n)+1;
 try(1);
 if ok=false then write('Khong the sap xep');
End;
BEGIN
 clrscr;
 write('Nhap n:');readln(n);
 if n mod 2 =1 then writeln('Khong the sap xep')
 else xuli;
 readln;
END.
(Lời giải của bạn Hoàng Phương Nhi - PTTH chuyên Lý Tự Trọng - Cần Thơ)
Nhận xét: Cách làm của bạn Hoàng Phương Nhi - PTTH chuyên Lý Tự Trọng - Cần Thơ dùng thuật toán duyệt nên chạy không được lớn. Với N = 20 thì chương trình chạy rất lâu, nếu N lớn hơn nữa thì không thể ra được kết quả. Bạn có thể cải tiến chương trình này bằng cách kiểm tra các điều kiện ngay trong quá trình duyệt để giảm bớt thời gian duyệt.
Cách làm khác dùng thuật toán chia kẹo chạy rất nhanh với N<35.
Tổng các số từ 1 đến 2n: 1 + 2 + .. + 2n = (2n*(2n+1))/2 = n*(2n+1).
Do đó, để hai hàng có tổng bằng nhau thì tổng của mỗi hàng phải là: (n*(2n+1))/2, như vậy n phải là số chẵn thì mới tồn tại hai hàng số kì ảo.
Tổng của n cột bằng nhau nên tổng của mỗi cột sẽ là: 2n+1.
ứng với một số A[i] (A[i] = 1, 2,.., 2n) chỉ tồn tại duy nhất một số B[i] = 2n -(A[i] -1) sao cho: A[i] + B[i] = 2n + 1
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
uses crt;
const max =35;
 fi = 'bai74.inp';
 fo = 'bai74.out';
var d : array[0..max*(2*max+1) div 2] of byte;
 tr : array[1..max,0..max*(2*max+1) div 2]of byte;
 kq : array[1..max]of integer;
 n,sum : integer;
 ok : boolean;
procedure docf;
var f :text;
 begin
 ok:=false;
 assign(f,fi);
 reset(f);
 read(f,n);
 close(f);
 end;
procedure lam;
var i,j :integer;
 begin
 sum:=n*(2*n+1) div 2;
 fillchar(d,sizeof(d),0);
 fillchar(tr,sizeof(tr),0);
 d[0]:=1;
 for i:=1 to n do
 begin
 for j:=sum-i downto 0 do
 if d[j]=1 then
 begin
 d[j+i]:=2;
 tr[i,j+i]:=1;
 end;
 for j:=sum-(2*n+1-i) downto 0 do
 if d[j]=1 then
 begin
 d[j+2*n+1-i]:=2;
 tr[i,j+2*n+1-i]:=2;
 end;
 for j:=0 to sum do
 if d[j]>0 then dec(d[j]);
 end;
 ok:=(d[sum]=1);
 end;
procedure ghif;
var f :text;
 i,j :integer;
 begin
 assign(f,fo);
 rewrite(f);
 if ok=false then write(f,'No solution')
 else
 begin
 i:=sum;j:=n;
 while i>0 do
 begin
 if tr[j,i]=1 then kq[j]:=j else kq[j]:=2*n+1-j;
 i:=i-kq[j];
 dec(j);
 end;
 for j:=1 to n do write(f,kq[j]:6);
 writeln(f);
 for j:=1 to n do write(f,(2*n+1-kq[j]):6);
 end;
 close(f);
 end;
BEGIN
 docf;
 if n mod 2=0 then lam;
 ghif;
END.