Correction Epreuve Bac pratique (9h)

uses wincrt;
var n,i:longint;
f:text;


{***** Procedure saisie : La saisie d'un entier n entre 40000 et 100000 *******

Procedure saisie(var n:longint);
begin
repeat
writeln('Donner un entier n entre 40000 et 100000 :');
readln(n);
until (n>40000) and (n<100000);
end;


{***** Procedure creer : La creation du fichier text super_p.txt *******

Procedure creer(var f:text);
begin
assign(f,'c:\docume~1\user\Mesdoc~1\Documents\EXAMS BAC INFO\ALGO\super_p.txt');
rewrite(f);
end;




{***** Fonction premier : Déterminer si un entier n donné est premier ou non *******

Function premier(n:longint):boolean;
var i:longint;
begin
premier:=true;
for i:=2 to n div 2 do
begin
if (n mod i)=0 then
premier:=false;
end;
end;



{***** Fonction sup_pre : Déterminer si un entier n donné est super premier ou non *******

Function sup_pre(n:longint):boolean;
begin
sup_pre:=true;
if not premier(n) then
sup_pre:=false
else if not premier(n div 10) then
sup_pre:=false
else if not premier(n div 100) then
sup_pre:=false
else if not premier(n div 1000) then
sup_pre:=false
else if not premier(n div 10000) then
sup_pre:=false;
end;



{***** Procedure remplir : Remplir le fichier super_p.txt par les nombres super premier puis les afficher *******

Procedure remplir(var f:text;n:longint);
var i:longint;
ch:string;
Begin
creer(f);
for i:=1 to n do
begin
if sup_pre(i) then
begin
str(i,ch);
ch:=ch+' super premier';
writeln(ch);
writeln(f,ch);
end;
end;
close(f);
end;


{***** Programme Principale *******

Begin
saisie(n);
remplir(f,n);
End.

{*****borjlouzir.1fr1.net*******

iiiiiiiiiiiiiiiiilyéééééééééééééééééééééééééééééééééééé hamdoullah le maximum mon travail est juste ilyyééééééééééééééééééé

j'ai travailler avec la recursivité ,je ponse que c'est plus claire en utilisant copy

Salut !
Heureusement les sujets étaient à la portée ! Même le bâreme est souple : Compilation -3, Structure de données ( déclaration de n et F) - 3 points , Décomposition - 4 points - c.a.d 10 points pour le minimum de travail.
Certains élèves ont fait une petite faute dans le remplissage de fichier et dans l'affichage. Selon l'énoncé il faut afficher tous les entiers premiers et signaler les nombres super premiers comme suit :
2super premier
3super premier
5super premier
7super premier
11super premier
13super premier
17super premier
19super premier
23super premier
29super premier
31super premier
37super premier
41
43
47
53super premier
59super premier
61
67
71super premier
73super premier
79super premier
83
89
97
101
103
107
109
113super premier
127
131super premier
....
Mais les élèves ont mal compris et ont rempli le fichier seulement par les nombres super premier. C'est une petite faute. Bonne révision pour la partie théorique
.

program bac8h30;
uses wincrt;
var n:longint;
f:text;
procedure saisie(var n:longint);
begin
repeat
write('Donner n ');
readln(n);
until (n>40000) and (n<100000);
end;

function premier(x:longint):boolean;
var test:boolean;
j:longint;
begin
test:=true;
for j:=2 to x div 2 do
if x mod j =0 then
test:=false;

premier:=test;
end;

function super(x:longint):boolean;
var verif:boolean;
r:longint;
begin
verif:=true;
repeat
r:=x div 10;
if premier(r) then
verif:=true
else
verif:=false;
x:=r;
until not(verif) or (x=0);
super:=verif;
end;

procedure affiche(var f:text;n:longint);
var i:longint;
chi:string;
begin
rewrite(f);
for i:=2 to n do
begin
if premier(i) then
if super(i) then
begin
writeln(i,' super premier ') ;
str(i,chi);
writeln(f,chi+'super premier ');
end
else
begin
writeln(i);
str(i,chi);
writeln(f,chi);
end;
end;
close(f);
end;

begin
assign(f,'c:\bac2009\super_p.txt');
saisie(n);
affiche(f,n);
end.

program minmax;
uses wincrt;
var u:integer;
f:text;
procedure saisie(var u:integer);
begin
repeat
write('Donner U0 ');
readln(u);
until (u>=1000) and (u<=9999);
end;
function max(u:integer):integer;
var test:boolean;
chu:string;
i,e:integer;
c:char;
begin
str(u,chu);
repeat
test:=true;
for i:=1 to length(chu)-1 do
if chu[i]<chu[i+1] then
begin
c:=chu[i];
chu[i]:=chu[i+1];
chu[i+1]:=c;
test:=false;
end;
until test;
val(chu,u,e);
max:=u;
end;
function min(u:integer):integer;
var test:boolean;
chu:string;
i,e:integer;
c:char;
begin
str(u,chu);
repeat
test:=true;
for i:=1 to length(chu)-1 do
if chu[i]>chu[i+1] then
begin
c:=chu[i];
chu[i]:=chu[i+1];
chu[i+1]:=c;
test:=false;
end;
until test;
val(chu,u,e);
min:=u;
end;
procedure calcul(var f:text;n:integer);
var u1:integer;
begin
rewrite(f);
repeat
writeln(f,u);
writeln(u);
u1:=u;
u:=max(u)-min(u);
until u1=u;
close(f);
end;

begin
assign(f,'c:\bac2009\444444\suite.txt');
saisie(u);
calcul(f,u);
end.

Salut Ilyes !!!
Oui, c'est normal de trouver 4203 nombres premiers inférieurs à 40001 parmi lesquels on trouve 93 nombres super premiers, car en faisant le calcul on obtient 26 nombres premiers inferieur à 100 ce qui fait 169 nombres premiers inferieurs à 1000. Donc c'est tout a fait logique d'obtenir 4203 nombres premiers inferieur à 40001.
http://nombrespremiersliste.free.fr/
J'espere que vous êtes convaincu.
Pour ce qui concerne les notes c'est strictement interdit de les savoir avant le jour des résultat du BAC. Mais si vous voulez connaître à peut près votre note postez-moi votre solution et je calculerai votre note +/- méchanceté ou gentillesse du correcteur . Normalement, vous connaissez Pascal sur 20, mais toujours il y a le stress du BAC. Note de pratique à le coefficient 0.75. La partie la plus imprtante vous attend encore. Je crois en vous. Battez votre stress et Inchalla que des bonnes notes. Bonne révision.