Page 157 - C:\Users\Admin\Desktop\Sach mem upweb\

100 Problems & Solutions Trang 157

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]);

Tin học & Nhà trường 100 Đề Toán - Tin học