LỜI GIẢI 100 BÀI TOÁN

Phần II: LỜI GIẢI

Bài 1/1999 - Trò chơi cùng nhau qua cầu

(Dành cho học sinh Tiểu học)

Đáp số: 17 phút. Cách đi như sau:

Lượt 1: 2 + 1 sang, 1 quay về       thời gian: 3 phút

Lượt 2: 10 + 5 sang, 2 quay về     thời gian: 12 phút

Lượt 3: 2 + 1 sang                        thời gian: 2 phút

                                             Tổng thời gian: 17 phút

Bài 2/1999 - Tổ chức tham quan

(Dành cho học sinh THCS)

Program bai2;

uses crt;

const fi = 'P2.inp';

         fo = 'P2.out';

type _type=array[1..2] of integer;

 mang=array[1..200] of _type;

var f:text;

 d,v:mang;

 m,n:byte;

procedure input;

var i:byte;

begin

 assign(f,fi);

 reset(f);

 readln(f,n,m);

 for i:=1 to n do

 begin

 read(f,d[i,1]);

 d[i,2]:=i;

 end;

 readln(f);

 for i:=1 to m do

 begin

 read(f,v[i,1]);

 v[i,2]:=i;

 end;

 close(f);

end;

procedure sapxeptang(var m:mang;n:byte);

var d:_type;

 i,j:byte;

begin

 for i:=1 to n-1 do

 for j:=i+1 to n do

 if m[j,1]m[i,1] then

 begin

 d:=m[j];

 m[j]:=m[i];

 m[i]:=d;

 end;

end;

var i:byte;

 tong:integer;

begin

 input;

 sapxeptang(d,n);

 sapxeptang(v,m);

 tong:=0;

 for i:=1 to n do tong:=tong+v[n-i+1,1]*d[i,1];

 for i:=1 to n do v[i,1]:=d[n-i+1,2];

 xapxeptang(v,n);

 assign(f,fo);

 rewrite(f);

 writeln(f,tong);

 for i:=1 to n do writeln(f,v[i,2]);

 close(f);

end.

Nhận xét: Chương trình trên sẽ chạy chậm nếu chúng ta mở rộng bài toán (chẳng hạn n <= m <= 8000). Sau đây là cách giải khác:

const

  Inp = 'P2.INP';

  Out = 'P2.OUT';

var

  n, m: Integer;

  Val, Pos: array[1..2, 1..8000] of Integer;

procedure ReadInput;

var

  i: Integer;

  hf: Text;

begin

  Assign(hf, Inp);

  Reset(hf);

  Readln(hf, n, m);

  for i := 1 to n do Read(hf, Val[1, i]);

  Readln(hf);

  for i := 1 to m do Read(hf, Val[2, i]);

  Close(hf);

  for i := 1 to m do

  begin

    Pos[1, i] := i;

    Pos[2, i] := i;

  end;

end;

procedure QuickSort(t, l, r: Integer);

var

  x, tg, i, j: Integer;

begin

  x := Val[t, (l + r) div 2];

  i := l; j := r;

  repeat

    while Val[t, i] < x do Inc(i);

    while Val[t, j] > x do Dec(j);

    if i <= j then

    begin

      Tg := Val[t, i]; Val[t, i] := Val[t, j]; Val[t, j] := Tg;

      Tg := Pos[t, i]; Pos[t, i] := Pos[t, j]; Pos[t, j] := Tg;

      Inc(i); Dec(j);

    end;

  until i > j;

  if i < r then QuickSort(t, i, r);

  if j > l then QuickSort(t, l, j);

end;

procedure WriteOutput;

var

  i: Integer;

  Sum: LongInt;

  hf: Text;

begin

  Sum := 0;

  for i := 1 to n do Inc(Sum, Val[1, n - i + 1] * Val[2, i]);

  for i := 1 to n do Val[1, Pos[1, n - i + 1]] := Pos[2, i];

  Assign(hf, Out);

  Rewrite(hf);

  Writeln(hf, Sum);

  for i := 1 to n do Writeln(hf, Val[1, i]);

  Close(hf);

end;

begin

  ReadInput;

  QuickSort(1, 1, n);

  QuickSort(2, 1, m);

  WriteOutput;

end.

Bài 3/1999 - Mạng tế bào

(Dành cho học sinh THPT)

Program Bai3/1999;

uses crt;

const fi = 'P3.inp';

 fo = 'P3.out';

type mang=array[0..201,0..201] of byte;

var m,n,t:byte;

 s:string;

 a:mang;

 f:text;

 b,c:^mang;

procedure input;

var i,j:byte;

