Bài 24/2000 - Sắp xếp dãy số
(Dành cho học sinh Tiểu học)
Có thể
sắp xếp dãy số đã cho theo cách sau:
Lần thứ
|
Cách đổi chỗ
|
Kết quả
|
0
|
Dãy ban đầu
|
3, 1, 7, 9, 5
|
1
|
Đổi chỗ 1 và 3
|
1, 3, 7, 9, 5
|
2
|
Đổi chỗ 5 và 7
|
1, 3, 5, 9, 7
|
3
|
Đổi chỗ 7 và 9
|
1, 3, 5, 7, 9
|
Bài 25/2000 - Xây
dựng số
(Dành
cho học sinh THCS)
Có thể
làm như sau:
1+35+7 = 43
17+35 = 52
Bài 26/2000 - Tô màu
(Dành cho học sinh THCS)
Ký hiệu
màu Xanh là x, màu Đỏ là d, màu Vàng là v. Ta có 12 cách tô màu được liệt kê
như sau:
x
|
d
|
v
|
x
|
d
|
v
|
x
|
d
|
v
|
x
|
d
|
v
|
x
|
d
|
v
|
x
|
xx
|
dd
|
vv
|
xx
|
vv
|
xx
|
dd
|
vv
|
dd
|
vv
|
xx
|
dd
|
xx
|
dd
|
vv
|
xx
|
xx
|
dd
|
vv
|
xx
|
dd
|
xx
|
vv
|
dd
|
vv
|
dd
|
xx
|
vv
|
xx
|
vv
|
dd
|
xx
|
xx
|
dd
|
vv
|
xx
|
vv
|
dd
|
xx
|
vv
|
dd
|
xx
|
vv
|
dd
|
xx
|
vv
|
dd
|
xx
|
dd
|
vv
|
xx
|
dd
|
xx
|
dd
|
vv
|
xx
|
vv
|
xx
|
dd
|
vv
|
dd
|
vv
|
xx
|
dd
|
dd
|
vv
|
xx
|
dd
|
vv
|
xx
|
dd
|
vv
|
xx
|
dd
|
vv
|
xx
|
dd
|
vv
|
xx
|
dd
|
dd
|
xx
|
vv
|
dd
|
xx
|
vv
|
dd
|
xx
|
vv
|
dd
|
xx
|
vv
|
dd
|
xx
|
vv
|
dd
|
vv
|
xx
|
dd
|
vv
|
xx
|
dd
|
vv
|
xx
|
dd
|
vv
|
xx
|
dd
|
vv
|
xx
|
dd
|
vv
|
vv
|
xx
|
dd
|
vv
|
dd
|
vv
|
xx
|
dd
|
xx
|
dd
|
vv
|
xx
|
vv
|
xx
|
dd
|
vv
|
vv
|
dd
|
xx
|
vv
|
dd
|
xx
|
vv
|
dd
|
xx
|
vv
|
dd
|
xx
|
vv
|
dd
|
xx
|
vv
|
vv
|
dd
|
xx
|
vv
|
xx
|
vv
|
dd
|
xx
|
dd
|
xx
|
vv
|
dd
|
vv
|
dd
|
xx
|
vv
|
dd
|
xx
|
vv
|
dd
|
vv
|
dd
|
xx
|
vv
|
xx
|
vv
|
dd
|
xx
|
dd
|
xx
|
vv
|
dd
|
Bài 27/2000 - Bàn cờ
(Dành cho học sinh THPT)
Chương
trình của bạn Nguyễn Tiến Dũng lớp 8A2 trường PTTH chuyên Bến Tre, tỉnh Bến
Tre.
Program
Ban_co;
Uses Crt;
Var a: array [1..8, 1..8] of 0..1;
b, c, d, p: array [0..8,0..8] of integer;
max:integer;
Procedure
Input;
Var f: text; i, j:
integer;
st: string[8];
Begin
Assign
(f, 'banco2.txt');
Reset (f);
For i:=1 to 8 do
begin
Readln(f,st);
For j:=1 to 8 do If st[j]= 0 then a[i,j]:=0 else a[i,j]:=1;
end;
Close(f);
End;
Procedure
Init;
Begin
Input;
Fillchar(b,sizeof(b),0);
c:=b; d:=b; p:=b;
End;
Function
Get_max(x, y, z, t: integer): integer;
Var k: integer;
Begin
k:=x;
If k < y then k:=y;
If k < z then k:=z;
If k < t then k:=t;
Get_max:=k;
End;
Procedure
Find_max;
Var
i, j, k: integer;
Begin
max:=0;
For i:=1 to 8
do
For j:=1 to 8 do
If a[i, j]= 1 then
begin
b[i, j]:=b[i-1,j]+1;
c[i, j]:=c[i,j-1]+1;
d[i,j]:=d[i-1,j-1]+1;
p[i,j]:=p[i-1,j+1]+1;
k:=get_max(b[i,j], c[i,j], d[i,j], p[i,j]);
If max < k then max:=k;
end;
Writeln (max);
Readln;
End;
BEGIN
Clrscr;
Init;
Find_max;
END.
Bài 28/2000 - Đổi tiền
(Dành
cho học sinh Tiểu học)
Có 10
cách đổi tờ 10 ngàn đồng bằng các đồng tiền 1, 2 và 5 ngàn đồng.
Số tờ 1 ngàn
|
Số tờ 2 ngàn
|
Số tờ 5 ngàn
|
0
|
0
|
2
|
1
|
2
|
1
|
3
|
1
|
1
|
5
|
0
|
1
|
0
|
5
|
0
|
2
|
4
|
0
|
4
|
3
|
0
|
6
|
2
|
0
|
8
|
1
|
0
|
10
|
0
|
0
|
Bài 29/2000 - Chọn bạn
(Dành
cho học sinh THCS)
Gọi một bạn học sinh nào đó trong 6 bạn là A. Chia 5 bạn
còn lại thành 2 nhóm: Nhóm 1 gồm những bạn quen A, nhóm 2 gồm những bạn không
quen A (dĩ nhiên A không nằm trong 2 nhóm đó). Vì tổng số các bạn trong 2 nhóm
bằng 5 nên chắc chắn có 1 nhóm có từ 3 bạn trở lên. Có thể xảy ra hai khả năng:
Khả năng
1. Nhóm 1 có từ 3 bạn trở lên: Khi đó nếu
các bạn trong nhóm đó không ai quen ai thì bản thân nhóm đó chứa 3 bạn không
quen nhau cần tìm. Ngược lại nếu có 2 bạn trong nhóm đó quen nhau thì hai bạn đó
cùng với A chính là 3 bạn quen nhau cần tìm.
Khả năng
2. Nhóm 2 có từ 3 bạn trở lên: Khi đó nếu
các bạn trong nhóm 2 đã quen nhau đôi một thì nhóm đó chứa 3 bạn quen nhau đôi
một cần tìm; ngược lại nếu có 2 bạn trong nhóm không quen nhau thì 2 bạn đó
cùng với A chính là 3 bạn không quen nhau cần tìm.
Bài 30/2000 - Phần tử yên ngựa
(Dành
cho học sinh THCS)
const
Inp = 'Bai30.INP';
Out = 'Bai30.OUT';
MaxLongInt = 2147483647;
var
Min, Max: array[1..5000] of LongInt;
m, n: Integer;
procedure ReadInput;
var
i, j, k: Integer;
hf: Text;
begin
Assign(hf, Inp);
Reset(hf);
Readln(hf, m, n);
for i := 1 to m do Min[i] := MaxLongInt;
for j := 1 to n do Max[j] := -MaxLongInt;
for i := 1 to m do
begin
for j := 1 to n do
begin
Read(hf, k);
if Min[i] > k then Min[i] := k;
if Max[j] < k then Max[j] := k;
end;
Readln(hf);
end;
Close(hf);
end;
procedure
WriteOutput;
var
i, j: Integer;
Result: Boolean;
hf: Text;
begin
Result := False;
Assign(hf, Out);
Rewrite(hf);
Writeln(hf, 'Cac phan tu yen ngua la: ');
for i := 1 to m do
for j := 1 to n do
if Min[i] = Max[j] then
begin
Result := True;
Write(hf, '(', i, ',', j, '); ');
end;
if not Result then
begin
Rewrite(hf);
Write(hf, 'Khong co phan tu yen ngua');
end;
Close(hf);
end;
begin
ReadInput;
WriteOutput;
end.
3 3
15 3 9
55 4 6
76 1 2
Bài 32/2000 - Bài toán 8 hậu
(Dành
cho học sinh Tiểu học)
Có rất
nhiều cách xếp. Sau đây là một vài cách để các bạn tham khảo:
0 1 0 0
0 0 0 0
|
0 0 0 1
0 0 0 0
|
0 0 0 0
0 1 0 0
|
0 0 0 0
0 0 0 1
|
0 0 1 0
0 0 0 0
|
1 0 0 0
0 0 0 0
|
0 0 0 0
0 0 1 0
|
0 0 0 0
1 0 0 0
|
0 1 0 0
0 0 0 0
|
0 0 0 0
1 0 0 0
|
0 0 0 0
0 0 1 0
|
0 0 0 1
0 0 0 0
|
1 0 0 0
0 0 0 0
|
0 0 0 0
0 0 0 1
|
0 0 0 0
0 1 0 0
|
0 0 1 0
0 0 0 0
|
0 1 0 0
0 0 0 0
|
0 0 0 0
1 0 0 0
|
0 0 0 0
0 0 1 0
|
1 0 0 0
0 0 0 0
|
0 0 1 0
0 0 0 0
|
0 0 0 0
0 0 0 1
|
0 0 0 0
0 1 0 0
|
0 0 0 1
0 0 0 0
|
0 1 0 0
0 0 0 0
|
0 0 0 0
0 1 0 0
|
1 0 0 0
0 0 0 0
|
0 0 0 0
0 0 1 0
|
0 0 0 1
0 0 0 0
|
0 0 0 0
0 0 0 1
|
0 0 1 0
0 0 0 0
|
0 0 0 0
1 0 0 0
|
Để tìm hết nghiệm của bài này
chúng ta phải sử dụng thuật toán Đệ quy - Quay lui. Sau đây là chương trình,
chạy ra 92 nghiệm và ghi các kết quả đó ra file HAU.OUT.
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
uses crt;
const fo =
'hau.out';
n = 8;
var
A : array[1..n,1..n] of byte;
c : array[1..n] of byte;
dc1 : array[2..2*n] of byte;
dc2 : array[1-n..n-1] of byte;
sn : integer;
f : text;
procedure ghino;
var
i,j : byte;
begin
inc(sn);
writeln(f,'Nghiem thu ',sn,' la :');
for i :=
1 to n do
begin
for j := 1 to n do
write(f,A[i,j],#32);
writeln(f);
end;
writeln(f);
end;
procedure vet(i
: byte);
var
j : byte;
begin
if i =
n+1 then
begin
ghino;
exit;
end;
for j :=
1 to n do
if
(c[j] =0)and(dc1[i+j]=0) and (dc2[i-j]=0) then
begin
A[i,j] := 1; c[j] := 1; dc1[i+j] :=1 ; dc2[i-j] := 1;
vet(i+1);
A[i,j] := 0; c[j] := 0; dc1[i+j] :=0 ; dc2[i-j] := 0;
end;
end;
BEGIN
assign(f,fo);
rewrite(f);
vet(1);
close(f);
END.
Bài 33/2000 - Mã hoá văn bản
(Dành
cho học sinh THCS)
a. Mã
hoá:
PEACE
thành UJFHJ
HEAL THE
WORLD thành MJFQ YMJ BTWQI
I LOVE
SPRING thành N QTAJ XUWNSL.
b. Qui
tắc giải mã các dòng chữ đã được mã hoá theo quy tắc trên: (lấy ví dụ ký tự X):
-Tìm số
thứ tự tương ứng của kí tự, ta được 23.
-Tăng giá
trị số này lên 21 (thực ra là giảm giá trị số này đi 5 rồi cộng với 26), ta được
44.
-Tìm số
dư trong phép chia số này cho 26 ta được 18.
-Tra ngược
bảng chữ cái ta thu được S.
Giải
mã:
N FRF
XYZIJSY thành I AM A STUDENT
NSKTVRFYNHX
thành INFOQMATICS.
MFSTN
SFYNTSFQ ZSNBJVXNYD thành HANOI NATIONAL UNIWEQSITY.
Sau đây
là chương trình mô tả thuật toán giải quyết bài 33/2000, gồm 2 thủ tục chính
là: mahoatu (chuyển xâu thành xâu mã
hoá) và giaimatu (chuyển xâu thành
xâu giải mã). Các bạn có thể xem kết quả sau khi chạy chương trình bằng cách ấn
Alt + F5.
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
uses crt;
function mahoa(x : char) : char;
var vtri :
byte;
begin
if upcase(x) in ['A'..'Z'] then
begin
vtri := ord(upcase(x))-ord('A');
vtri := vtri+5;
mahoa := char( vtri mod
26+ord('A'));
end
else mahoa := x;
end;
function giaima(x :
char) : char;
var vtri : byte;
begin
if upcase(x) in ['A'..'Z'] then
begin
vtri := ord(upcase(x))-ord('A');
vtri := vtri-5+26;
giaima := char( vtri mod 26 +
ord('A'));
end
else giaima := x;
end;
procedure mahoatu(s : string);
var i
: byte;
begin
write(s,' -> ');
for i := 1 to length(s) do
write(mahoa(s[i]));
writeln;
end;
procedure giaimatu(s : string);
var i
: byte;
begin
write(s,' <- ');
for i := 1 to length(s) do
write(giaima(s[i]));
writeln;
end;
BEGIN
clrscr;
mahoatu('PEACE');
mahoatu('HEAL THE WORLD');
mahoatu('I LOVE SPRING');
giaimatu('N FR F XYZIJSY');
giaimatu('NSKTVRFYNHX');
giaimatu('MFSTN SFYNTSFQ ZSNBJVXNYD');
END.
Bài 34/2000 - Mã hoá và giải mã
(Dành
cho học sinh THCS)
Program bai34;
Uses crt;
Const
Ord : array['A', ..'Z'] of byte =(0, 1, 2, 3, 4, 5, 6, 7, 8,
9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25);
chr : array[0..25] of char = ('A', 'B', 'C', 'D', 'E', 'F',
'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V',
'W', 'X', 'Y', 'Z');
Var s:string;
i, j:integer;
ch:char;
Begin
S:='';
Writeln('Nhap xau ki
tu:');
Repeat
ch:= ReadKey;
If (ch in
['a'..'z', 'A'..'Z']) then
Begin
ch :=
Upcase(ch); Write(ch);
S := S +
ch;
End;
Until ch = #13;
Writeln;
For i := 1 to
length(s) do
If S[i] <> ' '
then S[i] := chr[(ord{s[i]] + 5) mod 26];
Writeln('Xau ki tu
tren duoc ma hoa la:'); write(s); Readln;
S:= ' ' ;
Writeln('Nhap xau ki
tu can giai ma:');
Repeat
ch := Readkey;
If (ch in
['a'..'z', 'A'..'Z']) then
Begin
ch :=
Upcase(ch); Write(ch);
s := s +
ch;
End;
Until ch = #13;
Writeln;
for i := 1 to
length{S) do
If S[i] <> ' '
then S[i] := chr[(Ord[S[i]] + 21) mod
26;
writeln('Xau ki tu
tren duoc giai ma la:'); write(s);
Readln;
End.
Các bạn cũng có thể sử dụng lại 2 thủ tục mahoatu và giaimatu ở bài 33/2000 để giải bài này. Việc thiết kế giao diện khi
nhập xâu từ bàn phím xin dành cho các bạn.
Bài 35/2000 - Các phân số được sắp xếp
(Dành
cho học sinh THPT)
Program bai35;
Uses crt;
Type Phanso = (tu, mau);
Var F:
array[1..4000, phanso] of integer;
N, dem :
Integer;
Procedure nhap;
Begin
Write('Nhap so N:');
Readln(N);
F[1,tu] := 0;
F[1,mau] := 1; dem := 2;
F[dem, tu] := 1;
F[dem,mau] := 1;
End;
Procedure Chen(t,m,i:Integer);
Var j:integer;
Begin
Inc(dem);
For j := dem downto
i + 1 do
begin
F[j,tu] :=
F[j-1,tu];
F[j,mau] :=
F[j-1,mau];
end;
F[i,tu] := t;
F[i,mau] := m;
End;
Program xuli;
Var t,m,i:integer;
Begin
for m:=2 to N do
for t:=1 to m-1 do
begin
i:=1;
While
(F[i,tu]*m < F[i,mau]*t) do inc(i);
If (F[i,tu]*m
> F[i,mau]*t) then chen(t,m,i);
end;
End;
Procedure xuat;
var i:integer;
Begin
for i:=2 to dem do
begin
If WhereX >
75 then writeln;
If WhereY >
24 then
begin
Write('Nhan Enter de tiep tuc');
Readln;
end;
write('Tat ca co',
dem,' phan so.');
Readln;
End;
BEGIN
nhap;
xuli;
Xuat;
END.
Bài 36/2000 - Anh chàng hà tiện
(Dành
cho học sinh Tiểu học)
Liệt kê
số tiền phải trả cho từng chiếc cúc rồi cộng lại, ta được bảng sau:
Thứ tự
|
Số tiền
|
Cộng
dồn
|
1
|
1
|
1
|
2
|
2
|
3
|
3
|
4
|
7
|
4
|
8
|
15
|
5
|
16
|
31
|
6
|
32
|
63
|
7
|
64
|
127
|
8
|
128
|
255
|
9
|
256
|
511
|
10
|
512
|
1023
|
11
|
1024
|
2047
|
12
|
2048
|
4095
|
13
|
4096
|
8191
|
14
|
8192
|
16383
|
15
|
16384
|
32767
|
16
|
32768
|
65535
|
17
|
65536
|
131071
|
18
|
131072
|
262143
(= 218 -1)
|
Như vậy
anh ta phải trả 262143 đồng và anh ta rõ ràng là bị "hố" nặng do phải
trả gấp hơn 20 lần so với cách thứ nhất.
Bài 37/2000 - Số siêu nguyên tố
(Dành
cho học sinh THCS)
Program
Bai37;
{SuperPrime};
var a,b:
array [1..100] of longint;
N,i,k,ka,kb,cs: byte;
Function
Prime(N: longint): boolean;
Var i:
longint;
Begin
If (N=0) or (N=1) then
Prime:=false
Else
Begin
i:=2;
While (N mod i <> 0) and (i <= Sqrt(N)) do Inc(i);
If i > Sqrt(N) then
Prime:=true Else Prime:=false;
End;
End;
BEGIN
Write ('Nhap N: ');
Readln (N);
ka:=1; a[ka]:=0;
For i:=1 to N do
Begin
Kb:=0;
For k:=1 to ka do
For cs:=0 to 9 do
If Prime(a[k]*10+cs) then
Begin
Inc(kb);
b[kb]:=a[k]*10+cs;
end;
ka:=kb;
For k:=1 to ka do
a[k]:=b[k]; end;
For k:=1 to ka do
Write(a[k]:10);
Writeln;
Writeln('Co tat ca',ka,'so sieu nguyen to co',N,'chu so.');
Readln;
END.
Bài
38/2000 - Tam giác số
Uses Crt;
Const
inp='INPUT.TXT';
Var N,Smax: integer;
a: array [1..100,1..100] of integer;
{----------------------------------------}
Procedure
Nhap;
Var f: text;
i,j: integer;
Begin
Assign(f,inp);
Reset(f);
Readln(f,n);
For i:=1 to N do
begin
For
j:=1 to i do Read(f,a[i,j]);
Readln(f);
end;
Close(f);
End;
{----------------------------------------}
Procedure
Thu(S,i,j: integer);
Var
k,S_new: integer;
Begin
S_new:=S+a[i,j];
If i=N then
begin
If S_new>Smax then Smax:=S_new;
end
else
For k:=j to j+1 do Thu(S_new, i+1, k);
End;
{----------------------------------------}
BEGIN
Nhap;
Smax:=0;
Thu(0,1,1);
Write('Smax = ',Smax);
Readln;
END.
Dưới đây các bạn có thể tham khảo lời giải của bạn
Phạm Đức Thanh dùng phương pháp quy hoạch động trên mảng hai chiều:
Program bai38;
Uses crt;
Type mang = array[1..100,1..100] of integer;
Var
f:text;
i,j,n:integer;
a,b:mang;
Procedure Input;
Begin
clrscr;
Assign(f,'input.txt');
reset(f);
readln(f,n);
for j:=1 to n do
begin
for i:=2
to j+1 do
read(f,a[j,i]);
end;
close(f);
end;
{----------------------------------}
Function Max(m,n:integer):integer;
Begin
if n>m
then Max:=n
else
Max:=m;
end;
{----------------------------------}
Procedure MakeArrayOfQHD;
Begin
b[1,2]:=a[1,2];
for j:=1
to n do b[j,1]:=-maxint;
for i:=3
to n do b[1,i]:=-maxint;
for j:=2
to n do
begin
for i:=2 to j+1 do
b[j,i]:=a[j,i]+max(b[j-1,i],b[j-1,i-1]);
end;
end;
{-----------------------------------}
Procedure FindMax;
var max:integer;
Begin
max:=b[n,1];
for i:=2
to n do
if
b[n,i]>max then max:=b[n,i];
writeln('Smax:=',max);
readln;
end;
{------------------------------------}
BEGIN
Input;
makearrayofQHD;
FindMax;
END.
Nhận xét: Lời giải dùng thuật toán quy hoạch động của Phạm Đức
Thanh tốt hơn rất nhiều so với thuật toán đệ quy quay lui.
Bài 39/2000 - Ô chữ
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S-,T-,V+,X+}
{$M 16384,0,655360}
uses crt;
const
fi = 'input.txt';
fo = 'output.txt';
var
A : array[1..5,1..5] of char;
new,blank : record x,y : integer end;
procedure no_no_and_no;
var
f : text;
begin
assign(f,fo);
rewrite(f);
write(f,'This puzzle has no final
configuration.');
close(f);
halt;
end;
procedure yes_yes_and_yes;
var
f : text;
i,j : byte;
begin
assign(f,fo);
rewrite(f);
for i :=
1 to 5 do
begin
for j :=1 to 5 do
write(f,a[i,j]);
writeln(f);
end;
close(f);
end;
procedure swap(px,py
: integer);
var
coc : char;
begin
new.x :=
blank.x + px;
new.y :=
blank.y + py;
if (new.x
>5) or (new.y >5) or (new.x <1) or (new.y <1) then
no_no_and_no;
coc :=
A[new.x,new.y];
A[new.x,new.y] := A[blank.x,blank.y];
A[blank.x,blank.y] :=coc;
blank :=
new;
end;
procedure chuyen(ch : char);
begin
case ch
of
'A' :
swap( -1,0);
'B' :
swap( 1,0);
'R' :
swap( 0, 1);
'L' :
swap( 0,-1);
end;
end;
procedure docf;
var
f : text;
i,j : byte;
s : string[5];
ch
: char;
begin
assign(f,fi);
reset(f);
for i :=1
to 5 do
begin
readln(f,s);
if length(s) = 4 then s := s+ #32;
for j := 1 to 5 do
begin
A[i,j] := s[j];
if A[i,j] = #32 then
begin
blank.x := i;
blank.y := j;
end;
end;
end;
while not
seekeof(f) do
begin
read(f,ch);
if ch = '0' then exit;
chuyen(ch);
end;
close(f);
end;
BEGIN
clrscr;
docf;
yes_yes_and_yes;
END.
Bài 40/2000 - Máy định
vị Radio
Uses crt;
Const nmax = 30;
Output = 'P27.out';
Input = 'P27.inp';
Type
str20 = string[20];
Var
Toado : Array[1..nmax,1..2] of real;
TenDen,TenDen1,TenDen2 : Array[1..nmax] of
str20;
n,j,i,k:integer;
Td1,Td2:array[1..2] of integer;
goc,g1,g2,v,l:array[1..2] of real;
t1,t2:array[1..2] of integer;
xd,yd,x,y, x1,x2,y1,y2:array[1..2] of real;
f:text;
Function tg(x:
real): real;
Begin
if cos(x)<>0 then tg:=sin(x)/cos(x);
End;
Procedure
DocDen(var s:str20);
Var d:char;
Begin
repeat
read(f,d);
Until (d<>' ');
s:='';
While (d<>' ') do
begin
s:=s+d;
Read(f,d);
End;
End;
Function
XdToado(s:str20):Integer;
Var i:integer;
Begin
i:=1;
While (i<=n) and (s<> tenden[i]) do
inc(i);
XdToado:=i;
End;
Procedure InputDen;
Var i:integer;
Begin
Assign(f,input);
Reset(f);
Readln(f,n);
For i:=1 to n do
Begin
DocDen(TenDen[i]);
Readln(f,Toado[i,1],Toado[i,2]);
End;
End;
Procedure
Inputkichban;
Begin
Readln(f,k);
For i:=1 to k do
Begin
Readln(f, goc[i],v[i]);
Read(f,t1[i]);
Docden(tenden1[i]);
Td1[i]:=Xdtoado(tenden1[i]);
Readln(f,g1[i]);
Read(f,t2[i]);
Docden(tenden2[i]);
Td2[i]:=Xdtoado(tenden2[i]);
Readln(f,g2[i]);
End;
Close(f);
End;
Procedure Doi;
Begin
For j:=1 to k do
Begin
goc[j]:=goc[j]*pi/180;
g1[j]:=g1[j]*pi/180;
g2[j]:=g2[j]*pi/180;
l[j]:=(t2[j]-t1[j])*v[j];
End;
End;
Procedure TinhToan;
Begin
Assign(f,output);Rewrite(f);
For j:=1 to k do
Begin
x1[j]:=Toado[td1[j],1];
y1[j]:=Toado[td1[j],2];
x2[j]:=Toado[td2[j],1];
y2[j]:=Toado[td2[j],2];
xd[j]:=x1[j]+l[j]*sin(goc[j]);
yd[j]:=y1[j]+l[j]*cos(goc[j]);
If (cos(goc[j]+g2[j])=0) or
(cos(goc[j]+g1[j])=0) then
Writeln(f,'Scenario ',j,': Position
cannot be determined')
else
Begin
y[j]:= (xd[j] - x2[j] -
yd[j]*tg(goc[j] + g1[j]) + y2[j]*tg(goc[j] + g2[j]))/(tg(goc[j] + g2[j]) -
tg(goc[j] + g1[j]));
x[j]:= x2[j] - (y2[j] -
y[j])*tg(goc[j] + g2[j]);
Writeln(f,'Scenario ',j,': Positino
is (', x[j]:6:2, y[j]:6:2,')') ;
end;
End;
End;
BEGIN
InputDen;
Inputkichban;
Doi;
TinhToan;
Close(f);
END.
Bài
41/2000 - Cờ Othello
Program bai41;
{Co Othello}
Uses Crt ;
Const Inp = 'othello.Inp' ;
Out
= 'othello.out' ;
nmax
= 50;
huongi:array[1..8] of integer = (-1,-1,-1,0,0,1,1,1);
huongj:array[1..8] of integer = (-1,0,1,-1,1,-1,0,1);
Type
Mang1 =
Array [1..nmax] of string[3] ;
Mang2 =
Array [1..8,1..8] of char ;
Var f: text;
a:
mang2; l:mang1;
c:
char; n, k, code:integer;
di:array[1..8,1..8] of boolean;
x0,y0:array[1..nmax]
of integer;
{=================================================}
Procedure
nhap;
Var i,j
: Byte ;
Begin
Assign(f,inp) ;
Reset(f)
;
for i:=1
to 8 do
begin
for j:=1 to
8 do Read(f,a[i,j]) ;
Readln(f) ;
end;
Readln(f,c) ;
i:=0;
while not
eof(f) do
begin
inc(i);
Readln(f,l[i]);
end;
n:=i;
End ;
{===============================================}
Procedure kiemtra(i,j:integer);
Var m:integer;
Begin
Case c of
'B': If
a[i,j] = 'B' then
Begin
m:=
1;
repeat
if (a[i+huongi[m],j+huongj[m]] = 'W')
and(i+huongi[m]>0)and(j+huongj[m]>0)
and(i+2*huongi[m]>0)and(j+2*huongj[m]>0)
and(i+huongi[m]<9)and(j+huongj[m]<9)
and(i+2*huongi[m]<9)and(j+2*huongj[m]<9)
and(A [i+2*huongi[m],j+2*huongj[m]] = '-')
then
di [i+2*huongi[m],j+2*huongj[m]] := True;
m:=m+1;
until m>8;
End;
'W': If
(a[i,j] = 'W') then
Begin
m:=
1;
repeat
if (a [i+huongi[m],j+huongj[m]] = 'B')
and(i+huongi[m]>0)and(j+huongj[m]>0)
and(i+2*huongi[m]>0)and(j+2*huongj[m]>0)
and(i+huongi[m]<9)and(j+huongj[m]<9)
and(i+2*huongi[m]<9)and(j+2*huongj[m]<9)
and(a[i+2*huongi[m],j+2*huongj[m]] = '-')
then
di[i+2*huongi[m],j+2*huongj[m]] := True;
m:=m+1;
until m>8;
end;
End;{of
Case}
End;
{================================================}
Procedure lietke;
Var
i,j,m:
Integer;
t: Boolean;
Begin
t:= false;
for i:=1 to 8 do
for j:= 1 to
8 do
di[i,j]:=false;
for i:=1 to 8 do
for j:= 1 to
8 do kiemtra(i,j);
for i:= 1
to 8 do
for j:=
1 to 8 do
If
di[i,j] then
Begin
t:= True;
Write (f,'(',i,',',j,')');
End;
If t=false then
Write (f, 'No legal move.');
Writeln(f);
End;
{======================================}
Procedure latco(x0,y0:integer);
Var m:integer;
Begin
Case c of
'B': if
a[x0,y0] ='-'then
begin
m:=
1;
repeat
If (a[x0-2*huongi[m],y0-2*huongj[m]] = 'B')
and(a[x0-huongi[m],y0-huongj[m]] = 'W')
then
begin
a[x0,y0]:='B';
a[x0-huongi[m],y0-huongj[m]] := 'B';
end;
m:=m+1;
until m>8;
end;
'W': if
a[x0,y0] ='-'then
begin
m:=
1;
repeat
If (a[x0-2*huongi[m],y0-2*huongj[m]] = 'W')
and(a[x0-huongi[m],y0-huongj[m]] = 'B')
then
begin
a[x0,y0]:='W';
a[x0-huongi[m],y0-huongj[m]] := 'W';
end;
m:=m+1;
until m>8;
end;
end;
End;
{=============================================}
Procedure Thuchien(k:integer);
Var
i,j,xx,yy,xx1,yy1: Integer;
code,m:
Integer;
Begin
for i:= 1
to 8 do
for j:= 1
to 8 do
begin
if
a[i,j]='W'then yy1:=yy1+1;
if
a[i,j]='B'then xx1:=xx1+1;
end;
xx:= 0; yy:=
0;
for i:= 1 to
8 do
for j:= 1
to 8 do kiemtra(i,j);
If not
di[x0[k],y0[k]] then
begin
Case c Of
'W':c:= 'B';
'B':c:= 'W';
End;
for i:= 1 to 8 do
for j:= 1 to 8 do kiemtra(i,j);
If not di[x0[k],y0[k]] then
Case c Of
'W':c:= 'W';
'B':c:= 'B';
End;
end;
latco(x0[k],y0[k]);
for i:= 1
to 8 do
for j:=
1 to 8 do
begin
if a[i,j]='W'then yy:=yy+1;
if a[i,j]='B'then xx:=xx+1;
end;
WriteLn
(f,'Black - ',xx, ' White - ',yy );
if (xx<>xx1)and(yy<>yy1) then
Case c Of
'W':c:= 'B';
'B':c:= 'W';
End;
End;
{=============================================}
Procedure ketthuc;
Var
i,j:Integer;
Begin
for i:= 1 to
8 do
begin
for j:=
1 to 8 do Write (f,a [i,j]);
Writeln(f);
end;
End;
{==========================================}
Begin
clrscr;
nhap;
Assign(f,out);
Rewrite(f);
for k:=1 to
n do
Case
l[k][1] of
'L':
Lietke;
'M':begin
Val(l[k][2],x0[k],code);
Val(l[k][3],y0[k],code);
Thuchien(k);
end;
'Q':
ketthuc;
End;
Close(f);
End.
Bài 42/2000 - Một chút về tư duy số học
(Dành cho học sinh Tiểu học)
Giả sử
A là số phải tìm, khi đó A phải có dạng:
A = 2k1
+ 1 = 3k2 +2 = ... = 10k9 + 9 (k1, k2,
..., k9 - là các số tự nhiên).
Khi đó
A + 1 = 2(k1 + 1) = 3(k2 +1 ) = ... = 10(k9+
1).
Vậy A+1
phải là BSCNN (bội số chung nhỏ nhất) của (2, 3, ..., 10) = 2520.
Do đó
số phải tìm là A = 2519.
Bài 43/2000 - Kim giờ và kim phút gặp nhau
bao nhiêu lần trong ngày
(Dành cho học sinh Tiểu học)
Ta có
các nhận xét sau:
+ Kim
phút chạy nhanh gấp 12 lần kim giờ. Giả sử gọi v là vận tốc chạy của kim giờ,
khi đó vận tốc của kim phút là 12v.
+ Mỗi
giờ kim phút chạy một vòng và gặp kim giờ một lần. Như vậy trong 24 giờ, kim
giờ và kim phút sẽ gặp nhau 24 lần. Tất nhiên những lần gặp nhau trong 12 giờ đầu
cũng như các lần gặp nhau trong 12 giờ sau. Và các lần gặp nhau lúc 0 giờ, 12
giờ và 24 giờ là trùng nhau và gặp nhau vào chính xác các giờ đó.
Do đó,
ở đây ta chỉ xét trong chu kì một vòng của kim giờ (tức là từ 0 giờ đến 12
giờ).
Giả sử
kim giờ và kim phút gặp nhau lúc h giờ (h = 0, 1, 2, 3, ..., 10, 11) và s phút.
Và giả sử xét quãng đường được đo theo đơn vị là phút. Do thời gian chạy là như
nhau nên ta có:
60h = 11s s = 
.
Thay
lần lượt h = 0, 1, 2, 3, ..., 10, 11 vào ta sẽ tính được s.
Ví
dụ:
Với h =
0, s = 0 Kim giờ và kim phút gặp nhau đúng vào lúc 0 giờ.
s = 0 Kim giờ và kim phút gặp nhau đúng vào lúc 0 giờ.
h = 1, s = 
= 
Kim giờ và kim phút
gặp nhau lúc 1 giờ phút.
s = = Kim giờ và kim phút
gặp nhau lúc 1 giờ phút.
h = 2, s = 
Kim giờ và kim phút gặp nhau lúc 2 giờ phút.
s = Kim giờ và kim phút gặp nhau lúc 2 giờ phút.
....
h = 11,
s = 60; 11 giờ 60 phút = 12 giờ Kim giờ và kim phút
gặp nhau đúng vào lúc 12 giờ.
s = 60; 11 giờ 60 phút = 12 giờ Kim giờ và kim phút
gặp nhau đúng vào lúc 12 giờ.
Bài 44/2000 - Tạo ma trận số
(Dành cho học sinh THCS)
Program mang;
uses crt;
const n=9;
var
a:array[1..n,1..n] of integer;
i,j,k:integer; t:boolean;
Begin
clrscr;
for j:=1 to
n do
Begin
a[1,j]:=j;
a[j,1]:=a[1,j];
end;
i:=1;
repeat
i:=i+1;
for j:=i
to n do
begin
t:=
false;
for
k:= 2 to j-1 do if (a[k-1,i]>a[k,i])
then t:=true;
if t
then
begin
if a[j-1,i]+2 > n*2 then a[j,i]:=2 else a[j,i]:=a[j-1,i]+2;
a[i,j]:=a[j,i];
end
else
begin
if a[j-1,i]+i>2*n then a[j,i]:=2 else a[j,i]:=a[j-1,i]+i;
a[i,j]:=a[j,i];
end;
end;
until i=n;
for i:=1 to n do
begin
for
j:=1 to n do write(a[i,j]:4);
writeln;
end;
readln;
end.
Bài 45/2000 - Các vòng tròn Olympic
(Dành cho học sinh THCS và PTTH)
{$Q-}
{$M 65000 0 655360}
Program Vong_Tron;
Uses Crt,Dos;
Const Max = 39;
Fileout = 'VTron.out';
Dvt : array [1 .. 5,0 .. 8] of byte =
((8,1,2,3 ,4 ,5 ,6 ,7,8),
(6,2,3,4 ,9 ,10,11,0,0),
(6,4,5,6 ,11,12,13,0,0),
(4,6,7,13,14,0
,0 ,0,0),
(4,1,2,9 ,15,0 ,0 ,0,0));
D0 : array [1 .. 5] of byte =
(8,11,13,14,15);
Type Limt = 0 .. Max;
Mang = array [Limt] of byte;
Var A,B
: Mang;
dm
: longint;
fout : text;
{-------------------------------------}
Procedure Time;
Var
h,k,i,j : word;
Begin
Gettime(h,k,i,j);
writeln(h,' : ',k,' : ',i,'.',j);
End;
{-------------------------------------}
Procedure Output;
Var
i,j : byte;
Begin
Inc(dm);
For i := 1 to 15 do write(fout,A[i],'
');
writeln(fout);
End;
{-------------------------------------}
Function GT(j0,count : shortint) : byte;
Var
s,i0 : shortint;
Begin
s := 0;
For i0 := 1 to Dvt[j0,0] do
if Dvt[j0,i0] <= count then
Inc(s,A[Dvt[j0,i0]]);
GT := s;
End;
{-------------------------------------}
Procedure
Try(s0,count,k0 : shortint);
Var
i0 : shortint;
Begin
if (count <= D0[k0]) and (s0 <= Max)
then
For i0 := 1 to Max-s0 do if B[i0] = 0
then
Begin
B[i0] := 1;
A[count] := i0;
if (count = D0[k0]) and (s0 + i0 =
Max) then
Begin
if k0 = 5 then Output
else Try(gt(k0 + 1,count),count + 1,k0 +
1);
End
else Try(s0 + i0,count + 1,k0);
B[i0] := 0;
End;
End;
{-------------------------------------}
Procedure Process;
Begin
clrscr;
Time;
Assign(fout,fileout);rewrite(fout);
Fillchar(A,sizeof(A),0);
B:= A; dm := 0;
Try(0,1,1);
writeln(fout,'So cach : ',dm);
close(fout); Time;
End;
{-------------------------------------}
BEGIN
Process;
END.
Cách
ghi kết quả trong file Vtron.out như sau: trong mỗi dòng ghi một cách đặt
các số theo thứ tự từ 1 đến 15 theo cách đánh số như trên hình vẽ. Số cách xếp được
ghi ở cuối tệp.
(Lời
giải của bạn Đỗ Thanh Tùng - Lớp 12 Tin - PTTH chuyên Thái Bình)
Không có nhận xét nào:
Đăng nhận xét