correction Examen du baccalaureat, session de juin 2010, science de l'informatique le 27 mai 2010 à 8h30

program min_max;
uses wincrt;
type
fich = file of byte;
var
f:fich;
n:byte;
pn,gn:string;

(*la defintion de la procedure remplir*)
procedure remplir(var f:fich; var n:byte);
var
i,x:byte;
begin
repeat
write('donner n:');
readln(n);
until(n>2)and(n<=50);
rewrite(f);
for i:= 1 to n do
begin
x := random(9) + 1;
writeln(x);
write(f,x);
end;
close(f);
end;

(*la defintion de la procedure construction_nombre*)
procedure nombres(var f:fich;n:byte; var pn,gn:string);
var
x,k,j,i:byte;
c:string;
begin
reset(f);
read(f,x);
str(x,c);
pn := c;
gn := c;

for i:= 2 to n do
begin
read(f,x);
str(x,c);
j := 1; k:=1;
while(c < gn[j])and( j <= length(gn) )do
begin
j := j + 1;
end;

insert(c,gn,j);

while (c > pn[k]) and (k <= length(pn) ) do
begin
k := k +1;
end;

insert(c,pn,k);

end;
writeln('le plus grand nombre:',gn);
writeln('le plus petit nombre:',pn);

close(f);
end;

(*la defintion de la procedure verif*)
procedure verif(gn:string);
var
i,j,k,ci,cj:byte;
r,r1,av,nv:integer;
er:integer;

begin
i := 1;
j := length(gn);
val(gn[i],ci,er);
val(gn[j],cj,er);
av := ci - cj;

i := i + 1;
j := j - 1;
val(gn[i],ci,er);
val(gn[j],cj,er);
nv := ci - cj;
r := nv - av;
r1 := r;
k := length(gn);

while( i < k div 2 )and(i+j = k+1) and (r1 = r) do
begin

av := nv;
i := i + 1;
j := j - 1;
val(gn[i],ci,er);
val(gn[j],cj,er);
nv := ci - cj;
r1 := nv - av;
end;

if (r1 = r)then
writeln('la suite est arithmétique, son raison = ', r)
else
writeln('cette suite n''est pas arithmétique.');
end;

(*Le programme principal*)
begin
assign(f , 'c:\bac2010\123456\nombres.dat');
randomize;
remplir(f,n);
nombres(f,n,pn,gn);
verif(gn);
end.