100 Đề Toán Tin Tin Học & Nhà Trường

2 
= (N2+Ni+i+1)(N-i)/2 
= (N3+Ni+N-Ni2-i2-i)/2
Cắt đôi bảng ở chính giữa theo đường kẻ đậm và ghép lại thành một bảng vuông như sau:
1
2N
3N-1
...
N2-(N-2)
2
N+1
3N
...
N2-(N-3)
3
N+2
2N+1
...
N2-(N-4)
...
...
...
...
...
N
2N-1
3N-2
...
(N-1)N+1
Khi đó tổng các số trong hàng thứ i là
(Ni2-Ni+i2+i)/2 + (N3+Ni+N-Ni2-i2-i)/2  =  (N3+N)/2 = N(N2+1)/2
Rõ ràng trong mỗi hàng có N số và tổng các số trong mỗi hàng là như nhau.
Bài 17/2000 - Số nguyên tố tương đương 
(Dành cho học sinh THCS)
Có thể viết chương trình như sau: 
Program Nttd;
Var M,N,d,i: integer;
{------------------------------------}
Function USCLN(m,n: integer): integer;
Var r: integer;
Begin
 While n0 do
 begin
   r:=m mod n; m:=n; n:=r;
 end;
 USCLN:=m;
End;
{------------------------------------}
BEGIN
 Write('Nhap M,N: '); Readln(M,N);
 d:=USCLN(M,N); i:=2;
 While d1 do
 begin
   If d mod i =0 then
   begin
     While d mod i=0 do d:=d div i;
     While M mod i=0 do M:=M div i;
     While N mod i=0 do N:=N div i;
   end;
   Inc(i);
 end;
 If M*N=1 then Write('M va N nguyen to tuong duong.')
 Else Write('M va N khong nguyen to tuong duong.');
 Readln;
END.
Bài 18/2000 - Sên bò
(Dành cho học sinh THCS và THPT)
Ta có thể thấy ngay là con sên phải đi N bước (vì xi+1 = xi+1), và nếu đi lên k bước thì lại di xuống k bước (vì yN = y0 = 0). Do đó, h = N div 2;
Chương trình có thể viết như sau:
Program Senbo;
Uses Crt, Graph;
Var f:Text;
 gd, gm, N, W,xo,yo:Integer;
Procedure Nhap;
Begin
 Write('Nhap so N<50:');Readln(N);
 If N>50 Then N:=50;
End;
Procedure Veluoi;
Var i,j,x,y:Integer;
Begin
 W:=(GetMaxX -50) Div N;
 yo:=GetMaxY-100;
 xo:=(GetMaxX-W*N) Div 2-25;
 For i:=0 To N Do
 For j:=0 To N Div 2 Do
 Begin
 x:=i*W+xo;
 y:=yo-J*W;
 Bar(x-1,y-1,x+1,y+1);
 End;
End;
Procedure Bo
Var i,j,xo,yo,x,y:Integer;
 Sx,Sy,S:String;
Begin
 j:=0;xo:=xo;y:=yo;
 Writeln(f,N:2,N Div 2:3);
 SetColor(2);
 OutTextXY(xo,yo+5,'(0,0)');
 For i:=1 To N Do
 Begin
 If i<=N-i Then Inc(j)
 Else If j>0 Then Dec(j);
 Writeln(f,i:2,j:3);
 x:=i*W+xo;y:=yo-j*W;
 Line(xo,yo,x,y);
 Str(i,sx);str(j,sy);
 S:='('+sx+','+sy+')');
 OutTextXY(x,y+5,s);
 Delay(10000);
 xo:=x;yo:=y;
 End;
End;
Begin
 Nhap;
 Assign(F,'P5.Out');
 ReWrite(F);
 Dg:=Detect;
 InitGraph(Gd,Gm,'');
 VeLuoi;
 Bo;
 Readln;
 Close(F);
 CloseGraph;