begin

 assign(f,fi);

 reset(f);

 readln(f,m,n,t);

 readln(f,s);

 for i:=1 to m do

 begin

 for j:=1 to n do read(f,a[i,j]);

 end;

 close(f);

 new(b);

 new(c);

end;

procedure hien;

var i,j:byte;

begin

 for i:=1 to m do

 for j:=1 to n do

 begin

 gotoxy(j*2,i);

 write(b^[i,j]);

 end;

end;

procedure trans(ch:char);

var i,j,d:byte;

begin

 fillchar(c^,sizeof(mang),0);

 for i:=1 to m do

 for j:=1 to n do

 begin

 d:=b^[i,j];

 case a[i,j] of

 1:inc(c^[i,j-1],d);

 2:inc(c^[i,j+1],d);

 3:inc(c^[i-1,j],d);

 4:inc(c^[i+1,j],d);

 5:begin inc(c^[i-1,j],d);inc(c^[i+1,j],d); end;

 6:begin inc(c^[i,j-1],d);inc(c^[i,j+1],d); end;

 7:begin inc(c^[i,j-1],d);inc(c^[i-1,j],d); end;

 8:begin inc(c^[i,j+1],d);inc(c^[i+1,j],d); end;

 end;

 end;

 if ch<>'X' then b^[1,1]:=ord(ch)-48;

 for i:=1 to m do

 for j:=1 to n do

 if (i<>1) or (j<>1) then b^[i,j]:=byte(c^[i,j]<>0);

 hien;

 readln;

end;

procedure output;

var i,j:byte;

begin

 assign(f,fo);

 rewrite(f);

 for i:=1 to m do

 begin

 for j:=1 to n do write(f,' ',b^[i,j]);

 writeln(f);

 end;

 close(f);

end;

var i:byte;

begin

 clrscr;

 input;

 fillchar(b^,sizeof(mang),0);

 fillchar(c^,sizeof(mang),0);

 for i:=1 to t do trans(s[i]);

 output;

end.

Bài 4/1999 - Trò chơi bốc sỏi

(Dành cho học sinh Tiểu học)

Huy sẽ là người thắng cuộc. Thật vậy số sỏi ban đầu là 101 là một số có dạng 5k+1, nghĩa là số nếu chia 5 sẽ còn dư 1. Hoàng phải bốc trước, do số sỏi của Hoàng phải lấy là từ 1 đến 4 do đó sau lượt đi đầu tiên, số sỏi còn lại sẽ lớn hơn 96. Huy sẽ bốc tiếp theo sao cho số sỏi còn lại phải là 96, nghĩa là số dạng 5k+1. Tương tự như vậy, Huy luôn luôn chủ động được để sau lần bốc của mình số sỏi còn lại là 5k+1. Lần cuối cùng số sỏi còn lại chỉ là 1 và Hoàng bắt buộc phải bốc viên cuối cùng và ... thua.

Bài toán tổng quát: có thể cho số viên bi là 5k+1 viên.

Bài 5/1999 - 12 viên bi  

(Dành cho học sinh THCS)

Ta sẽ chỉ ra rằng tồn tại 3 lần cân để chỉ ra được viên bi đặc biệt đó.

Gọi các viên bi này lần lượt là 1, 2, ..., 12. Trong khi mô tả thuật toán ta dùng ký hiệu

để mô tả quả hòn bi thứ n

để mô tả một hòn bi bất kỳ

Mô tả một phép cân.

Ta gọi viên bi có trọng lượng khác là đđ.

I. Lần cân thứ nhất. Lấy ra 8 hòn bi bất kỳ và chia làm 2 phần để cân:

Có 2 trường hợp xảy ra:

1.1. Cân trên cân bằng. Suy ra viên bi đđ (không rõ nặng nhẹ) nằm trong 4 viên bi còn lại (không mang ra cân)

1.2. Cân trên không cân bằng.

1.2.1. Nếu (1) nhẹ hơn (2) suy ra hoặc đđ là nhẹ nằm trong (1) hoặc đđ là nặng nằm trong (2).

1.2.2. Nếu (1) nặng hơn (2) suy ra hoặc đđ là nặng nằm trong (1) hoặc đđ là nhẹ nằm trong (2).

Dễ thấy các trường hợp 1.2.1. và 1.2.2. là tương tự nhau.

Trong mọi trường hợp ta có kết luận đđ nằm trong số 8 viên hoặc nhẹ trong 4 hoặc nặng trong 4 còn lại.

II. Xét trường hợp 1.1: Tìm được 4 viên bi chứa đđ

Gọi các hòn bi này là 1, 2, 3, 4

Lần cân thứ hai:

Xét các trường hợp sau:

