Bac pratique 4ème scientifiques
Enoncé Bac pratique 2014 - sujets 26 mai 2014-8h
Soit T un tableau contenant des entiers distincts de l'intervalle [1,99]. Pour trier dans l'ordre croissant les éléments du tableau T, On propose la méthode suivante: -Placer chaque élément T[i] dans la case d'indice T[i] d'un tableau intermédiaire TI, sachant que les éléments du tableau TI sont initialisés à zéro. -Placer dans l'ordre tous les entiers différents de zéro du tableau TI , dans le tableau T. Exemple:
Après application du principe de tri décrit précédemment, on obtient le tableau intermédière TI ci dessous:
et on aura le tableau T trié suivant
Ecrire un programme Pascal qui permet de :
|
program sujet26mai2014_8h; uses wincrt; var n,m:integer; procedure saisir(var n,m:integer); begin repeat write('n=');readln(n); until n >=100; repeat write('m=');readln(m); until m >n; end; function harshad( n : integer): boolean; var c,d,u,s: integer; begin c:=n div 100; d:=(n mod 100) div 10; u:=n mod 10; s:=c+d+u; if n mod s =0 then harshad:=true else harshad:=false; end; |
function premier(n:integer):boolean; var nb,i:integer; begin nb:=0; for i:=1 to n do if n mod i=0 then nb:=nb+1; if nb=2 then premier:=true else premier:=false; end; procedure afficher(n,m:integer); var i:integer; begin for i:=n to m do if harshad(i) and premier(i-1) then writeln(i, ' car ',i ,' est Harshad et son prédécesseur ', i-1 ,' est un nombre premier'); end; begin saisir(n,m); afficher(n,m); end. |
Remarque: On peut utiliser une autre méthode pour la vérification si le nombre est harshad en utilisant les chaines de caractères pour n'importe quel entier
function harshad2( n : integer): boolean; var d,s,i,e: integer; ch:string; begin str(n,ch); s:=0; for i:=1 to length(ch) do begin val(ch[i],d,e); s:=s+d; end; if n mod s =0 then harshad2:=true else harshad2:=false; end; |
program sujet26mai2014_9h; uses wincrt; type tab=array[1..100]of integer; var nb,n:integer; t:tab;
procedure saisir(var nb:integer); begin repeat write('nb=');readln(nb); until (nb >=4) and (nb mod 2=0); end;
function premier(n:integer):boolean; var nb,i:integer; begin nb:=0; for i:=1 to n do if n mod i=0 then nb:=nb+1; if nb=2 then premier:=true else premier:=false; end; |
procedure remplir (var t:tab; var n:integer; nb:integer); var i:integer; begin n:=0; for i:=1 to nb do if premier(i) then begin n:=n+1; t[n]:=i; end; end; procedure afficher(t:tab;n:integer); var i:integer; begin for i:=1 to n do writeln(t[i]); end; procedure afficher_couples(t:tab;n,nb:integer); var i,j:integer; begin writeln('Les couples des nombres premiers que leurs somme =', nb); for i:=1 to n do for j:=1 to n do if t[i]+t[j]=nb then writeln(' ( ', T[i], ' , ', T[j], ' )' ); end;
begin saisir(nb); remplir(t,n,nb); { afficher(t,n); } afficher_couples(t,n,nb); end. |
program sujet26mai2014_11h; uses wincrt; type TAB=array[1..30]of integer; var n:integer; t:tab; procedure saisir(var n:integer); begin repeat write('Donner la taille du tableau T n (dans [5..30])=');readln(n); until n in[5..30]; end; function existe(x:integer; t:tab; i:integer):boolean; var j:integer; trouve:boolean; begin trouve:=false; j:=0; repeat j:=j+1; if t[j]=x then trouve:=true; until (j=i-1) or (trouve) ; existe:=trouve; end; procedure remplir(var t:tab;n:integer); var i:integer; begin repeat write('T[1]=');readln(t[1]); until (t[1] in[1..99]); for i:=2 to n do repeat write('T[',i,']=');readln(t[i]); until (t[i] in[1..99]) and (existe(t[i],T,i)=false); end; |
procedure trier (var t:tab;n:integer); var TI:array[1..99]of integer; i,j:integer; begin for i:=1 to 99 do TI[i]:=0; for i:=1 to n do TI[ T[i] ]:=T[i]; j:=0; for i:=1 to 99 do if TI[i]<>0 then begin j:=j+1; t[j]:=TI[i]; end; end; procedure afficher(t:tab;n:integer); var i:integer; begin for i:=1 to n do writeln('T[', i,']= ',t[i]); end;
begin saisir(n); remplir(t,n); trier(t,n); writeln('Le tableau après le tri : '); afficher(t,n); end. |
program sujet26mai_14h; uses wincrt; type TAB=array[1..25]of integer; var nombre,TA,TD : tab; n,n1,n2:integer; procedure saisir(var n:integer); begin repeat write('n='); readln(n); until n in [5..25]; end; procedure remplir( var nombre:tab; n : integer); var i:integer; begin for i:=1 to n do repeat write('nombre[',i,']=');readln(nombre[i]); until nombre[i]>0 ; end; function somme_diviseurs(x:integer):integer; var s,i:integer; begin s:=0; for i:=1 to x-1 do if x mod i=0 then s:=s+i;
somme_diviseurs:=s; end;
|
procedure transferer(t:tab; n:integer; var TD:tab; var n1:integer; var TA:tab;var n2:integer); var i:integer; begin n1:=0; n2:=0; for i:=1 to n do begin if somme_diviseurs(t[i]) > T[i] then begin n1:=n1+1; TD[n1]:=t[i]; end; if somme_diviseurs(t[i]) < T[i] then begin n2:=n2+1; TA[n2]:=t[i]; end; end; end; procedure afficher(t:tab;n:integer); var i:integer; begin for i:=1 to n do writeln('l''élément n° ',i , ' est ',t[i]); end;
begin saisir(n); remplir(nombre,n); transferer(nombre,n,TD,n1,TA,n2); writeln('Les nombres déficients:'); afficher(TD,n1); writeln('Les nombres abondants: '); afficher(TA,n2); end. |