Bài 91/2002 - Các số lặp (Dành cho học sinh THCS 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 + 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 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) 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 Dispose(A[i]); End; DeThiMau.vn 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 Nguyễn Toàn Thắng *) Bài giải bạn Nguyễn Tồn Thắng dùng thuật tốn lùa bò vào chuồng Sau 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 tốn dùng mảng đánh đấu có nghĩa số x Lap[x] số lần xuất số x mảng Vì số phần tử mảng nhỏ 106 nên phần tử mảng Lap phải kiểu liệu để lưu trữ 106 Số x số nguyên kiểu integer giới hạn nhớ 64K nên ta dùng ba mảng động sau: MG = array[-maxint maxint] of byte; L[1 3] of ^MG; Xử lý hệ 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 fo coso type var mg ='input.txt'; ='output.txt'; =100; =array[-maxint maxint]of byte; 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 if random(2)=1 then write(f,random(maxint),#32) DeThiMau.vn else write(f,-random(maxint),#32); close(f); end; procedure danhdau(x:integer); var i :integer; begin for i:=3 downto if L[i]^[x]lap then begin lap:=L[1]^[k]*sqr(coso)+L[2]^[k]*coso+L[3]^[k]; kq:=k; end; for k:=1 to dispose(L[k]); end; DeThiMau.vn 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 DeThiMau.vn ... giải Nguyễn Toàn Thắng *) Bài giải bạn Nguyễn Tồn Thắng dùng thuật tốn lùa bị vào chuồng Sau 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 dùng mảng đánh đấu có... assign(f,fi); rewrite(f); writeln(f,n); for k:=1 to N if random(2)=1 then write(f,random(maxint),#32) DeThiMau.vn else write(f,-random(maxint),#32); close(f); end; procedure danhdau(x:integer); var i... begin lap:=L[1]^[k]*sqr(coso)+L[2]^[k]*coso+L[3]^[k]; kq:=k; end; for k:=1 to dispose(L[k]); end; DeThiMau.vn procedure ghif; var f :text; begin assign(f,fo); rewrite(f); write(f,kq); writeln('So