Tổng hợp đề thi Tin học trẻ

nction 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 7 - 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 8 - Đế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 9 - 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 10 - 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 11 - 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 12 - 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 13 - 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 14 - 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 15 - 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 16 - 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 17 - Đảo chữ cái
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
(*Du lieu vao: file 'inp.txt' voi cac tu khac nhau, moi tu ghi o mot dong; 
 Du lieu ra: file 'out.txt' *)
PROGRAM Sinh_hoan_vi;
USES Crt;
CONST
 MAX = 100;
 INP = 'inp.txt';
 OUT = 'out.txt';
TYPE
 STR = array[0..max] of char;
VAR
 s :str;
 f,g :text;
 n :longint; { so luong tu}
 time:longint ;
PROCEDURE Nhap_dl;
Begin
 Assign(f,inp);
 Assign(g,out);
 Reset(f);
 Rewrite(g);
 Readln(f,n);
End;
PROCEDURE DocDay(var s:str);
Begin
 Fillchar(s,sizeof(s),chr(0));
 While not eoln(f) do
 begin
 s[0]:=chr(ord(s[0])+1);
 read(f,s[ord(s[0])]);
 end;
End;
PROCEDURE VietDay(s:str);
Var i :word;
Begin
 For i:=1 to ord(s[0]) do Write(g,s[i]);
End;
PROCEDURE Sap_xep(l,r:word);{ giai thuat Quicksort}
Var i,j :word;
 tg,tam :char;
Begin
 i:=l;j:=r;
 tg:=s[(l+r) div 2];
 Repeat
 While ord(s[i]) < ord(tg) do inc(i);
 While ord(s[j]) > ord(tg) do dec(j);
 If i<=j then
 begin
 tam:=s[i];
 s[i]:=s[j];
 s[j]:=tam;
 inc(i);
 dec(j);
 end;
 Until i>j;
 If j>l then Sap_xep(l,j);
 If i<r then Sap_xep(i,r);
End;
PROCEDURE Sinh_hv(s:str);
Var vti,vtj,i,j:word;
 stop :boolean;
 tam :char;
Begin
 Writeln(g);
 VietDay(s);
 Repeat
 Stop:=true;
 For i:= ord(s[0]) downto 2 do
 If s[i] > s[i-1] then
 begin
 vti:=i-1;
 stop:=false;
 For j:=ord(s[0]) downto vti+1 do
 begin
 If (ord(s[j])>ord(s[vti])) then
 begin
 vtj:=j;
 break;
 end;
 end;
 tam:=s[vtj];
 s[vtj]:=s[vti];
 s[vti]:=tam;
 For j:=1 to ((ord(s[0]) - (vti+1))+1) div 2 do
 begin
 tam:=s[vti+j];
 s[vti+j]:=s[ord(s[0])-j+1];
 s[ord(s[0])-j+1]:=tam;
 end;
 Writeln(g);
 VietDay(s);
 break;
 end;
 Until stop;
End;
PROCEDURE Xu_ly;
Var i:longint;
Begin
 For i:=1 to n do
 begin
 DocDay(s);
 readln(f);
 Sap_xep(1,ord(s[0]));
 Sinh_hv(s);
 Writeln(g);
 end;
 Close(f);
 Close(g);
End;
BEGIN
 Nhap_dl;
 Xu_ly;
END.
(Lời giải của bạn Nguyễn Việt Bằng - Lớp 10 Tin - Trường phổ thông Năng Khiếu - ĐHQG TPHCM) 
Bài 18 - Xoá số trên vòng tròn 
Lời giải 1:
Program vd;
Uses crt;
Var s:array[1..2000] of integer;
 i:integer;
Begin
 Clrscr;
 for i:=0 to 1999 do s[i]:=i+1;
 s[2000]:=1;
 i:=1;
 repeat
 s[i]:=s[s[i]];
 i:=s[i];
 until
 s[i]=i;
 writeln(i);
 readln;
End.
(Lời giải của bạn: Hà Huy Luân)
Lời giải 2:
Program xoa_so;
Const N=2000;
Var x:integer;
Function topow(x:integer):integer;
Var P:integer;
Begin
 P:=1;
 Repeat 
 p:=p*2;
 Until p>x;
 topow:=p div 2;
End;
BEGIN
 x:=1+2*(N-topow(N));
 write(x);
END.
(Lời giải của bạn: Nguyễn Quang Trung - Lớp 12A Trường HERMANN GMEINER, Đà Lạt, Lâm Đồng)
Lời giải 3: 
(* Thuat Giai Xu ly Bit *)
USES Crt;
CONST
 Max = 2000;
VAR
 A: array[0..(MAX div 8)] of byte;
 so: word;
FUNCTION Laybit(i:word):byte;
Var k:word;
Begin
 k:=i div 8;
 i:=i mod 8;
 Laybit:=(a[k] shr (7-i)) and 1;