2.1. Cân thăng bằng. Kết luận: viên bi 4 chính là đđ.

2.2. Trường hợp cân trái nhẹ hơn phải (dấu <). Suy ra hoặc 3 là đđ nặng, hoặc 1 hoặc 2 là đđ nhẹ.

2.3. Trường hợp cân trái nặng hơn phải (dấu >). Suy ra hoặc 3 là đđ nhẹ, hoặc 1 hoặc 2 là đđ nặng.

Dễ thấy rằng các trường hợp 2.2. và 2.3. là tương tự nhau.

III. Xét trường hợp 2.1: viên bi 4 chính là đđ

Lần cân thứ ba:

Nếu cân nghiêng < thì 4 là đđ nhẹ, nếu cân nghiêng > thì 4 là đđ nặng.

IV. Xét trường hợp 2.2. Hoặc 3 là đđ nặng, hoặc 1 hoặc 2 là đđ nhẹ.

Lần cân thứ ba:

Nếu cân thăng bằng thì ta có 1 là hòn bi đđ nhẹ.

Nếu cân nghiêng > thì ta có 3 là hòn bi đđ nặng.

Nếu cân nghiêng < thì ta có 2 là hòn bi nhẹ.

V. Xét trường hợp 2.3. Hoặc 3 là đđ nhẹ, hoặc 1 hoặc 2 là đđ nặng.

Cách làm tương tự trường hợp 2.2 mô tả trong mục IV ở trên.

VI. Xét trường hợp 1.2.1.

Hoặc đđ là nhẹ trong 1, 2, 3, 4 hoặc đđ là nặng trong 5, 6, 7, 8.

Lần cân thứ hai:

6.1. Trường hợp cân thăng bằng. Suy ra đđ sẽ phải nằm trong 4, 7, 8, và do đó theo giả thiết của trường hợp này ta có hoặc đđ là 4 nhẹ, hoặc đđ là nặng trong 7, 8. Dễ nhận thấy trường hợp này hoàn toàn tương tự như 2.2. Bước tiếp theo làm tương tự như mô tả trong IV.

6.2. Trường hợp cân nghiêng <, suy ra hoặc đđ là nhẹ rơi vào 1, 2 hoặc đđ là 6 nặng. Trường hợp này cũng hoàn toàn tương tự như 2.2. Bước tiếp theo làm tương tự như mô tả trong IV.

6.3. Trường hợp cân nghiêng >, suy ra hoặc đđ là 5 nặng, hoặc đđ là nhẹ 3.

VII. Xét trường hợp 6.3.

Hoặc đđ là 5 nặng, hoặc đđ là 3 nhẹ.

Lần cân thứ ba:

Nếu cân thăng bằng, suy ra 5 là đđ nặng.

Nếu cân nghiêng < suy ra 3 là đđ nhẹ.

Tất cả các trường hợp của bài toán đã được xem xét.

Sau đây là chương trình chi tiết.

Program bai5;

Uses crt;

Const

st1=' nang hon.';

st2=' nhe hon.';

Var i, kq1: integer;

kq2: string;

ch: char;

(* Thủ tục Kq *)

Procedure kq(a: integer; b: string);

Begin

kq1:=a;

kq2:=b;

End;

(* Thủ tục Cân *)

Procedure can(lan: integer; t1, t2, t3, t4, p1, p2, p3, p4: string);

Begin

Writeln('Lần cân thứ', lan, ' :');

Writeln;

Writeln(' ', t1, ' ', t2, ' ', t3, ' ', t4, ' ', p1, ' ', p2, ' ', p3, ' ', p4);

Writeln;

Write(' Bên nào nặng hơn? Trái(t)/Phải(p)/ Hay cân bằng(c)');

Repeat

ch:=readkey;

ch:=upcase(ch);

Until (ch in ['P', 'T', 'C']);

Writeln(ch);

Writeln(*==========================================*);

End;

(* Thủ tục Play *)

Procedure play;

Begin

Writeln('Có 12 quả cân: 1 2 3 4 5 6 7 8 9 10 11 12');

Writeln('Cho phép bạn chọn ra một quả cân nặng hơn hay nhẹ hơn những quả khác.');

can(1, '1', '2', '3', '4', '5', '6', '7', '8');

If (ch='T') then {T}

Begin

can(2, '1', '2', '5', ' ', '3', '4', '6', ' ');

If (ch='T') then {TT}

Begin

can(3, '1', '6', ' ', ' ', '7', '8', ' ', ' ');

If ch='T' then kq(1, st1); {TTT}

If ch='P' then kq(6, st2); {TTP}

If ch='C' then kq(2, st1); {TTC}

End

Else If (ch='P') then {TP}