End.
Bài 19/2000 - Đa giác 
(Dành cho học sinh THPT)
Ta sẽ chứng minh khẳng định sau cho n ³ 3:
Các số thực dương a1, a2, a3,..., an lập thành các cạnh liên tiếp của một đa giác n cạnh khi và chỉ khi với mọi k=1, 2,..., n ta có các bất đẳng thức sau:
a1 + a2 +... (thiếu k)... + an > ak                   (1)
(tổng của n-1 cạnh bất kỳ phải lớn hơn độ dài cạnh còn lại)
Chứng minh
Chứng minh được tiến hành qui nạp theo n. Với n = 3 thì (1) chính là bất đẳng thức tam giác quen thuộc. 
Giả sử (1) đúng đến n. Xét (1) cho trường hợp n+1. 
Trước tiên ta có nhận xét sau: Các số a1, a2,..., an, an+1 lập thành một đa giác n +1 cạnh khi và chỉ khi tồn tại một số g sao cho a1, a2, a3,..., an-1, g tạo thành một đa giác n cạnh và g, an, an+1 tạo thành một tam giác.
Giả sử a1, a2, a3,..., an, an+1 lập thành một đa giác n +1 cạnh. Khi đó theo nhận xét trên thì tồn tại đa giác n cạnh a1, a2, a3,..., an-1, g và tam giác g, an, an+1. Do đó ta có các bất đẳng thức sau suy từ giả thiết qui nạp và bất đẳng thức tam giác:
a1 + a2 + a3 +.... + an-1 > g                             (2)
an + an+1 > g > |an - an+1|                                (3)
Do vậy ta có 
a1 + a2 + a3 +.... + an-1 > |an - an+1|                 (4)
từ (4) suy ra ngay các khẳng định sau:
a1 + a2 + a3 +.... + an-1 + an > an+1                    (5)
a1 + a2 + a3 +.... + an-1 + an+1 > an                    (6)
Mặt khác từ giả thiết qui nạp cho đa giác n cạnh a1, a2, a3,..., an-1, g, tương tự như (2) ta có các bất đẳng thức sau với k < n:
a1 + a2 +... (thiếu k)... + an-1 + g > ak
thay thế vế trái của (3) ta phải có với k 
a1 + a2 +... (thiếu k)... + an-1 + an + an+1 > ak    (7)
Các bất đẳng thức (5), (6) và (7) chính là (1). Điều kiện cần được chứng minh.
Giả sử ngược lại, hệ bất đẳng thức (1) thoả mãn, ta có
a1 + a2 +... + an-1 + an > an+1                            (8)
a1 + a2 +... + an-1 + an+1 > an                            (9)
và với mọi k < n ta có:
a1 + a2 +...(thiếu k)... + an-1 + an + an+1 > ak     (10)
Từ (8) và (9) ta có ngay:
a1 + a2 +... + an-1 > |an - an+1|                            (11)
Từ (10) suy ra với mọi k < n ta có:
an + an+1 > ak - a1 - a2 -...(thiếu k)... - ak           (12)
Từ các bất đẳng thức (11) và (12) suy ra tồn tại một số dương g thỏa mãn đồng thời các điều kiện sau:
an + an+1 > g > |an - an+1|                                (13)
a1 + a2 +... + an-1 > g                                       (14)
g > ak - a1 - a2 -...(thiếu k)... - ak                     (15)
Các bất đẳng thức (13), (14) và (15) chính là điều kiện để tồn tại đa giác n cạnh a1, a2, a3,..., an-1, g và tam giác g, an, an+1. Điều kiện đủ đã được chứng minh.
Chương trình:
Program Dagiac;
Uses Crt;
Const fn = 'P6.INP';
Var i,j,N: integer;
    a: array[1..100] of real;
    s: real;
    Kq: boolean;
{------------------------------------}
Procedure Nhap;
Var f: text;
Begin
 Assign(f,fn); Reset(f);
 Readln(f,N);
 For i:=1 to N do Read(f,a[i]);
 Close(f);
End;
{------------------------------------}
BEGIN
 Nhap;
 Kq:=true;
 For i:=1 to N do
 begin
   s:=0;
   For j:=1 to N do If ji then s:=s+a[j];
   If s<=a[i] then Kq:=false;
 end;
 If Kq then Write('Co.') Else Write('Khong.');
 Readln;
END.
Bài 20/2000 - Bạn Lan ở căn hộ số mấy? 
(Dành cho học sinh Tiểu học)
Ta coi như các căn hộ được đánh số từ 1 đến 64 (vì ngôi nhà có 8 tầng, mỗi tầng có 8 căn hộ). Ta có thể hỏi như sau:
- Có phải số nhà bạn lớn hơn 32?
Sau khi Lan trả lời, dù "đúng" hay "không" ta cũng biết chính xác căn hộ của Lan ở trong số 32 căn hộ nào. Giả sử câu trả lời là "không" ta cũng biết chính xác căn hộ của Lan ở trong số 32 căn hộ nào. Giả sử câu trả lời là "không", ta hỏi tiếp:
-  Có phải số nhà bạn lớn hơn 16?
Sau câu hỏi này ta biết được 16 căn hộ trong đó có căn hộ Lan đang ở.  
Tiếp tục hỏi như vậy đối với số đứng giữa trong các số còn lại. Sau mỗi câu trả lời khoảng cách giữa các số giảm đi một nửa. Cứ như vậy, chỉ cần 6 câu hỏi, ta sẽ biết được căn hộ Lan ở.
Bài 21/2000 - Những trang sách bị rơi 
(Dành cho học sinh Tiểu học)
Nếu trang bị rơi đầu tiên đánh số 387 thì trang cuối cùng sẽ phải đánh số lớn hơn và phải là số chẵn. Do vậy trang cuối cùng phải là 738.
Như vậy, có 738 - 378 + 1= 352 trang sách (176 tờ ) bị   rơi.
Bài 22/2000 - Đếm đường đi 
(Dành cho học sinh THCS) 
a) Có tất cả 8 đường đi từ A đến B sao cho mỗi đường đi qua một đỉnh nào đó chỉ đúng một lần. Cụ thể:
A B
A E B
A E F B
A E D F B 
A E F C B 
A E D C B
A E F D C B
A E D F C B
b). Có tất cả 8 đường đi từ A đến D, sao cho đường đi đó qua mội cạnh nào đó chỉ đúng một lần, cụ thể:
A B C D
A B E D
A B F D
A E D
A E B F D
A E B C D
A E F D
A E F C D
c). Các đường đi qua tất cả các cạnh của hình, qua mỗi cạnh đúng một lần (điểm bắt đầu và điểm kết thúc trùng nhau):
- 
+ Các đường đi qua tất cả các cạnh của hình, qua mỗi cạnh đúng một lần (điểm bắt đầu và điểm kết thúc không trùng nhau): 
- Điểm bắt đầu là C và điểm kết thúc là D:
CFBCDFEBAED
CFBCDFEABED
CDFCBFEBAED
....
Tương tự như thế với điểm bắt đầu là D và điểm kết thúc là C ta cũng tìm được các đường thoả mãn tính chất này.
Bài 23/2000 - Quay Rubic 
(Dành cho học sinh THPT)
Khai triển mặt rubic và đánh số các mặt như hình vẽ sau:
Khi đó ta có thể xây dựng thủ tục Quay (mặt thứ i) để đổi màu 8 mặt con của mặt này và 12 mặt con kề với mặt này. Trên cơ sở đó giải được 2 bài toán này. Chương trình có thể viết như sau:
Program Rubic;
uses Crt;
Type  Arr= array[0..5, 0..7] of byte;
const color: Array [0..5] of char=('F', 'U','R', 'B', 'L', 'D');
Var
A1, A2, A0, A: Arr;
        X, X1, X2: String;
        k: byte;