End;	
PROCEDURE Tatbit(i:word);
Var k:word;
Begin
 k:=i div 8;
 i:=i mod 8;
 a[k]:=a[k] and (not (1 shl (7-i)));
End;
FUNCTION Tim(j:word):word;
Begin
 While (laybit(j+1)=0) do
 begin
 If j=max-1 then j:=0
 else inc(j);
 end;
 Tim:=j+1;
End;
PROCEDURE Xuly;
Var j,dem,i :word;
Begin
 j:=1;dem:=0;
 Fillchar(a,sizeof(a),255);
 Tatbit(0);
 Repeat
 If j=max then j:=0;
 j:=tim(j);
 Tatbit(j);
 inc(dem);
 If j=max then j:=0;
 j:=tim(j);
 Until dem=max-1;
 For i:=0 to (max div 8) do
 If a[i]0 then break;
 so:=i * (1 shl 3);
 For i:=so to so+7 do
 If Laybit(i)=1 then break;
 so:=i;
 Writeln(' SO TIM DUOC LA :',SO:4);
 Writeln(' Press Enter to Stop.....');
 readln;
End;
BEGIN
 Clrscr;
 Xuly;
END.
Bài 19 - Những chiếc gậy
(Dành cho học sinh THPT)
Program bai48;
Var x:array[0..10000] of word;
 d,a:array[1..1000] of byte;
 n,p,s,gtmax:word;
 fi,fo:text;
 ok:boolean;
Procedure Q_sort(l,k:word);
Var h,i,j,t:word;
Begin
 h:=a[(l+k)div 2];i:=l;j:=k;
 Repeat
 While a[i]>h do inc(i);
 While a[j]<h do dec(j);
 If i<=j then
 Begin
 t:=a[i];a[i]:=a[j];a[j]:=t;
 inc(i);dec(j);
 End;
 Until i>j;
 if i<k then Q_sort(i,k);
 if j>l then Q_sort(l,j);
End;
Procedure phan(var ok:boolean);
Var i,p1,j:word;
Begin
 Fillchar(x,sizeof(x),0);x[0]:=1;
 For i:=1 to n do
 If (d[i]=0) then
 For j:=p downto a[i] do
 If (x[j]=0) and(x[j-a[i]]0) then
 Begin
 x[j]:=i;
 if j=p then
 Begin
 j:=a[i];
 i:=n;
 End;
 End;
 ok:=(x[p]0);
 if ok then
 Begin
 p1:=p;
 Repeat
 d[x[p1]]:=1;
 p1:=p1-a[x[p1]];
 Until p1=0;
 End;
End;
Procedure chat(Var ok:boolean);
Var i:word;
Begin
 Fillchar(d,sizeof(d),0);
 Repeat
 phan(ok);
 Until not ok;
 ok:=true;
 for i:= n downto 1 do
 if d[i]=0 then
 Begin
 ok:=false;
 break;
 End;
End;
Procedure Tinh;
Begin
 For p:=gtmax to s div 2 do
 Begin
 chat(ok);
 if ok then
 Begin
 writeln(fo,p);
 break;
 End;
 End;
 If not ok then
 Writeln(fo,s);
End;
Procedure Start;
Var i:word;
Begin
 assign(fi,'input.txt');reset(fi);
 assign(fo,'output.txt');rewrite(fo);
 While not seekeof(fi) do
 Begin
 Readln(fi,n);
 if n0 then
 Begin
 gtmax:=0;s:=0;
 for i:=1 to n do
 Begin
 Read(fi,a[i]);
 s:=s+a[i];
 if a[i]> gtmax then
 gtmax:=a[i];
 End;
 Q_sort(1,n);
 Tinh;
 End;
 End;
 Close(fi);Close(fo);
End;
Begin
 Start;
