Bài 63/2001 - Tìm số nhỏ nhất
(Dành
cho học sinh Tiểu học)
a. Số đó chia hết cho 9 nên tổng các chữ số của nó phải
chia hết cho 9. Ta thấy tổng 0 + 1 + 2 + 3 + 4 + 5 + 6 + 7 + 8 + 9 = 45 chia
hết cho 9. Vậy số nhỏ nhất bao gồm tất cả các chữ số 0, 1, 2, ..., 9 mà chia
hết cho 9 là: 1023456789.
b. Số này chia hết cho 5 nên tận cùng phải là 0 hoặc 5. Nếu
tận cùng là 5 thì số nhỏ nhất sẽ là 1023467895 còn nếu số đó tận cùng là 0 thì
số nhỏ nhất sẽ là123457890.
So sánh hai số trên, suy ra số nhỏ nhất phải tìm là:
1023467895
c. Một số chia hết cho 20, do đó phải chia hết cho 10. Suy
ra số đó phải là số nhỏ nhất tận cùng là 0. Mặt khác, chữ số hàng chục của số đó
phải là một số chẵn. Vì vậy ta tìm được
số phải tìm là 1234567980.
Bài
64/2001 - Đổi ma trận số
(Dành
cho học sinh THCS và PTTH)
Program DoiMT;
Uses Crt;
Const nmax=50;
inp='INPUT.TXT'; {Du lieu duoc nhap vao
file input.txt}
Type Mang=array
[1..nmax,1..nmax] of real;
Var a,b,c: Mang;
n,i,j: integer;
Procedure Nhap;
Var i,j: integer;
f: text;
Begin
Assign(f,inp); Reset(f);
Readln(f,n);
For i:=1 to 2*n do
begin
For j:=1 to 2*n do Read(f,c[i,j]);
Readln(f);
end;
Close(f);
End;
Procedure Xuat(a:
Mang);
Var i,j: integer;
Begin
For i:=1 to 2*n do
begin
For j:=1 to 2*n do Write(a[i,j]:8:2);
Writeln;
end;
End;
BEGIN
Nhap;
For i:=1 to n do
For j:=1 to n do
begin
a[i+n,j+n]:=c[i,j];
a[i,j+n]:=c[i+n,j];
a[i,j]:=c[i+n,j+n];
a[i+n,j]:=c[i,j+n];
b[i,j]:=c[i+n,j];
b[i,j+n]:=c[i,j];
b[i+n,j+n]:=c[i,j+n];
b[i+n,j]:=c[i+n,j+n];
end;
ClrScr;
Xuat(c); {mang ban dau}
Writeln;
Xuat(a);
Writeln;
Xuat(b);
Readln;
END.
(Lời giải của bạn Lê Thanh Tùng - Vĩnh Yên - Vĩnh Phúc)
Bài 65/2001 - Lưới ô vuông vô
hạn
(Dành
cho học sinh THCS và PTTH)
Program bai65;
uses crt;
var
a:array[1..100,1..100] of integer;
b,i,j,n,m,k:integer;
f:text;
t:boolean;
Begin
clrscr;
write('Nhap so n: '); readln(n);
write('Nhap so m: '); readln(m);
for i:=1 to m do
for j:=1 to n do a[i,j]:=-1;
for i:=m downto 1 do
for j:=1 to n do
begin
b:=-1;
repeat
inc(b); t:=true;
for k:=1 to n do if a[i,k]=b then
t:=false; {kt hang}
for k:=1 to m do if a[k,j]=b then
t:=false; {kt cot}
until t;
a[i,j]:=b;
end;
assign(f,'KQ.TXT');
rewrite(f);
for i:=1 to m do
begin
for j:=1 to n do write(f,a[i,j]:5);
writeln(f);
end;
close(f);
write('Mo file KQ.TXT de xem ket qua!');
readln;
END.
(Lời
giải của bạn Nguyễn Trường Đức Trí)
Bài 66/2001 - Bảng số 9 x 9
(Dành cho học sinh Tiểu họcvà THCS)
Ta sẽ điền
vào các ô ở cột thứ năm các số lớn nhất có thể được. Nếu số lớn nhất trong các
cột còn lại (chưa điền vào bảng) là a, thì số lớn nhất có thể điền vào
cột thứ năm là a- 4 vì các số phải điền theo thứ tự tăng dần theo hàng
mà sau cột thứ 5 còn có 4 cột nữa. Ta thực hiện điền các số giảm dần từ 81 vào
nửa phải của bảng trước, sau đó dễ dàng điền vào nửa còn lại với nhiều cách
khác nhau:
1
|
2
|
3
|
4
|
77
|
78
|
79
|
80
|
81
|
5
|
6
|
7
|
8
|
72
|
73
|
74
|
75
|
76
|
9
|
10
|
11
|
12
|
67
|
68
|
69
|
70
|
71
|
13
|
14
|
15
|
16
|
62
|
63
|
64
|
65
|
66
|
17
|
18
|
19
|
20
|
57
|
58
|
59
|
60
|
61
|
21
|
22
|
23
|
24
|
52
|
53
|
54
|
55
|
56
|
25
|
26
|
27
|
28
|
47
|
48
|
49
|
50
|
51
|
29
|
30
|
31
|
32
|
42
|
43
|
44
|
45
|
46
|
33
|
34
|
35
|
36
|
37
|
38
|
39
|
40
|
41
|
Program bai66;
Uses
ctr ;
Var i,j : integer ;
Begin
Clsscr;
for
i:= 1 to do
begin
for j:= 1to 4 do write (4*(i-1) + j
:3);
for j:= 0 to 4 do write (81-4*i-(i-1)+j
:3) ;
Writeln;
end ;
Write (‘tong cac so o cot 5:
‘,(37+77)*9div2);
Readln
End.
(Lời
giải của bạn Nguyễn Chí Thức - Lớp 11A1 - Khối PTCTT - ĐHSPHN - Thôn Đại Đồng
- xã Thuỵ Phương - Từ Liêm - Hà Nội)
Bài 67/2001 - Về các phép
biến đổi "Nhân 2 trừ 1"
(Dành cho học sinh THCS và PTTH)
Để biến
đổi ma trận A thành 0, ta biến đổi từng cột thành 0
Xét một
cột bất kì có n số a1, ..., an (ai >= 0)
Đặt X =
max(a1, ..., an).
- Bước 1:
+ Nếu dãy a1, ..., an có một số 0
và một số khác 0, dừng ở đây vì không thể đưa A về 0;
- Bước
2:
+ Nếu dãy a1, ..., an có ai = 0
(i = 1..n) thì cột này đã được biến đổi xong, qua cột tiếp theo,
+ Nếu không thì ai = 2ai nếu 2ai <= X
(nhân hàng có chứa số ai lên 2), tiếp tục thực hiện đến khi không nhân được
nữa, qua bước 3;
- Bước 3:
X:= X-1;
ai:= ai-1;
Quay
lại bước 2.
Đây
không phải là lời giải tốt ưu nhưng rất đơn giản, dễ dàng cài đặt (việc viết
chương trình tương đối đơn giản)
Nhận
xét: Bài này thực sự dễ nếu chỉ dừng
lại ở mức tìm thuật toán? Nếu đặt lại điều kiện là có thể nhân hàng, cột cho 2,
trừ hàng, cột cho 1, tìm lời giải tối ưu với giới hạn của M, N thì hay hơn
nhiều.
(Lời
giải của bạn Vũ Lê An - Lớp 11T2 - Lê Khiết - Quảng Ngãi)
Thuật toán của bạn Vũ Lê An rất đúng. Song trên thực
tế thuật toán này còn một điểm chưa chuẩn vì nếu các số của mảng số thì nhỏ, số
thì lớn thì thuật toán này mất rất nhiều bước. Việc nhân có thể gây ra tràn số.
Ví
dụ:
2
3
1 100
1
100 1
100
số
bước sẽ rất lớn.
Nhưng
thuật toán này trên lý thuyết là giải được. Chương trình theo thuật toán trên.
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+,Y+}
{$M
16384,0,655360}
program
bai67_bien_doi_mang; {Author : Nguyen Van Chung}
uses
crt;
const max =100;
fi ='bai67.inp';
fo ='bai67.out';
var a
:array[1..max,1..max]of longint;
m,n :integer;
procedure
docf;
var
f :text;
i,j
:integer;
begin
assign(f,fi);
reset(f);
read(f,m,n);
for i:=1 to m do
for j:=1 to n do read(f,a[i,j]);
close(f);
end;
procedure
lam;
var f
:text;
i,j,ma,mi,k :longint;
begin
assign(f,fo);
rewrite(f);
for j:=1 to n do
begin
ma:=0;mi:=maxlongint;
for i:=1 to m do
begin
if a[i,j]>ma then ma:=a[i,j];
if a[i,j]<mi then mi:=a[i,j];
end;
if (ma>0)and(mi=0) then
begin
rewrite(f);
writeln(f,'No solution');
break;
end;
repeat
for i:=1 to m do
begin
while a[i,j]*2<=ma do
begin
for k:=1 to n do
a[i,k]:=a[i,k]*2;
writeln(f,'nhan 2 dong :',i);
end;
a[i,j]:=a[i,j]-1;
end;
dec(ma);
writeln(f,'tru 1 cot :',j);
until ma=0;
end;
close(f);
end;
BEGIN
docf;
lam;
END.
Bài 68/2001 - Hình tròn và bảng
vuông
(Dành cho học sinh PTTH)
+ Tính
số ô vuông bị cắt bởi hình tròn:
Nếu trục toạ độ là (0,0) thì tâm vòng tròng có
toạ độ (n,n). Xét 1 phần 4 vòng tròn từ 6 giờ đến giờ ô bị cắt là ô có đỉnh (i,j) nằm ngoài
vònh tròn và 1 đến 3 đỉnh (i+1, j), (i, j+1), (i+1, j+1) trong vòng tròn. Do
tính đối xứng ta chỉ cần tính số ô của 1 phần 4 vòng tròn rồi nhân với 4. Tuy
nhiên nếu nhận xét kĩ hơn ta thấy với n = 2, số ô bị cắt là 12, khi n tăng 1 đơn
vị, số ô bị cắt tăng lên 8 ô. Do đó ta có thể tính thẳng số ô bị cắt bằng công
thức : Số ô bị cắt =12 + (n-2)*8
+ Tính
số ô nằm trong vòng tròn:
Cũng do
tính đối xứng ta chỉ cần tính số ô nằm trong 1 phần 4 vòng tròn rồi nhân với 4,
ô nằm trong vòng tròn khi tất cả 4 đỉnh nằm trong vòng tròn.
Chương
trình Pascal
Uses
Ctr;
Const
S1 =’INPUT.TXT’;
S2=’OUTPUT.TXT’;
VarF1F2:
text;
I,J,N :
word;
Dem
:longint;
FunctionTrong(X,Y:
longint): boolean;
Begin
Trong:=
4*(sqr(X-N)+sqr(Y-N))<=sqr(2*N-1);
End
BEGIN
Clrscr;
Assign(F1,S1);
Reset(F1);
Assign(F2,S2);
Rewrite(F2);
While
not eof(F1) do
Begin
Readln(F1,N);
Write(F2,’N=,’=>’,12+((N-2)*8));
Dem:=
0;
For I:=
0 to N-1 do
For J:=
0 to J-1 do
If
Trong (I,J) and Trong (I+1,J) and Trong (I,J+1) and Trong (I+1, J+1) then(Dem)
Writeln(F2,’’,Dem*4);
End;
Close(F1);
Close(F2);
End.
(Lời
giải của bạn Lâm Tấn Minh Tâm - 12 Tin trường PTTH Chuyên Tiền Giang- Tiền
Giang)
Bài
69/2001 - Bội số của 36
(Dành
cho học sinh Tiểu học)
Một số đồng
thời chia hết cho 4 và 9 thì sẽ chia hết cho 36 (vì 4 và 9 nguyên tố cùng nhau:
(4, 9) = 1).
Ta
thấy, tổng của tất cả các số từ 1 đến 9 = 1 + 2 + ... + 9 = 45 chia hết cho 9.
Một số
chia hết cho 4 khi và chỉ khi hai chữ số cuối cùng của nó chia hết cho 4. Mà ta
cần tìm số nhỏ nhất chia hết cho 36, do đó số đó phải là số nhỏ nhất
có đầy đủ các chữ số từ 1 đến 9 và hai số cuối cùng của nó phải
là một số chia hết cho 4. Vậy số phải tìm là: 123457896
Bài
70/2001 - Mã hoá theo khoá
(Dành
cho học sinh THCS và THPT)
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
uses crt;
Const
MaxVal=256;
Var
n:Integer; S,KQ:String;
a:array[0..MaxVal] of Integer;
Procedure InPut;
Var i:Integer;
Begin
CLrscr;
Write('Nhap N=');Readln(n);
For i:=1 to n do
Begin
Write('a[',i,']=');Readln(a[i]); End;
Write('Nhap Xau:');Readln(S);
End;
Procedure Main;
Var
i,j:Integer;
Begin
if (Length(S) Mod n) <>0 then
For i:=1 to n-(Length(S) Mod n) do S:=S+' ';
KQ:='';
For i:=0 to (Length(S) Div n)-1 do
For j:=(n*i)+1 to n*(i+1) do
KQ:=KQ+S[a[j-(n*i)]+(n*i)];
Writeln('Xau Ma Hoa: ',KQ);
End;
Begin
InPut;
Main;
Readln;
End.
(Lời
giải của bạn Nguyễn Cao Thắng - Lớp 12A2 chuyên Vĩnh Phúc - tỉnh Vĩnh Phúc)
Bài
71/2001 - Thực hiện phép nhân
Program
Thuc_hien_phep_nhan;
Uses Crt;
Type so = 0..9;
Var a,b,c,d: string;
can,i: byte;
Procedure Nhap;
Begin
Clrscr;
Write('Nhap so a : '); Readln(a);
Write('Nhap so b : '); Readln(b);
Writeln('Phep nhan a va b : ');
can:=length(a)+length(b)+1;
Writeln(a:can);
Writeln('X');
Writeln(b:can);
For i:=1 to can do Write('-');
Writeln;
End;
Procedure Nhan(a:
string; k: so);
Var nho: so;
x,i: byte;
Begin
nho:=0;
c:='';
For i:=length(a) downto 1 do
Begin
x:=(ord(a[i])-48)*k+nho;
nho:=x div 10;
c:=chr((x mod 10)+48)+c;
End;
If nho>0 then c:=chr(nho+48)+c;
Writeln(c:can);
can:=can-1;
End;
Procedure Cong(var
c,d: string; z:byte);
Var nho: so;
x,i: byte;
Begin
for i:=1 to length(b)-z do c:=c+'0';
If length(c) > length(d) then
For i:=1 to length(c)-length(d) do d:='0'+d
Else
For i:=1 to length(d)-length(c) do
c:='0'+c;
nho:=0;
For i:=length(d) downto 1 do
Begin
x:=ord(d[i])+ord(c[i])-96+nho;
d[i]:=chr((x mod 10)+48);
nho:=x div 10;
End;
If nho>0 then d:='1'+d;
End;
Begin
Nhap;
d:='';
For i:=length(b) downto 1 do
Begin
Nhan(a,ord(b[i])-48);
Cong(c,d,i);
End;
can:=length(a)+length(b)+1;
For i:=1 to can do Write('-');
Writeln;
Writeln(d:can);
Readln;
End.
(Lời
giải của bạn Đặng Trung Thành - PTTH Nguyễn Du - Buôn Mê Thuột)
Bài
72/2001 - Biến đổi trên lưới số
const Inp
='bai72.inp';
Out ='bai72.out' ;
maxn=100;
Var dem, n, i, j,
d:integer; f:text;
a:array[0..maxn+1,0..maxn+1] of Boolean;
Procedure Init;
Var t:integer;
Begin
Fillchar(a, Sizeof(a), true);
Assign(f, inp); reset(f);
dem:=0;
Readln(f, n);
for i:= 1 to n do
for j:=1 to n do
begin
read(f, t);
If t=1 then a[i,j]:=true else begin
a[i,j]:=false;inc(dem); end;
If j=n then readln(f);
end;
Close(f);
End;
Procedure Solve1;
Begin
for i:=1 to n do
for j:=1 to n do
begin
If not a[i,j] then
begin
a[i,j]:= not (a[i,j-1] xor a[i,j+1] xor
a[i-1,j] xor a[i+1,j]);
If a[i,j] then begin
dec(dem);writeln(f,i,' ',j) end
end;
end;
End;
Procedure Solve2;
Begin
for i:=1 to n do
for j:=1 to n do
If not a[i,j] then
begin
If i >1 then
begin
a[i-1,j]:=false;
inc(dem);
writeln(f, i-1, ' ', j);
end
else
If i <n then
begin
a[i+1,j]:=false;
inc(dem);
writeln(f, i+1, ' ', j);
end
else
If j >1 then
begin
a[i,j-1]:=false;
inc(dem);
writeln(f, i, ' ', j-1);
end
else
begin a[i,j+1]:=false; inc(dem);
writeln(f, i, ' ', j+1) end;
exit;
end;
End;
BEGIN
Init;
Assign(f,out); rewrite(f);
While dem >0 do
begin
writeln(dem); d:=dem; solve1;
If (d=dem) and (dem >0) then solve2;
end; Close(f);
END.
(Lời
giải của bạn Nguyễn Chí Thức - khối PTCTT - ĐHSP - Hà Nội)
Bài 73/2001 - Bài toán chuỗi số
(Dành cho học sinh Tiểu họcvà THCS)
Hai số
cuối là 59 và 65.
Giải thích: Chuỗi số được tạo ra từ
việc cộng các số nguyên tố (ở hàng trên) với các số không phải là nguyên tố
(hàng dưới), cụ thể như sau:
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.
Bài 75/2001 - Trò chơi Tích -
Tắc vuông
(Dành cho học sinh THCS và PTTH)
(* Thuat toan:
Chia ban co lam 4 huong: Dong , Tay , Nam , Bac. Ta
co cach di sau:
i) Luon di
theo o lien canh voi o truoc
ii) Di theo
huong khong bi chan. Vi du: o buoc 1 neu bi chan o huong Dong
thi di theo huong nguoc lai la huong Tay. Di theo
huong Tay den khi huong Tay bi chan thi di theo huong Bac hoac Nam.
Trong khi di ta luon de y 2 dieu kien sau:
1. Neu co 3 o da lap thanh 3 dinh cua 1 hinh vuong
ma o thu 4 chua bi di
thi ta se di o thu 4 va gianh duoc thang loi.
2. Neu co 2k+1(k>=1) o lien canh lien tiep thi
kiem tra co the gianh thang
loi bang nuoc do^i khong? Nuoc do^i la nuoc ta danh
vao 1 o nhung co the co duoc 2 hinh vuong. vi du: co 3 o (1,1);(1,2);(1,3) thi
ta co the danh nuoc doi bang cach danh vao o (2,2) nhu vay ta co kha nang hinh
thanh 2 o vuong. Nhung sau 1 nuoc di doi thi chi duy nhat chan duoc 1 o vuong,
ta co the danh nuoc tiep theo de hinh thanh o vuong con lai va gianh duoc thang
loi.
Bang cach
danh nhu vay ban co the chien thang trong vong toi da la 10 nuoc.*)
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
CONST Min=-50;
Max=50;
TYPE Ma=Array[Min..Max,Min..Max] of char;
diem=
Record
hg,cot:Integer;
End;
Qu=Array[1..Max]
of diem;
VAR dmay,dng,dc1,dc2:diem;
hgdi:Integer; (*1:B ; 2:D ; -1:N ; -2:T*)
fin,ok:Boolean;
A:Ma;
Q,Qc:Qu;
dlt,dq,cq:Integer;
Procedure HienA(hgd,hgc,cotd,cotc:Integer);
Var i,j:Integer;
Begin
For
i:=hgd to hgc do
Begin
For j:=cotd to cotc do Write(A[i,j],' ');
Writeln;
End;
End;
Procedure finish(d:diem);
Begin
A[d.hg,d.cot]:='x';
HienA(-10,10,-10,10);
Writeln('Ban
da thua! An ENTER de ket thuc chuong trinh');
Readln;
Halt;
End;
Procedure Init;
Begin
Fillchar(A,sizeof(A),'.');
fin:=false;
Writeln('Gia thiet bang o vuong co: 101 hang (-50 -> 50)');
Writeln('
101 cot (-50 -> 50)');
Writeln('Gia thiet may luon di nuoc dau tien tai o co toa do (0:0)');
dmay.hg:=0;
dmay.cot:=0; A[dmay.hg,dmay.cot]:='X';
HienA(-10,10,-10,10);
dlt:=1;
End;
Procedure Sinh(d1:diem; Var d2:diem;
hgdi,k:integer);
Var h,c:Integer;
Begin
h:=d1.hg;
c:=d1.cot;
Case hgdi of
1:
Dec(h,k);
2: Inc(c,k);
-1:
Inc(h,k);
-2:
Dec(c,k);
End;
d2.hg:=h;
d2.cot:=c;
End;
Function kt(Var d1,d2:diem):boolean;
Var g1,g,g2:diem;
k,p:integer;
Begin
kt:=true;
k:=(dlt-1)
div 2;
p:=2 div
abs(hgdi);
sinh(dmay,g1,-hgdi,k);
sinh(dmay,g2,-hgdi,2*k);
sinh(g1,g,p,k);
sinh(dmay,d1,p,k);
sinh(g2,d2,p,k);
If
(A[d1.hg,d1.cot]='.')and(A[g.hg,g.cot]='.')and(A[d2.hg,d2.cot]='.')then
begin
A[g.hg,g.cot]:='x'; HienA(-10,10,-10,10); exit; end;
sinh(g1,g,-p,k);
sinh(dmay,d1,-p,k);
sinh(g2,d2,-p,k);
If
(A[d1.hg,d1.cot]='.')and(A[g.hg,g.cot]='.')and(A[d2.hg,d2.cot]='.')then
begin
A[g.hg,g.cot]:='x'; HienA(-10,10,-10,10); exit; end;
kt:=false;
End;
Procedure Ngdi;
Begin
Repeat
Write('Nhap
toa do diem (hang,cot): '); Readln(dng.hg,dng.cot);
Until
(dng.hg>=Min)and(dng.hg<=Max)and(dng.cot>=Min)and(dng.cot<=Max)and(A[dng.hg,dng.cot]='.');
A[dng.hg,dng.cot]:='1'; HienA(-10,10,-10,10);
End;
Function Hgchan:Integer;
Var Hgc:Integer;
Begin
If dmay.cot<dng.cot then
Begin
Hgc:=2;
If Hgc=hgdi then Begin Hgchan:=Hgc; Exit; End;
End;
If dmay.cot>dng.cot then
Begin
Hgc:=-2;
If Hgc=hgdi then Begin Hgchan:=Hgc; Exit; End;
End;
If dmay.hg<dng.hg then
Begin
Hgc:=-1;
If Hgc=hgdi then Begin Hgchan:=Hgc; Exit; End;
End;
If dmay.hg>dng.hg then
Begin
Hgc:=1;
If Hgc=hgdi then Begin Hgchan:=Hgc; Exit; End;
End;
Hgchan:=Hgc;
End;
Procedure Nap(Var Q:Qu; d1:diem; hgdi,k:Integer);
Var h,c:Integer;
d2:diem;
Begin
Sinh(d1,Q[cq],hgdi,k);
End;
Procedure Maydi;
Begin
Inc(dq);
if not ok
then
Begin
If
Q[dq].hg<dmay.hg then hgdi:=1
Else If
Q[dq].hg>dmay.hg then hgdi:=-1
Else
If Q[dq].cot<dmay.cot then hgdi:=-2
Else If Q[dq].cot>dmay.cot then hgdi:=2;
End;
dmay:=Q[dq];
A[q[dq].hg,q[dq].cot]:='x';
HienA(-10,10,-10,10)
End;
Procedure Process;
Var Hgc,p,i,ntt:Integer;
Begin
ok:=true;
ntt:=0;
Ngdi;
Hgc:=Hgchan;
Hgdi:=-Hgc;
Inc(cq);
Nap(Q,dmay,hgdi,1); Maydi; Inc(dlt);
Repeat
Ngdi;
Hgc:=Hgchan;
If
ntt=1 then
If
A[dc1.hg,dc1.cot]='.' then finish(dc1)
Else
finish(dc2);
If
ntt=0 then If (dlt>=3) and (kt(dc1,dc2)) then ntt:=1;
If
(Hgc=Hgdi) then
If
ok then
Begin
p:=2 div abs(Hgc);
For i:=1 to dlt-1 do
Begin
Inc(cq);
Nap(Q,dmay,p,i); Nap(Qc,Q[cq],-hgdi,i);
Inc(cq);
Nap(Q,dmay,-p,i);Nap(Qc,Q[cq],-hgdi,i);
End;
ok:=false;
dlt:=1;
End
Else
Begin
hgdi:=-hgdi; Inc(cq); Nap(Q,dmay,hgdi,dlt);
End;
If
ntt=0 then
Begin
If
dq=cq then Begin Inc(cq); Nap(Q,dmay,hgdi,1); End;
If
A[Qc[dq].hg,Qc[dq].cot]='.' then finish(Qc[dq]);
Maydi; Inc(dlt);
End;
Until fin;
End;
BEGIN
Init;
Process;
END.
Không có nhận xét nào:
Đăng nhận xét