Procedure Nhap;
Var   i, j: byte;
Begin
       Clrscr;
       Writeln ('Bai toan 1. So sanh hai xau:');
       Writeln ('Nhap xau X1:');
       Readln (X1);
       Writeln (' Nhap xau X2:');
       Readln (X2);
       Writeln ('Bai toan 2. Tinh so lan xoay:');
       Write ('Nhap xau X:');
       Readln (X);
      For i:= 0 to 5 do
          For j:= 0 to 7 do A[i, j]:= i; 
       A:=A0; A1:=A0; A2:=A0;
End;
Procedure Quay (Var A: Arr; k: byte);
Const Dir : array
[0.. 5, 0.. 3, 0.. 3] of byte = ( ( (1,2,5,4), (6,0,2,4), (5,7,1,3), (4,6,0,2) ),
 ( (0,4,3,2), (0,0,4,0), (1,1,5,1), (2,2,6,2) ), 
 ( (0,1,3,5), (4,4,4,4), (3,3,3,3), (2,2,2,2) ),
 ( (1,4,5,2), (2,0,6,4), (1,7,5,3), (0,6,4,2) ), 
 ( (0,5,3,1), (0,0,0,0), (7,7,7,7),(6,6,6,6) ), 
 ( (0,2,3,4), (6,6,2,6), (5,5,1,5), (4,4,0,4) ) );
var i,j,tg: byte;
Begin
tg:=A[k,6];
for i:=3 downto 1 do A[k,0] := A[k,2*i-2];
A[k,0]:=tg;
tg:=A[k,7];
for i:=3 downto 1 do A[k,2*i] := A[k,2*i -2];
A[k,1]:=tg;
for i:=1 to 3 do
begin
tg:=A[dir[k,0,3], Dir[k,i,3];
for j:=3 downto 1 do A[ dir[k,0,j], Dir[k,i,j] ]:= A[ dir[k,0,j-1], Dir[k,i,j-1] ];
A[ [dir[k,0,0], Dir[k,i,0] ]:=tg;
end;
End;
Function Eq(A,B:Arr):Boolean;
Var i,j,c:byte;
Begin
c:=0;
for i:=1 to 5 do
for j:=1 to 7 do
If A[i,j] B[i,j] then inc(c);
If c=0 then Eq:=true else Eq:=false;
End;
Procedure QuayXau(x:string; var A: arr);
Var i,j:byte;
Begin
for i:=1 to length(X) do
begin
for j:= 1 to 5 do
If Color[j] = X[i] then Quay(A,j);
end;
End;
Procedure Bai1;
Begin
QuayXau(X1,A1);
QuayXau(X2,A2);
End;
Procedure Bai2;
Begin
k:=0;
Repeat
QuayXau(X,A);
Inc(k);
Until Eq(A,A0);
End;
Procedure Xuat;
Var i,j:byte;
Begin
writeln;
writeln('Ket qua:');
writeln('Bai toan 1. So sanh 2 xau:') ;
If Eq(A1,A2) then writeln('Hai xau X1 va X2 cho cung mot ket qua.');
writeln('Can ap dung xau X ',k,' lan de Rubic quay ve trang thai ban dau.');
Readln;
End;
Begin
 Nhap;
 Bai1;
 Bai2;
 Xuat;
END.
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
1638