Exercice Corrigé Pascal [PDF]

Zitiervorschau

Application 1 {Permutation de 2 variables} Program permutation; uses wincrt; var a,b,c : integer; {***********************************} procedure permut2(var a,b : integer); begin {Permutation sans avoir recour à une troisième variable} a:=a+b; b:=a-b; a:=a-b; end; {***********************************} begin write('Donner a : '); readln(a); write('Donner b : '); readln(b); c:=a; a:=b; b:=c; writeln('La nouvelle valeur de a est : ',a); write('La nouvelle valeur de b est : ',b); end.

Index Application 2 Program calcul_aire; uses wincrt; Const pi=3.14; var r,c,s_hachuree,s_triangle,s_cercle : real; begin write ('donner le rayon du cercle : '); read(r); write ('donner le côté du triangle : '); read(c); s_cercle := pi * SQR(r);

s_triangle := SQRT(3) / 4 * SQR(c); s_hachuree := s_cercle - s_triangle /3; write('l''aire de la surface hachurée est : ',s_hachuree:4:2); end. Index Application 3 {CH1 Ex12 page 23 - 4Sc 07 - 08} {Changer la casse des caractères d'une chaine} {conversion d'un caractère miniscul en majuscul} program min_maj; uses wincrt; var ch, maj : string; i : integer; begin writeln('Donner une chaine :'); readln(ch); maj:=''; for i:=1 to length(ch) do if ch[i] in ['a'..'z'] then maj:= maj + Chr(Ord(ch[i])-32) else maj:= maj + ch[i]; write('Aprés changement de la casse : ',maj); end.

Index Application 4 {4 Sc Rappel Type énuméré et vecteur - Paye de la semaine} {calcul de la paye d'un ouvrier et création d'un type énuméré jours} {création d'un type interval jours_de_travail} program paye_semaine; uses wincrt; Type jours = (dimanche, lundi, mardi, mercredi, jeudi, vendredi, samedi); jours_de_travail = lundi..vendredi; t_horaire_semaine = array[jours_de_travail] of integer; var t : t_horaire_semaine; j : jours_de_travail;

total :integer; ps,thp :real; begin for j:= lundi to vendredi do begin writeln('Entrez le nombre d''heure du jour ',ord(j),' : '); readln(t[j]); total:= t[j] + total; end; writeLN('Précisez la valeur du taux horaire : '); readln(thp); PS:= total * thp; write('La paye de la semaine est : ',PS:3:3, ' DT'); end. Index Application 5 {calcul de l'inverse d'un entier à 2 chiffres CH 2 Les actions élémentaires simples } Program inverse; uses wincrt; var n,m: integer; begin write('Donner un entier : '); readln(n); m:= (n div 10)+(n mod 10) *10; write('L''inverse est :',m); end. Index Application 6 {Structure de contrôle conditionnelle simple - forme réduite. } program recherche; uses wincrt; var c:char; ch,msg:string; begin readln(c); readln(ch); msg:='Le caractère n''existe pas'; if pos(c,ch)0 then msg:='Le caractère existe '; write(msg); end.

Index Application 7 version 1 {Saisir une chaîne de caractère et vérifier si elle est composée de plusieurs mots.} {version 1} program phrase; uses wincrt; var ch:string; begin writeln('Donner une chaîne : '); readln(ch); if POS (' ',ch) = 0 then writeln('Votre chaîne est composée d''un seul mot ') else writeln('Votre chaîne est composée de plusieurs mots '); end. Index Application 8 version 2 {structure de contrôle conditionnelle forme généralisée.} program phrase; uses wincrt; var ch:string; procedure efface_esp_deb(var ch:string); begin while (ch[1]=' ') and (length(ch)0) do {supprimer tous les espaces de début} delete(ch, 1, 1); end; procedure efface_esp_fin(var ch:string); begin while (ch[length(ch)]=' ') and (length(ch)0) do {supprimer tous les espaces de fin} delete (ch,length(ch), 1); end; { ********* PP ***********} begin writeln('Donner une chaîne : '); readln(ch); efface_esp_deb(ch); efface_esp_fin(ch);

if length(ch)= 0 then writeln('Votre chaîne est vide ') else if POS (' ',ch) = 0 then writeln('Votre chaîne est composée d''un seul mot ') else writeln('Votre chaîne est composée de plusieurs mots '); end. Index Application 9 heure système {Avancer l'heure système d'une seconde} program inc_heure_systeme; uses wincrt,windos; var h,m,s,c:word; bip:char; msg:string; begin gettime(h,m,s,c); {Pour tester le cas particulier 23:59:59} {h:=23; m:=59; s:=59;} writeln(h,':',m,':',s); if sfx0); writeln('f(x) = x+1+1/x admet un minimum en x0 '); writeln('x0 est encadré entre ',x0:3:4,' et ',x:3:4); end.

Index Application 18 Combinaison

{Ecrire un programme qui détermine puis affiche le nombre de combinaisons de p objets parmi n, n et p sont deux entiers naturels strictement positifs (n >= p). } Program Combinaison ; uses wincrt; Var f1, f2, f3 ,p , n : integer ; c : integer ; Function fact (x: integer) : integer ; var f,c :integer; Begin f:=1; For c :=1 to x Do begin f:= f * c; End; Fact:=f; End ; procedure saisie(var n,p:integer); begin Repeat Writeln('donner un entire n '); readln(n) ; Writeln('donner un entire p'); readln(p) ; until (n>=p) and ( p>0); end; Begin {pp} Writeln('********** Nombre de combinaison ***********'); saisie(n,p); f1:=fact(n); f2 :=fact(p) ; f3 :=fact(n-p) ; c :=f1 div(f2 *f3); writeln ('la combinaison de p objets parmi n est = ', c); End. Index Application 19 pos_min

