Giải đề thi tin họ trẻ không chuyên tỉnh Bình Định -2006

GIẢI ĐỀ THI TIN HỌC TRẺ KHÔNG CHUYÊN TỈNH BÌNH ĐịNH
NĂM 2006
(Giải theo yêu cầu của đề Tỉnh Bình Định - Nguyễn Thị Hoa)
Bài 1. (Giải cho nhiều bộ Input, còn đề thi chỉ minh họa cho một Input)
BAI1.INP BAI1.OUT
6
7
5
6
1
3
4
**********************
5
3
5
6
4
2
**********************
8
7
6
4
5
8
2
1
9
*********************
2

**********************
1
**********************
3
**********************
Program Bai12006;
Const max = 1000;
fi = 'C:\BAI1.INP';
fo = 'C:\BAI1.OUT';
Type Mang1 = array[1..max] of integer;
Var a : Mang1;
i,n,maso : integer;
sao : string[40];
f1,f2 : text;
Procedure Nhap;
Begin
readln(f1,n);
for i:=1 to n do readln(f1,a[i]);
readln(f1,sao);
end;
Procedure Xuli; {dung thuat toan sap xep nhanh - QuickSort}
Procedure sort(l,r:integer);
Var i,j,x,tg:integer;
Begin
i:=l;j:=r;
x:=a[(l+r) div 2];
repeat
while a[i]<x do i:=i+1;
while a[j]>x do j:=j-1;
if i <= j then begin tg:=a[i];a[i]:=a[j];a[j]:=tg;i:=i+1;j:=j-1;end;

until i>j;
if l<j then sort(l,j);
if i<r then sort(i,r);
End;
Begin {sap xep tang dan}
sort(1,N);
maso :=1;
{tim ma nho nhat}
for i:=1 to n-1 do
if a[i+1]-a[i] >=2 then
begin maso:= a[i]+1;write(maso);break;end;
End;
Procedure Xuat;
Begin
writeln(f2,maso);
writeln(f2,sao);
End;
BEGIN
assign(f1,fi); reset(f1);
assign(f2,fo);rewrite(f2);
while Not(EOF(f1)) do
Begin
Nhap;Xuli;Xuat;
End;
close(f1);close(f2);
END.
Bài 2. (Giải cho nhiều bộ Input, còn đề thi chỉ minh họa cho một Input)
BAI2.INP BAI2.OUT
29 4
3 5 7 11

**********************
(Tu cho them vai
Output khac)
5
2 1 1 1
**********************
Program Bai22006;(Thu giai cach khac hay hon}
Const fi='C:\Bai2.inp';
fo='C:\Bai2.out';
Var a,b:array[1..1000] of byte;
m1, s,conlai,m,n,i,j:integer;
f1,f2:text;
sao:string;
Procedure Nhap;
Begin
readln(f1,m,n);
for i:=1 to n do read(f1,a[i]);
readln(f1);
readln(f1,sao);
End;
Procedure Xuli;
begin
{fillchar(b,sizeof(b),1);}
s:=0; m1:=0;
for i:=1 to n do
begin
m1:= m1 + a[i]*b[i];
if m=m1 then s:=s+b[i]
else
begin

conlai:=m - m1;
for j:=1 to n do
if conlai=a[j] then
begin
b[j]:=b[j]+1; break;
end;
s:=s+b[j];
end;
end;
End;
Procedure Xuat;
Begin
writeln(f2,s);
for i:=1 to n do write(f2,b[i],' ');
writeln(f2);
writeln(f2,sao);
End;
BEGIN
assign(f1,fi);reset(f1);
assign(f2,fo);rewrite(f2);
while Not(eof(f1)) do
Begin
NHAP;
XULI;
XUAT;
End;
close(f1);close(f2);
END.
--------------------------------------------