Correction de bac pratique 2008 (sciences)

[administrateur]

Message envoyé dans contacts le 2009-04-07 par Asmar:

svp correction de bac pratique 2008 des sc

Recherche des sujets en cours, et en attendant, Merci de proposer une réponse à Asma.

[sweetyroura]

moi o6 g besoin de kelke correction,je passeré mn examen le mercredi!!!i need ur help!!

[kiteb]

une proposition de correction:
Bac pratique 2008-22 mai 2008 14h

Code: Tout sélectionner

program somme;
uses wincrt;
type    tab=array[1..30]of integer;
var     t:tab;      n,p,init:integer;
procedure remplir(var t:tab;var  n:integer);
var i:integer;
begin
randomize;
repeat
write('Donner la taille du tableau(entre 5 et 30):');
readln(n);
until n in[5..30];
for i:=1 to n do
    t[i]:=random(999)+1;
end;
function verif(t:tab; n:integer;p:integer):integer;
var     i,s,init:integer;
begin
i:=p;  s:=0;
   repeat
        i:=i+1;   s:=s+t[i];
   until (i=1) or (s>=t[p])  ;
if s=t[p] then    verif:=i
              else  verif:=p; 
end;
procedure affiche( t:tab;init:integer;final:integer);
var i :integer;
begin
if (init=final+1) then writeln('Condition non vérifiée')
                   else    for i:=init to final do
                              write(t[i],', ');
end;
begin
remplir(t,n);
writeln('Donner l''indice p à vérifier :') ;  readln(p) ;
init:=verif(t,n,p);
affiche(t,init,p-1)
end.


[kiteb]

proposition de correction:
Bac pratique 2008-22 mai 2008 15h30

Code: Tout sélectionner

               
program chaines;
uses wincrt;
type tab=array[1..30] of string;
var ch:string;  t:tab;  n, i:integer;
procedure remplir(var t:tab;var n:integer);
var  i:integer;
begin
   repeat
        writeln('Donner le nombre des chaines: ');           
        readln(n);
   until n in [5..30];           {valeur entre 5 et 30}

           for i:=1 to n do   
      begin
   writeln('Donner la chaine n°',i); readln(t[i]);
       end;
end;
procedure efface(var ch:string);
  var i:integer;
  begin
  i:=0;
repeat
i:=i+1;
    repeat
    if not(upcase(ch[i]) in['A'..'Z']) then delete(ch,i,1);
     until (upcase(ch[i]) in ['A'..'Z']) or ( i>length(ch));
until i>=length(ch);
end;
procedure afficher( t:tab;n:integer);
var i:integer;
begin
        for i:=1 to n do
   if length(t[i])<> 0 then writeln(i,' ',t[i]);
end;
begin
remplir(t,n);
for i:=1 to n do   efface(t[i]);
afficher(t,n);
end.

Remarque: sur le turbo pascal utiliser une taille de tableau <=29 pour que le programme fonctionne(pour ne pas saturer la mémoire) donc utiliser "type tab=array[1..29] of string;" au lieu de "type tab=array[1..30] of string;", aussi n'oublier pas de changer le contrôle de saisie en changeant 30 par 29.

[kiteb]

Proposition de correction:
Bac pratique 2008-22 mai 2008 9h

Code: Tout sélectionner

program divisible;
uses wincrt;                 {longint pour que n puisse }
var   n:longint;            {prendre des grandes valeurs}     
procedure saisir(var n:longint);
begin
   repeat
       writeln('Donner un entier > 9 : ');
       readln(n);
   until n>9;
end;
function somme(a,b:integer):integer;
var s:integer;
begin   
   s:=a+b;
          repeat
        if s>=9 then s:=s-9;
              until s<9;
    somme:=s;
end;
function verif(nombre:longint):integer;
var  ch:string;u,d,e,i,l:integer;
begin
str(nombre,ch);
val(ch[1],u,e);
l:=length(ch);
   for i:=2 to l do
      begin
      val(ch[i],d,e);
      u:=somme(u,d);
      end;
verif:=u;
end;
begin
saisir(n);
if verif(n)=0 then writeln(n,' est divisible par 9')
             else
             writeln(n,' n''est pas divisible par 9');
end.

[kiteb]

Bon travail et bonne chance

[kiteb]

23 mai 2008-10h30 - bac pratique informatique
proposition de correction:

Code: Tout sélectionner

program cartes_CIN;
uses wincrt;
const taille=20;
type tab=array[1..taille]of string;
var
t:tab;
n:integer;

function existe(t:tab;n:integer;ind:integer):boolean ;
var
cin:string[8];
j:integer;
trouve:boolean;

begin
trouve:=false;
cin:=t[ind];
j:=1;
repeat

if t[j]=cin then trouve:=true
else j:=j+1

until (j=ind) or (trouve=true);

existe:=trouve;
end;





procedure remplir(var t:tab;var n:integer);
var
i:integer;
begin
writeln('Donner le nombre de cartes: ');
readln(n);

   repeat
   writeln('Donner le n° de la CIN  n° 1');
        readln(t[1]);
   until length(t[1]) = 8;

for i:=2 to n do
       repeat
           writeln('Donner le n° de la CIN  n° ',i);
           readln(t[i]);       

       until (length(t[i])=8) and (existe(t,n,i)=false)

end;

procedure afficher(t:tab;n:integer);
var i:integer;
begin
for i:=1 to n do
writeln('La CIN n° ', i ,' est ',t[i]);
end;


begin
remplir (t,n);
afficher(t,n);
end.

bon travail et bonne chance