End.
9
5 2 1 5 2 1 5 2 1
4
1 2 3 4
0
(Lời giải của bạn Tăng Hải Anh - Hải Dương - TP. Hải Phòng
Bài 20 - Bài toán đổi màu bi
(Dành cho học sinh THCS và PTTH) 
Program ba_bi;
Uses crt;
var v,x,d:integer;
BEGIN
 Clrscr;
 writeln('v x d ?(>=0)');
 readln(v,x,d);
 if ((v-x)mod 3 =0)and((x+d)*(v+d)0) then
 while (v+x)0 do
 begin
 d:=d-1+3*((3*v*x)div(3*v*x-1));
 x:=x+2-3*((3*x)div(3*x-1));
 v:=v+2-3*((3*v)div(3*v-1));
 writeln('>> ',v,' ',x,' ',d);
 end
 else writeln('Khong duoc !');
 readln;
END.
(Lời giải của bạn:Nguyễn Quang Trung)
Bài 21 - Thay thế từ
(Dành cho học sinh THCS và PTTH)
program thaythetu;
var
 source,des:array[1..50]of string;
 n:byte;
procedure init;
var
 i:byte;
 s:string;
 f:text;
begin
 assign(f,'input2.txt');
 reset(f);
 n:=0;
 while not eof(f) do
 begin
 readln(f,s);
 inc(n);
 while (s'')and(s[1]=' ') do
 delete(s,1,1);
 if i>0 then
 begin
 i:=pos(' ',s);
 des[n]:=copy(s,1,i-1);
 while (i<=length(s))and(s[i]=' ') do
 i:=i+1;
 source[n]:=copy(s,i,length(s)-i+1);
 end;
 end;
end;
procedure replace;
var
 f,g:text;
 s:string;
 i,k:byte;
begin
 assign(f,'input1.txt');
 reset(f);
 assign(g,'kq.out');
 rewrite(g);
 while not eof(f) do
 begin
 readln(f,s);
 for k:=1 to n do
 for i:=1 to length(s)-length(des[k])+1 do
 if des[k]=copy(s,i,length(des[k])) then
 begin
 delete(s,i,length(des[k]));
 insert(source[k],s,i);
 i:=i+length(source[k]);
 end;
 writeln(g,s);
 end;
 close(f);
 close(g);
end;
begin
 init;
 replace;
end.
Bài 22 - Bạn hãy gạch số 
(Dành cho học sinh Tiểu học và THCS)
Chúng ta viết ra 10 số nguyên tố đầu tiên: 
 2 3 5 7 11 13 17 19 23 29
là số có 16 chữ số, có thể chứng minh không khó khăn lắm rằng sau khi gạch đi 8 chữ số thì số nhỏ nhất có thể được là: 11111229; còn số lớn nhất có thể được là: 77192329. Thật vậy:
a. Gạch đi 8 chữ số, để số còn lại là một số có 8 chữ số là nhỏ nhất (giữ nguyên thứ tự ban đầu). Nhìn vào dãy số ở trên ta thấy số 1 là nhỏ nhất, có năm chữ số 1 và sau chữ số 1 thứ năm này lại còn nhiều hơn 3 chữ số khác nữa. Do đó, 5 chữ số đầu của số cần tìm chắc chắn phải là 5 chữ số 1. Lí luận tương tự, để tìm được 3 chữ số còn lại.
b. Tương tự như thế: chữ số 9 là lớn nhất, nhưng sau chữ số 9 đầu tiên lại chỉ còn lại 4 chữ số (mà ta cần giữ lại số có 8 chữ số), nên ta không thể chọn số 9 là chữ số đứng đầu trong 8 chữ số cần tìm. Chữ số lớn thứ hai là 7, có hai chữ số 7, tất nhiên ta chọn chữ số 7 đầu tiên (vì sau chữ số 7 thứ 2 chỉ còn lại 6 chữ số). Lí luận tương tự, ta tìm được chữ số thứ hai trong 8 chữ số cần tìm cũng là chữ số 7, và 6 chữ số còn lại phải tìm tất nhiên là 6 chữ số sau chữ số 7 này.
Bài 23 - Bài toán che mắt mèo 
(Dành cho học sinh THCS và PTTH)
Program Che_Mat_meo;
Uses crt;
Const td=200;
Var i,j,n:integer;
 out:string;
 f:text;
Procedure Xuli;
 Begin
 for i:=1 to n do
 begin
 gotoxy(15,i+3);
 for j:=1 to n do
 begin
 if (odd(i))and(odd(j)) then
 begin
 textcolor(11);
 if out'' then write(f,'M ')
 else 
 begin 
 write('M ');
 delay(td); 
 end;
 end
 else
 begin
 textcolor(14);
 if out'' then write(f,'o ')
 else 
 begin 
 write('o ');
 delay(td); 
 end;
 end;
 end;
 writeln(f);
 end;
 End;
BEGIN
 Clrscr; textcolor(2);
 Write('Nhap n= ');
 Readln(n);
 if n<=20 then out:=''
 else
 begin
 out:='matmeo.inp';
 writeln('Mo File meo.inp de xem ket qua');
 end;
 Assign(f,out);
 Rewrite(f);
 writeln(f,'(Chu M Ki hieu cho con meo, chu o ki hieu cho quan co)');
 Xuli; writeln(f);
 Writeln(f,'Tong cong co ',sqr((n+1) div 2),' con meo');
 Close(f);
 Readln;
END.
 (Lời giải của bạn Đỗ Ngọc Sơn - Quảng Ninh
Bài 24 - Chọn số
(Dành cho học sinh Tiểu học và THCS )
Giả sử có m số 1, n số -1 (m, n nguyên dương) theo giả thiết:
a) m + n = 2000, suy ra m, n cùng tính chẵn lẻ. 
+ Nếu m chẵn, do đó n cũng chẵn, ta chọn ra m/2 số 1 và n/2 số -1. 
+ Nếu m lẻ, n lẻ: 
	m = 2k +1 = k + (k + 1)
 n = 2q +1 = q + (q + 1)
Luôn có: k - q = (k+1) - (q+1), do đó ta sẽ chọn k số 1 và q số -1. 
Vậy ta luôn có thể chọn ra các s