Begin

can(3, '3', '5', ' ', ' ', '7', '8', ' ', ' ');

If ch='T' then kq(3, st1); {TPT}

If ch='P' then kq(5, st2); {TPP}

If ch='C' then kq(4, st1); {TPC}

End

Else If (ch='C') then {TC}

Begin

can(3, '7', ' ', ' ', ' ', ' ', '8', ' ', ' ');

If ch='T' then kq(8, st2); {TCT}

If ch='P' then kq(7, st2); {TCP}

If ch='C' then

Begin

Writeln('Trả lời sai!'); kq2:=st2;

End;

End;

End

Else If (ch='P') then {P}

Begin

can(2, '5', '6', '1', ' ', '7', '8', '2', ' ');

If (ch='T') then {PT}

Begin

can(3, '5', '2', ' ', ' ', '3', '4', ' ', ' ');

If ch='T' then kq(5, st1);

If ch='P' then kq(2, st2);

If ch='C' then kq(6, st1);

End

Else If (ch='P') then {PP}

Begin

can(3, '7', '1', ' ', ' ', '3', '4', ' ', ' ');

If ch='T' then kq(7, st1);

If ch='P' then kq(1, st2);

If ch='C' then kq(8, st1);

End

Else If (ch='C') then {PC}

Begin

can(3, '3', ' ', ' ', ' ', ' ', '4', ' ', '');

If ch='T' then kq(4, st2);

If ch='P' then kq(3, st2);

If ch='C' then

Begin

Writeln('Trả lời sai !'); kq2:=st2;

End;

End;

End

Else If (ch='C') then {C}

Begin

can(2, '9', '10', '11', ' ', '1', '2', '3', ' ');

If (ch='T') then

{CT}

Begin

can(3, '9', ' ', ' ', ' ', '10', ' ', ' ', ' ');

If (ch='T') then kq(9, st1);

If (ch='P') then kq(10, st1);

If (ch='C') then kq(11, st1);

End

Else If (ch='P') then {CP}

Begin

can(3, '9', ' ', ' ', ' ', '10', ' ', ' ', ' ');

If (ch='T') then kq(10, st2);

If (ch='P') then kq(9, st2);

If (ch='C') then kq(11, st2); End

Else If (ch='C') then {CC}

Begin

can(3, '12', ' ', ' ', ' ', '1', ' ', ' ', ' ');

If (ch='T') then kq(12, st1);

If (ch='P') then kq(12, st2);

If (ch='C') then Writeln('Trả lời sai!');

kq1:=12;

End;

End;

End;

(* Chương trình chính*)

Begin

Clrscr;

play;

Writeln(' Quả thứ', kq1, kq2);

Writeln(' Nhấn Enter kết thúc...');

Readln;

End.

Bài 6/1999 - Giao điểm các đường thẳng

(Dành cho học sinh THPT)

