Đề thi Toán - Tin trong nhà trường Bài 91

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;
Begin
 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.
(Lời giải của Nguyễn Toàn Thắng *)
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 106 nên phần tử của mảng Lap phải là kiểu dữ liệu để có thể lưu trữ được 106. 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+}
{$M 16384,0,655360}
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;
 begin
 for i:=3 downto 1 do
 if L[i]^[x]<coso then
 begin
 inc(L[i]^[x]);
 break;
 end
 else L[i]^[x]:=0;
 end;
procedure lam;
var f :text;
 k :longint;
 x :integer;
 begin
 for k:=1 to 3 do
 begin
 new(L[k]);
 fillchar(L[k]^,sizeof(L[k]^),0);
 end;
 assign(f,fi);
 reset(f);
 read(f,n);
 for k:=1 to n do
 begin
 read(f,x);
 danhdau(x);
 end;
 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]);
 end;
procedure ghif;
var f :text;
 begin
 assign(f,fo);
 rewrite(f);
 write(f,kq);
 writeln('So lan lap :',lap);
 close(f);
 end;
BEGIN
 {tao_test;}
 time:=clock;
 lam;
 ghif;
 writeln((clock-time)/18.2:10:10);
END.