Đề thi Về một ma trận số

Bài 79/2001 - Về một ma trận số
(Dành cho học sinh THCS)
Bài này có rất nhiều nghiệm, để liệt kê tất cả các nghiệm thì phải sử dụng thuật toán duyệt. Do không gian tìm kiếm là cực kì lớn nên nếu duyệt tầm thường thì không thể giải đuợc, thậm chí còn không ra nghiệm nào cả. Vì vậy bài giải này duyệt bằng cách xây dựng một mảng ban đầu thoả mãn tích chất: dùng đúng 10 số 0, 10 số 1, ..., 10 số 9 và mỗi dòng không có quá 4 số khác nhau. Sau đó bằng cách hoán vị vòng các dòng để thoả mãn tính chất của đề bài.
Chọn mảng ban đầu như thế giảm đi rất nhiều khả năng và cũng làm mất đi rất nhiều nghiệm. Mảng ban đầu có thể có rất nhiều cách chọn, số nghiệm tìm ra phụ thuộc rất nhiều vào cách chọn này.
Ví dụ có thể chọn mảng ban đầu là:
(0,0,1,1,2,2,2,3,3,3)
(1,1,2,2,3,3,3,4,4,4)
(2,2,3,3,4,4,4,5,5,5)
(3,3,4,4,5,5,5,6,6,6)
(4,4,5,5,6,6,6,7,7,7)
(5,5,6,6,7,7,7,8,8,8)
(6,6,7,7,8,8,8,9,9,9)
(7,7,8,8,9,9,9,0,0,0)
(8,8,9,9,0,0,0,1,1,1)
(9,9,0,0,1,1,1,2,2,2)
Vì số nghiệm rất nhiều nên ta muốn ghi ra bao nhiêu nghiệm thì thay đổi biến sn để thay đổi số nghiệm cần ghi ra. Bài giải này in ra 100 nghiệm.
Các bạn chú ý rằng nếu có 1 bảng thoả mãn tính chất của bài thì tráo 2 dòng hoặc tráo 2 cột bất kì với nhau, hoặc quay 900 bảng ta có thể có các bảng cũng thoả mãn.
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+}
{$M 65384,0,655360}
uses crt;
type MG = array[1..10,1..10]of integer;
 mg1c = array[1..10]of integer;
const N =10;
 p = 4;
 sn =100; {số nghiệm muốn ghi ra}
 fo ='out.txt';
 h :MG= {một cách chọn khác}
 ((0,0,0,1,1,1,2,2,2,3),
 (1,1,1,2,2,2,3,3,3,4),
 (2,2,2,3,3,3,4,4,4,5),
 (3,3,3,4,4,4,5,5,5,6),
 (4,4,4,5,5,5,6,6,6,7),
 (5,5,5,6,6,6,7,7,7,8),
 (6,6,6,7,7,7,8,8,8,9),
 (7,7,7,8,8,8,9,9,9,0),
 (8,8,8,9,9,9,0,0,0,1),
 (9,9,9,0,0,0,1,1,1,2));
var a,dx : MG;
 lap : mg1c;
 dem : longint;
 f : text;
procedure init;
var k :integer;
 begin
 dem:=0;
 a:=h;
 fillchar(dx,sizeof(dx),0);
 fillchar(lap,sizeof(lap),0);
 for k:=1 to N do lap[k]:=1;
 for k:=1 to N do dx[k,a[1,k]+1]:=1;
 end;
procedure ghikq(w:mg);
var i,j,ds:integer;
 begin
 inc(dem);
 writeln('****** :',dem,':******');
 writeln(f,'****** :',dem,':******');
 for i:=1 to N do
 begin
 for j:=1 to N do
 begin
 write(w[i,j]:2);
 write(f,w[i,j]:2);
 end;
 writeln;writeln(f);
 end;
 end;
function doi(k:integer):integer;
 begin
 if k mod N=0 then doi:=N
 else doi:=k mod N;
 end;
procedure try(k:byte;w:MG);
var i,j :byte;
 luu :mg1c;
 ldx :mg;
 ok :boolean;
 begin
 luu:=lap;ldx:=dx;
 for i:=1 to N do
 begin
 lap:=luu;dx:=ldx;
 for j:=1 to N do w[k,j]:=a[k,doi(i+j-1)];
 ok:=true;
 for j:=1 to N do
 begin
 inc(lap[j],1-dx[j,w[k,j]+1]);
 dx[j,w[k,j]+1]:=1;
 if lap[j]>4 then
 begin
 ok:=false;
 break;
 end;
 end;
 if ok then
 begin
 if k=N then
 ghikq(w)
 else try(k+1,w);
 end;
 if dem=sn then exit;
 end;
 lap:=luu;dx:=ldx;
 end;
BEGIN
 clrscr;
 init;
 assign(f,fo);
 rewrite(f);
 try(2,a);
 close(f);
END.
(Lời giải của Vũ Anh Quân)