Program Bai6;
(* Tinh so giao diem cua n duong thang 0 trung nhau *)
Uses Crt;
Const
fn = 'P6.INP';
fg = 'P6.OUT';
max = 100;
exp = 0.0001;
Var
a ,b ,c : array[1..max] of real;
n : integer;
sgd : integer;
Procedure Nhap;
Var
f: text;
i: integer;
Begin
Assign( f ,fn ); Reset( f );
Readln( f ,n );
For i := 1 to n do
Readln( f ,a[i] ,b[i] ,c[i] ); { ax + by = c }
Close( f );
End;
(*--------------------------------------------------------------------------*)
Procedure Chuanbi;
Begin
sgd := 0;
End;
(*--------------------------------------------------------------------------*)
Function Giaodiem( i ,j : integer;Var x ,y : real ) : boolean;
Var
d ,dx ,
dy : real;
Begin
d := a[i] * b[j] - a[j] * b[i];
dx := c[i] * b[j] - c[j] * b[i];
dy := a[i] * c[j] - a[j] * c[i];
If d <> 0 then
begin
x := dx / d;
y := dy / d;
end;
giaodiem := d <> 0;
End;
(*--------------------------------------------------------------------------*)
Function Giatri( i : integer;x ,y : real ) : real;
Begin
Giatri := a[i] * x + b[i] * y - c[i];
End;
(*--------------------------------------------------------------------------*)
Function bang( a ,b : real ) : boolean;
Begin
bang := abs( a - b ) <= exp;
End;
(*--------------------------------------------------------------------------*)
Function Thoaman( i ,j : integer;x ,y : real ) : boolean;
Var
ii: integer;
Begin
Thoaman := false;
For ii := 1 to i - 1 do
If (ii <> j) and bang( giatri( ii ,x ,y ) ,0 ) then
exit;
Thoaman := true;
End;
(*--------------------------------------------------------------------------*)
Function Catrieng( i : integer ) : integer;
Var
ii , gt:integer;
x, y : real;
Begin
gt := 0;
For ii := 1 to i do
If giaodiem( i ,ii ,x ,y ) then
If thoaman( i ,ii ,x ,y ) then Inc( gt );
catrieng := gt;
End;
(*--------------------------------------------------------------------------*)
Procedure Tinhsl;
Var
i : integer;
Begin
For i := 1 to n do
Inc( sgd ,catrieng( i ) );
End;
(*--------------------------------------------------------------------------*)
Procedure GhiKQ;
 Begin
 Writeln(So giao diem cua cac duong thang la: ' ,sgd );
 End;
(*--------------------------------------------------------------------------*)
BEGIN
ClrScr;
Nhap;
Chuanbi;
Tinhsl;
ghiKQ;
END.

Bài 7/1999 - Miền mặt phẳng chia bởi các đường thẳng

(Dành cho học sinh THPT)

Program Bai7;
(* Tinh so giao diem cua n duong thang ko trung nhau *)
Uses Crt;
Const
fn = 'P7.INP';
fg = 'P7.OUT';
max = 100;
exp = 0.0001;
Var
a ,b ,c : array[1..max] of real;
n : integer;
smien : integer;
Procedure Nhap;
Var
f : text;
i : integer;
Begin
Assign( f ,fn ); Reset( f );
Readln( f ,n );
For i := 1 to n do
Readln( f ,a[i] ,b[i] ,c[i] ); { ax + by = c }
Close( f );
End;
(*--------------------------------------------------------------------------*)
Procedure Chuanbi;
Begin
smien := 1;
End;
(*--------------------------------------------------------------------------*)
Function Giaodiem( i ,j : integer;Var x ,y : real ) : boolean;
Var
d ,dx ,dy :real;
Begin
d := a[i] * b[j] - a[j] * b[i];
dx:= c[i] * b[j] - c[j] * b[i];
dy := a[i] * c[j] - a[j] * c[i];
If d <> 0 then
begin
x := dx / d;
y := dy / d;
end;
Giaodiem := d <> 0;
End;
(*--------------------------------------------------------------------------*)
Function Giatri( i : integer;x ,y : real ) : real;
Begin
Giatri := a[i] * x + b[i] * y - c[i];
End;
(*--------------------------------------------------------------------------*)
Function bang( a ,b : real ) : boolean;
Begin
bang := abs( a - b ) <= exp;
End;
(*--------------------------------------------------------------------------*)
Function Thoaman( i : integer;x ,y : real ) : boolean;
Var
ii : integer;
Begin
Thoaman := false;
For ii := 1 to i - 1 do
If bang( Giatri( ii ,x ,y ) ,0 ) then
exit;
Thoaman := true;
End;
(*--------------------------------------------------------------------------*)
Function Cattruoc( i : integer ) : integer;
Var
ii , gt : integer;
x, y : real;
Begin
gt:= 0;
For ii := 1 to i - 1 do
If Giaodiem( i ,ii ,x ,y ) then
If Thoaman( ii ,x ,y ) then Inc( gt );
cattruoc := gt;
End;
(*--------------------------------------------------------------------------*)
Procedure Tinhslmien;
Var
i : integer;
Begin
For i := 1 to n do
Inc( smien ,cattruoc( i ) + 1 );
End;
(*--------------------------------------------------------------------------*)
Procedure GhiKQ;
 Begin
 Writeln(So mien mat phang duoc chia la: ' ,smien );
 End;
(*--------------------------------------------------------------------------*)
BEGIN
Clrscr;
Nhap;
Chuanbi;
Tinhslmien;
GhiKQ;
END.

Bài 8/1999 - Cân táo

(Dành cho học sinh Tiểu học)

Số lần cân ít nhất là 3. Cách cân như sau:

Lần 1: Chia 27 quả táo thành 3 phần, mỗi phần 9 quả. Đặt 2 phần lên 2 đĩa cân. Nếu cân thăng bằng thì quả táo nhẹ nằm ở phần chưa cân, nếu cân lệch thì quả táo nhẹ nằm ở đĩa cân nhẹ hơn. Sau lần cân thứ nhất, ta chọn ra được 9 quả táo trong đó có quả táo nhẹ.

Lần 2: Chia 9 quả táo, chọn được ra thành 3 phần, mỗi phần 3 quả. Đặt 2 phần lên 2 đĩa cân. Nếu cân thăng bằng thì quả táo nhẹ nằm ở phần chưa cân, nếu cân lệch thì quả táo nhẹ nằm ở đĩa cân nhẹ hơn. Sau lần cân thứ 2, ta chọn ra được 3 quả táo trong đó có quả táo nhẹ.

Lần 3: Lấy 2 trong số 3 quả táo chọn đặt lên 2 đĩa cân. Nếu cân thăng bằng thì quả táo nhẹ là quả táo còn lại, nếu cân lệch thì quả táo nhẹ nằm ở đĩa cân nhẹ hơn. Sau ba lần cân ta chọn ra được quả táo nhẹ.

Bài 9/1999 - Bốc diêm

(Dành cho học sinh Tiểu học)

Nếu số lượng que diêm của mỗi dãy là: 3, 5, 8 thì hai bạn Nga và An bạn nào bốc trước sẽ thắng. Có nhiều cách để người bốc trước sẽ thắng. Giả sử:

- Dãy thứ nhất cso 8 que diêm.

- Dãy thứ hai có 5 que diêm.

- Dãy thứ hai có 3 que diêm.

Nếu Nga là người bốc trước để thắng, Nga sẽ làm như sau:

1. Bốc hết 8 que diêm ở dãy đầu tiên. Như vậy còn 2 dãy tổng cộng 8 que. An sẽ phải bốc một số que ở một trong hai dãy này.

2. Trong trường hợp sau khi An bốc số diêm chỉ còn ở trên một dãy, Nga sẽ bốc tất cả số diêm còn lại và sẽ thắng. Nếu sau khi An bốc mà số diêm vẫn còn ở trên hai dãy thì Nga cũng sẽ phải bốc sao cho đưa An vào thế bất lợi: mỗi dãy trong 2 dãy cuối cùng còn đúng một que diêm. Nếu chưa đưa An được vào thế bất lợi thì phải bốc sao cho mình không phải ở thế bất lợi. Chẳng hạn như:

- An bốc 3 que diêm ở dãy thứ 2. Nga sẽ bốc 1 que ở dãy cuối cùng.

- An bốc 1 que diêm tiếp theo cũng ở dãy đó. Nga cũng sẽ bốc 1 que ở dãy thứ 3.

- An bốc 1 que tiếp theo. Khi đó, Nga bốc que diêm cuối cùng và thắng cuộc.

Các bạn cũng có thể thử cho các trường hợp khác.

Bài 10/1999 - Dãy số nguyên

(Dành cho học sinh THCS)

Dãy đã cho là dãy các số tự nhiên viết liền nhau:

123456789        101112...99         100101102...999          100010011002...9999           10000...

9 x 1 = 9

90 x 2 = 180

900 x 3 = 2700

9000 x 4 = 36000 ...

Ta có nhận xét sau:

- Đoạn thứ 1 có 9 chữ số;

- Đoạn thứ 2 có 180 chữ số;

- Đoạn thứ 3 có 2700 chữ số;

- Đoạn thứ 4 có 36000 chữ số;

- Đoạn thứ 5 có 90000 x 5 = 450000 chữ số ...

Với k = 1000 ta có: k = 9 + 180 + 3.270 + 1.

Do đó, chữ số thứ k là chữ số đầu tiên của số 370, tức là chữ số 3.

Chương trình:

Program Bai10;

Uses crt;

Var k: longInt;

(*--------------------------------------------*)

Function chuso(NN: longInt):char;

Var st:string[10];

       dem,M:longInt;

Begin

  dem:=0;

  M:=1;

  Repeat

     str(M,st);

     dem := dem+length(st);

     inc(M);

  Until dem >= NN;

  chuso := st[length(st) - (dem - NN)]

  (*-------------------------------------*)

  BEGIN

      clrscr;;

      write('Nhap k:');

      Readln(k);

      Writeln('Chu so thu', k,'cua day vo han cac so nguyen khong am');

      write('123456789101112... la:', chu so(k));

      Readln;

END.

Cách giải khác:

var n, Result: LongInt;

procedure ReadInput;

begin

  Write('Ban hay nhap so K: '); Readln(n);

end;

procedure Solution;

var

  i, Sum, Num, Digits: LongInt;

begin

  Sum := 9; Num := 1; Digits := 1;

  while Sum < n do

  begin

    Num := Num * 10; Inc(Digits);

    Inc(Sum, Num * 9 * Digits);

  end;

  Dec(Sum, Num * 9 * Digits); Dec(n, Sum);

  Num := Num + (n - 1) div Digits;

  n := (n - 1) mod Digits + 1;

  for i := 1 to Digits - n do Num := Num div 10;

  Result := Num mod 10;

end;

procedure WriteOutput;

begin

  Writeln('Chu so can tim la: ', Result);

  Readln;

end;

begin

  ReadInput;

  Solution;

  WriteOutput;

end.

Bài 11/1999 - Dãy số Fibonaci  

(Dành cho học sinh THCS)

{$R+}

const

  Inp = 'P11.INP';

  Out = 'P11.OUT';

  Ind = 46;

var

  n: LongInt;

  Fibo: array[1..Ind] of LongInt;

procedure Init;

var

  i: Integer;

begin

  Fibo[1] := 1; Fibo[2] := 1;

  for i := 3 to Ind do Fibo[i] := Fibo[i - 1] + Fibo[i - 2];

end;

procedure Solution;

var

  i: LongInt;

  hfi, hfo: Text;

begin

  Assign(hfi, Inp);

  Reset(hfi);

  Assign(hfo, Out);

  Rewrite(hfo);

  while not Eof(hfi) do

  begin

    Readln(hfi, n);

    Write(hfo, n, ' = ');

    i := Ind; while Fibo[i] > n do Dec(i);

    Write(hfo, Fibo[i]);

    Dec(n, Fibo[i]);

    while n > 0 do

    begin

      Dec(i);

      if n >= Fibo[i] then

      begin

        Write(hfo, ' + ', Fibo[i]);

        Dec(n, Fibo[i]);

      end;

    end;

    Writeln(hfo);

  end;

  Close(hfo);

  Close(hfi);

end;

begin

  Init;

  Solution;

end.

Bài 12/1999 - N-mino

(Dành cho học sinh THPT)

Program Bai12;{Tinh va ve ra tat ca Mino}
Uses Crt;
Const   fn = 'NMINO.INP';
            fg = 'NMINO.OUT';
            max = 16;
Type   bang =    array[0..max+1,0..max+1] of integer;
Var    n : integer;
          lonmin     : integer;
          hinh ,hinh1 ,xet ,dd :    bang;
          hang ,cot: array[1..max] of integer;
          sl : integer;
          qi,qj :    array[1..max*max] of integer;
          sh ,sc    :integer;
          hangthieu , cotthieu:integer;
          slch :    longint;
          f : text;

Procedure Nhap;
Var  f:text;
Begin
  Assign(f,fn); Reset(f);
  Readln(f ,n);
  Close(f);
End;

Procedure Chuanbi;
Begin
  lonmin:= trunc(sqrt(n));
  If n <> sqr(lonmin) then Inc(lonmin);
  slch := 0;
End;

Function min2( a ,b : integer ) : integer;
Begin
  If a < b then min2 := a Else min2 := b;
End;

Procedure Taobien( i ,j : integer );
Var  ii ,jj : integer;
Begin
  FillChar(dd ,SizeOf(dd),1);
  FillChar(xet,SizeOf(xet),1);
  For ii := 1 to i do
    For jj := 1 to j do
      begin
             dd[ii,jj] := 0;
             xet[ii,jj]    :=    0;
      end;
End;

Procedure Ghinhancauhinh;
Var  i ,j :    integer;
Begin
  Inc(slch);
  Writeln(f,sh ,' ' ,sc);
  For i := 1 to sh do
    begin
           For j := 1 to sc do Write(f,(dd[i,j] mod 2):2);
           Writeln(f)
    end;
End;

Procedure Quaytrai;
Var  hinh1 : bang;
        i,j : integer;
Begin
  hinh1:= hinh;
  For i := 1 to sh do
    For j := 1 to sc do hinh[i,j] := hinh1[sc-j+1,i];
End;

Procedure Lathinh;
Var  hinh1 : bang;
        i ,j : integer;
Begin
  hinh1:= hinh;
  For i := 1 to sh do
    For j := 1 to sc do hinh[i,j] := hinh1[sh-i+1,sc-j+1];
End;

Procedure Daohinh;
Var  hinh1 : bang;
        i,j : integer;
Begin
  hinh1 := hinh;
  For i := 1 to sh do
    For j := 1 to sc do hinh[i,j] := hinh1[sh-i+1,j];
End;

Function Bethat : boolean;
Var  ii,jj    :integer;
Begin
  Bethat := false;
  For ii := 1 to sh do
    For jj := 1 to sc do
      If hinh[ii,jj] <> hinh1[ii,jj] then
           begin
                  Bethat:= hinh[ii,jj] < hinh1[ii,jj];
                  exit;
           end;
End;

Function Behon : boolean;
Begin
  Behon := Bethat;
End;

Function Xethinhvuong : boolean;
Begin
  Xethinhvuong :=    false;
  Quaytrai;
  If Behon then exit; Quaytrai;
  If Behon then exit; Quaytrai;
  If Behon then exit; Daohinh;
  If Behon then exit; Quaytrai;
  If Behon then exit; Quaytrai;
  If Behon then exit; Quaytrai;
  If Behon then exit; Xethinhvuong := true;
End;

Function Xetchunhat : boolean;
Begin
  Xetchunhat := false;
  Lathinh;
  If Behon then exit; Daohinh;
  If Behon then exit; Lathinh;
  If Behon then exit; Xetchunhat := true;
End;

Procedure Chuyensang( a : bang;Var b : bang );
Var         i,j:integer;
Begin
For i := 1 to sh do
  For j := 1 to sc do b[i,j] := a[i,j] mod 2;
End;

Procedure Thughinhancauhinh;
Begin
  Chuyensang(dd ,hinh);
  hinh1:=    hinh;
  If sh = sc then   begin   If not Xethinhvuong then exit;  end
     Else If not Xetchunhat then exit;
  Ghinhancauhinh;
End;

Procedure Xetthem( i ,j : integer );
Begin
  Inc(xet[i,j]);
  If xet[i,j] = 1 then
     begin
            Inc(sl);
            qi[sl] := i;
            qj[sl] := j
     end;
End;

Procedure Xetbot( i ,j : integer );
Begin
  If xet[i,j] = 1 then Dec(sl);
  Dec( xet[i,j] );
End;

Procedure Themdiem( ii : integer );
Var  i ,j : integer;
Begin
  i := qi[ii];
  j := qj[ii];
  dd[i,j] := 1;
  If dd[i,j-1] = 0 then Xetthem(i ,j-1);
  If dd[i,j+1] = 0 then Xetthem(i ,j+1);
  If dd[i-1,j] = 0 then Xetthem(i-1,j);
  If dd[i+1,j] = 0 then Xetthem(i+1,j);
End;

Procedure Bodiem( ii : integer );
Var  i , j    : integer;
Begin
  i := qi[ii];
  j := qj[ii];
  dd[i,j] := 0;
  If dd[i,j-1] = 0 then Xetbot(i,j-1);
  If dd[i,j+1] = 0 then Xetbot(i,j+1);
  If dd[i-1,j] = 0 then Xetbot(i-1,j);
  If dd[i+1,j] = 0 then Xetbot(i+1,j);
End;

Procedure Xethangcot( ii : integer );
Var  i ,j    :integer;
Begin
  i := qi[ii];
  j := qj[ii];
  Inc(hang[i]);
  If hang[i] = 1 then Dec(hangthieu);
  Inc(cot[j]);
  If cot[j] = 1 then Dec(cotthieu);
End;

Procedure Xetlaihangcot( ii : integer );
Var  i,j :    integer;
Begin
  i := qi[ii];
  j := qj[ii];
  If hang[i] = 1 then Inc(hangthieu);
  Dec(hang[i]);
  If cot[j] = 1 then Inc(cotthieu);
  Dec(cot[j]);
End;

Procedure Duyet( i : integer;last : integer );
Var  ii :integer;
Begin
If i > n then
   begin  thughinhancauhinh;  exit; end;
For ii := last + 1 to sl do
   begin
          themdiem(ii);
          xethangcot(ii);
          If hangthieu + cotthieu <= n - i then duyet(i+1,ii);
          Xetlaihangcot(ii);
          bodiem(ii);
   end;
End;

Procedure Duyetcauhinh( i ,j : integer );
Var  jj :    integer;
Begin
  sh := i;
  sc := j;
  FillChar(hang ,SizeOf(hang),0);
  FillChar(cot,SizeOf(cot),0);
  hangthieu := sh;
  cotthieu := sc;
  taobien(i ,j);
  For jj := 1 to j do
     begin
            sl:= 1;
            qi[1] := 1;
            qj[1] := jj;
            duyet(1,0);
            dd[1,jj] := 2;
     end;
End;

Procedure Duyethinhbao;
Var  i ,j :  integer;
       minj ,maxj :  integer;
Begin
For i := lonmin to n do
   begin
          minj := (n-1) div i + 1;
          maxj := min2(n+1-i,i);
          For j := minj to maxj do duyetcauhinh(i,j);
   end;
End;

Procedure Ghicuoi;
Var f : file of char;
       s : string;
       i : integer;
Begin
  str(slch,s);
  Assign(f,fg); reset(f);
  Seek(f,0);
  For i := 1 to length(s) do  Write(f,s[i]);
  Close(f);
End;

BEGIN
  Clrscr;
  Assign(f,fg); Rewrite(f);
  Writeln(f ,' ');
  Nhap;
  Chuanbi;
  duyethinhbao;
  Close(f);
  ghicuoi;
END.