program minimum; uses wincrt; type tab=array[1..20]of integer; var T:tab; i,n :integer; function pos_min (T:tab; n:integer):integer; var pm:integer; begin pm:=1; for i:=2 to n do if T[i]=1) and (n 2*pi; end; procedure temporiser(t:word); var i,j:integer; begin for i:=1 to t do for j:=1 to 5000 do j:=j; end; begin repeat cercle; temporiser(2000); clrscr; temporiser(2000); until keypressed; end. {Principe : Le cercle sera constitué d'étoile. Les coordonnées des étoiles seront calculées selon les formules suivantes : Pour un angle a donnée, * x = cos (a) × rayon + 40 * y = sin (a) × rayon + 12 On vous rappel que les coordonnées du centre de la fenêtre d'exécution sont (40,12). Les angles calculés varient entre 0 et 2 avec un pas constant.}

Index Application 22 Tri par sélection {Tri par sélection ordre croissant} program tri_par_selection; uses wincrt; Type tab=array[1..50]of integer; var t:tab; n:integer; procedure saisie(var T:tab;var n:integer); var i:integer; begin repeat Write('Donner la taille du tableau :'); readln(n); until n in [2..50]; for i:=1 to n do begin Write('Donner l’’élément n°',i,' :') ; Readln(T[i]); end; end; {**} Procedure permuter( var a:integer; var b:integer); Var p : integer; begin p:=a; a:=b; b:=p; end; {**} function recherche_p_min(T:tab; n:integer; i:integer):integer; var p,j :integer; begin p:=i; for j:=i+1 to n do if t[j] T[i+1] then begin permuter (T[i] ,T[i+1]); changer:=true; end; until changer = false; end; procedure affichage(T:tab;n:integer); var c:integer; begin write('le tableau trié est : '); for c:=1 to n do write(T[c]:5); end; BEGIN saisie(T,n); tri(T,n); affichage(T,n); End.

Index Application 24 Tri par insertion {Chapitre 6 - Les traitements avancés} {Tri par insertion} Program tri_par_insertion ; Uses wincrt; Type tab=array[1..50] of integer; Var t:tab; n : integer ; procedure saisie(var T:tab;var n:integer); var i:integer; begin repeat Write('Donner la taille du tableau :'); readln(n); until n in [2..50]; for i:=1 to n do begin Write('Donner l’’élément n°',i,' :') ; Readln(T[i]); end; end; Procedure tri_insertion(var t : tab; n : integer); var i, j, p : integer; begin for i:=2 to n do begin p := t[i]; { p est la valeur à insérer dans l'endroit approprié du tableau} j := i ; { j est un compteur décroissant parcourant T de la position j à 1} while (j-1>=1) and(t[j-1] > p) do { On décale toutes les valeurs du tableau < p } begin t[j]:= t[j-1]; j := j - 1; end; t[j] := p; { finalement la valeur p est insérée à son emplacement adéquat} end; end; procedure affichage (T:tab; n:integer); var

c:integer; begin write('le tableau trié : '); for c:=1 to n do write(T[c]:5); end; BEGIN saisie(t,n); tri_insertion(t,n); affichage(T,n); End. Index Application 25 Recherche dichotomique {Chapitre 6 - Les algorithmes de tri et de recherches} {Recherche dichotomique} Program Recherche_dichotomique ; Uses wincrt; Type tab=array[1..50] of integer; Var T:tab; n:byte; m:integer; Procedure saisie(var T:tab; var n :byte); Var c : byte; Begin Write('Donner la taille du tableau : '); Readln(n) ; Write('Donner l''élément n° 1 : '); Readln(T[1]) ; For c :=2 to n do begin repeat Write('Donner l''élément n° ',c,' : ') ; Readln(T[c]); until T[c]>=T[c-1] end; end; function recherche_d (T:tab;n:byte;m:integer):boolean; var debut,fin,milieu:byte; trouve:boolean; begin

debut:=1; fin:=n; trouve:=false; repeat milieu:= (debut+fin) div 2; if m = T[milieu] then trouve:=true else if m < T[milieu] then fin :=milieu -1 else debut:=milieu+1; until (trouve) or (debut > fin); recherche_d:=trouve; end; BEGIN Saisie(T,n); write('Donner l''élément à rechercher : ');readln(m); if recherche_d(T,n,m) then write(m,' Existe dans T') else write(m,' N''existe pas dans T'); End.

Index Application 26 Prototype théorique {Correction Pototype BAC Théorique Info {Problème 12 pts} program eleves_admis; uses wincrt; Type nom=array[1..10]of string; moyenne=array[1..10]of real; var N:nom; M:moyenne; k:integer; procedure saisie(var k:integer); begin repeat Write('Donner le nombre de cases de N et M :'); readln(k); until k in [1..100]; end; { ** } procedure remplir (var N:nom; var M:moyenne; k:integer); var i:integer; begin

for i:=1 to k do begin write('Donner le nom de l''élève n° ',i,' : '); readln(N[i]); repeat write('Donner la moyenne de l''élève n° ',i,' : '); readln(M[i]); until (M[i]=0); end; end; { ** } Procedure permuter1( var a:real; var b:real); Var p : real; begin p:=a; a:=b; b:=p; end; Procedure permuter2( var a:string; var b:string); Var p : string; begin p:=a; a:=b; b:=p; end; { ** } function RP_max(M:moyenne; i:integer; k:integer):integer; var pm,j :integer; begin pm:=i; for j:=i+1 to k do if M[pm]