Bài 91/2002 - Các số lặp
(Dành cho học sinh THCS và THPT)
Program bai91;
{Thuat toan lua bo vao chuong}
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
USES crt;
CONST M1 = MaxInt div 4 + 1;
M2 = MaxInt;
fi = 'Bai91.Inp';
TYPE MA = Array[0..M1] of LongInt;
Var A: Array[0..3] of ^MA;
d,l :LongInt;
Procedure Init;
Var i:Byte;
Begin
For i:=0 to 3 do
begin
New(A[i]);
Fillchar(A[i]^,sizeof(A[i]^),0);
end;
End;
Procedure ReadF(k:ShortInt);
Var f:Text;
x:LongInt;
i,j:Integer;
Init;
Assign(f,fi);
Reset(f);
While Not SeekEof(f) do
begin
Read(f,x);
x:=x*k;
If x>=0 then
begin
i:=x div M1;
j:=x mod M1;
If i=4 then begin i:=3; j:=M1; end;
Inc(A[i]^[j]);
If A[i]^[j]>d then begin d:=A[i]^[j]; l:=x*k; end;
end;
end;
Close(f);
For i:=0 to 3 do Dispose(A[i]);
End;
BEGIN
Clrscr;
d:=0; l:=0;
ReadF(-1);
ReadF(1);
Writeln('So lap nhieu nhat la: ',l,#10#13,'Voi so lan lap : ',d);
Readln;
END.
Bài giải của bạn Nguyễn Toàn Thắng dùng thuật toán lùa bò vào chuồng. Sau đây là cách giải khác dùng
thuật toán đếm số lần lặp.
Thuật toán: Tư tưởng thuật toán là dùng mảng đánh đấu có nghĩa là số x thì Lap[x] sẽ là số lần xuất hiện của
số x trong mảng. Vì số phần tử của mảng nhỏ hơn hoặc bằng 10
6 nên phần tử của mảng Lap phải là kiểu dữ
liệu để có thể lưu trữ được 10
6. Số x là số nguyên kiểu integer và do giới hạn bộ nhớ là 64K nên ta dùng ba
mảng động như sau: MG = array[-maxint..maxint] of byte;
L[1..3] of ^MG;
Xử lý trong hệ cơ số 100.
Chương trình.
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+,Y+}
program bai91;{Đỗ Đức Đông}
uses crt;
const fi ='input.txt';
fo ='output.txt';
coso =100;
type mg =array[-maxint..maxint]of byte;
var L :array[1..3]of ^mg;
n,lap :longint;
kq :integer;
time :longint;
clock :longint absolute $00:$0046c;
procedure tao_test;
var f :text;
k :longint;
begin
n:=1000000;
assign(f,fi);
rewrite(f);
writeln(f,n);
for k:=1 to N do
if random(2)=1 then write(f,random(maxint),#32)
else write(f,-random(maxint),#32);
close(f);
end;
procedure danhdau(x:integer);
var i :integer;
for i:=3 downto 1 do
if L[i]^[x]<coso then
inc(L[i]^[x]);
break;
end
else L[i]^[x]:=0;
procedure lam;
x :integer;
for k:=1 to 3 do
new(L[k]);
fillchar(L[k]^,sizeof(L[k]^),0);
assign(f,fi);
reset(f);
read(f,n);
for k:=1 to n do
read(f,x);
danhdau(x);
close(f);
lap:=0;
for k:=-maxint to maxint do
if L[1]^[k]*sqr(coso)+L[2]^[k]*coso+L[3]^[k]>lap then
begin
lap:=L[1]^[k]*sqr(coso)+L[2]^[k]*coso+L[3]^[k];
kq:=k;
end;
for k:=1 to 3 do dispose(L[k]);
procedure ghif;
var f :text;
assign(f,fo);
rewrite(f);
write(f,kq);
writeln('So lan lap :',lap);
{tao_test;}
time:=clock;
lam;
ghif;
writeln((clock-time)/18.2:10:10);
Bạn đang xem bài 91/ - 100 DE TIN HSG CO DAP AN
