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;
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;
k:=i div 8;
i:=i mod 8;
Laybit:=(a[k] shr (7-i)) and 1;
PROCEDURE Tatbit(i:word);
a[k]:=a[k] and (not (1 shl (7-i)));
FUNCTION Tim(j:word):word;
While (laybit(j+1)=0) do
begin
If j=max-1 then j:=0
else inc(j);
end;
Tim:=j+1;
PROCEDURE Xuly;
Var j,dem,i :word;
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);
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;
Xuly;
(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)
Bạn đang xem bài 47/ - 100 DE TIN HSG CO DAP AN