Đề thi Toán - Tin học trong nhà trường (Bài 47)

Bài 47/2000 - 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.
(Lời giải của bạn: Nguyễn Việt Bằng - Lớp 10 Tin - Phổ thông Năng Khiếu - ĐHQG.TPHCM)