CORRECTION DES EXERCICES
program tva(input,output);
var prix_unitaire,quantite,
total_ht,tva,total_ttc:real;
begin
writeln('prix de l''article ?');
readln(prix_unitaire);
writeln('quantité désirée ? ');
readln(quantite);
total_ht:=prix_unitaire*quantite;
tva:=total_ht*(18.6/100);
total_ttc:=total_ht+tva;
writeln('total ht : ',total_ht);
writeln('tva : ',tva);
writeln(' -------------');
writeln('total ttc : ',total_ttc)
end.
program puissances(input,output);
var n,max:integer;
begin
writeln('nombre maxi ? ');
readln(max);
n:=2;
while n<=max do begin
writeln(n);
n:=n*2
end;
writeln('c''est fini')
end.
program jeu(input,output);
var choix,rep,nb:integer;
begin
nb:=0;
choix:=random(11);
repeat
nb:=nb+1;
writeln('choix ndeg. ',nb,' ? ');
readln(rep)
until rep=choix;
writeln('trouvé en ',nb,' coups')
end.
program moyenne(input,output);
var n,i:integer;
note,total,moyenne:real;
begin
writeln('nombre notes à entrer ?');
readln(n);
total:=0;
for i:=1 to n do begin
writeln(i,'ième note ? ');
readln(note);
total:=total+note
end;
moyenne:=total/n;
writeln('la moyenne est : ',moyenne)
end.
program jeu_ameliore(input,output);
var choix,rep,nb:integer;
begin
nb:=0;
choix:=random(11);
repeat
nb:=nb+1;
writeln('choix ndeg. ',nb,' ? ');
readln(rep);
if rep<choix then
writeln('c''est plus')
else if rep>choix then
writeln('c''est moins')
{le 2ème if empêche d'écrire si juste}
until rep=choix;
writeln('juste en ',nb,' coups')
end.
program calculatrice(input,output);
var val1,val2,resultat:real;
operation:char;
begin
writeln('première valeur ?');
readln(val1);
writeln('opération (+ - * /) ? ');
readln(operation)
writeln('deuxième valeur ? ');
readln(val2);
case operation of
'+':resultat:=val1+val2;
'-':resultat:=val1-val2;
'*':resultat:=val1*val2;
'/':resultat:=val1/val2
end;
writeln('résultat : ',resultat)
end.
program moyenne(input,output);
var n,compteur:integer
somme,moyenne,ecart:real;
note:array[1..100] of real;
begin
repeat
writeln('nb notes (100 maxi)?');
readln(n)
until (n>0) and (n<=100);
{entrée notes et calcul de la somme}
somme:=0;
for compteur:=1 to n do
begin
writeln(compteur,'è note ?');
readln(note[compteur]);
somme:=somme+note[compteur]
end;
{calcul et affichage de la moyenne}
moyenne:=somme/n;
writeln('moyenne : ',moyenne);
{calcul et affichage des écarts}
writeln('écarts :');
for compteur:=1 to n do
begin
ecart:=note[compteur]-moyenne;
writeln(compteur,'ième note (',
note[compteur],
') : écart : ',ecart)
end
end.
program rotation(input,output);
var index,n:integer;
prem:real;
tableau:array[1..100]of real;
begin
repeat
writeln('nb valeurs (100 maxi)?');
readln(n)
until (n>0) and (n<=100);
(* entrée des valeurs *)
for index:=1 to n do
begin
writeln(index,'ième valeur ?');
readln(tableau[index]);
end;
writeln('on décale vers le haut');
prem:=tableau[1]; {ne pas écraser!}
for index:=2 to n do
tableau[index-1]:=tableau[index];
tableau[n]:=prem;
for index:=1 to n do
writeln(tableau[index]);
writeln('on re-décale vers le bas');
prem:=tableau[n];
for index:=n downto 2 do
tableau[index]:=tableau[index-1];
tableau[1]:=prem;
for index:=1 to n do
writeln(tableau[index])
end.
program classer(input,output);
var n,i,index,petit,indexpetit:integer;
avant,apres:array[1..100]of integer;
pris:array[1..100] of boolean;
{pour noter ceux déjà pris}
begin
repeat
writeln('nb valeurs (100 maxi) ?');
readln(n)
until (n>0) and (n<=100);
{entrée valeurs - initialisation de pris}
for index:=1 to n do begin
writeln(index,'ième valeur ? ');
readln(avant[index]);
pris[index]:=false
end;
{ordre croissant,on cherche N valeurs}
for i:=1 to n do begin
petit:=maxint; {plus grand possible}
{recherche du plus petit non pris}
for index:=1 to n do
if (not pris[index]) and
(avant[index]<=petit) then begin
petit:=avant[index];
indexpetit:=index
end;
{ sauvegarde dans le tableau APRES et
mise à jour de PRIS }
apres[i]:=petit;
pris[indexpetit]:=true
end; { passage au prochain i }
{affichage du tableau APRES}
writeln('par ordre croissant : ');
for i:=1 to N do writeln(apres[i]);
{classement par ordre décroissant}
writeln('par ordre décroissant : ');
for i:=n downto 1 do writeln(apres[i])
{n'auriez-vous pas tout refait ?}
end.
program position(input,output);
var ch,sch:string[255];
i,j,n,l,ls:integer;
begin
writeln('chaîne à tester ? ');
readln(ch);
writeln('sous-chaîne à trouver ?');
readln(sch);
l:=length(ch);ls:=length(sch);
n:=0;
for i:=1 to l-ls do begin
j:=1;
while (j<=l)and(ch[i+j-1]=sch[j])
do j:=j+1;
if j>ls then begin
writeln('trouvé position ',i);
n:=n+1
end
end;
writeln(n,' fois ',sch,' dans ',ch)
end.
program produit_mat(input,output);
var m1,m2,m3:array[1..10,1..10]of real;
l,m,n,jl,jm,jn:integer;
begin
writeln('nb lignes 1ère matrice ?');
readln(m);
writeln('nb colonnes 1è matrice ?');
readln(l);
writeln('nb colonnes 2è matrice ?');
readln(n);
(* entrée de m1 *)
writeln('première matrice');
for jm:=1 to m do for jl:=1 to l do
begin
writeln('lig',jm,', col',jl,'?');
readln(m1[jm,jl])
end;
(* entrée de m2 *)
writeln('2ième matrice');
for jl:=1 to l do for jn:=1 to n do
begin
writeln('lig',jl,', col',jn,'?');
readln(m2[jl,jn])
end;
(* calcul du produit *)
for jm:=1 to m do for jn:=1 to n do
begin {calcul composante m,n de m2}
m3[jm,jn]:=0;
for jl:=1 to l do m3[jm,jn]:=
m3[jm,jn]+(m1[jm,jl]*m2[jl,jn]);
end;
(* affichage du résultat *)
writeln('résultat');
for jm:=1 to m do for jn:=1 to n do
writeln('m[',jm,',',jn,']=',
m3[jm,jn])
end.
program annuaire(input,output);
(* version simplifiée *)
type ligne=string[40];
typepersonne=record
nom:ligne;
num_tel:ligne
(* integer malheureusement < 32635 *)
end;
var pers:array[1..100]of
typepersonne;
nb,i:1..100;
rep:char;
imprimer:boolean;
texte:ligne;
begin
{on suppose avoir ici les instructions
permettant de lire sur fichier disque
NB et le tableau PERS }
repeat
writeln('recherche suivant : ');
writeln(' N : nom');
writeln(' T : numéro téléphone');
writeln(' Q : quitter le prog');
writeln('quel est votre choix ?');
readln(rep);
if rep<>'Q' then begin
writeln('texte à chercher ? ');
readln(texte)
for i:=1 to nb do with pers[i] do
begin
case rep of
'N':imprimer:=nom=texte;
'T':imprimer:=num_tel=texte;
end;
if imprimer then begin
writeln('nom : ',nom);
writeln('tel : ',num_tel)
end
end
end
until rep='Q'
end.
program determ(input,output);
{ on se limite à 10x10, ce qui fait 7h
de calcul et 6.235.314 appels à DETN }
type tmat=array[1..10,1..10] of real;
var dim:integer;
{dimension matrice à calculer}
det:real; {résultat désiré}
mat:tmat; {matrice à calculer}
appel:real; {nb appels à }
procedure entree;
var lig,col:integer;
begin
writeln('dimension de la matrice ?');
readln(dim); {DIM variable globale}
writeln('entrez les composantes :');
for lig:=1 to dim do begin
writeln('pour la ligne ndeg. ',lig);
for col:=1 to dim do begin
writeln('colonne ',col,' ?');
readln(mat[lig,col])
end
end
end;
procedure sous_mat(mdeb:tmat; var mfin:
tmat; ind,dim:integer);
{on supprime la colonne 1 et la ligne
ind pour avoir la s/mat de dim-1}
var col,lig,l:integer;
begin
l:=0;
for lig:=1 to dim do begin
if lig<>ind then begin
l:=l+1;
for col:=2 to dim do
mfin[l,col-1]:=mdeb[lig,col]
end
end
end;
function detn(m:tmat;d:integer):real;
{dét ordre d en fonction ordre d-1}
var result:real;
mprim:tmat; {matrice intermédiaire}
lig,signe:integer;
begin
appel:=appel+1;
if d=1 then detn:=m[1,1]
(* fin de récursivité *)
else begin
result:=0;
signe:=-1;
for lig:=1 to d do begin
sous_mat(m,mprim,lig,d);
signe:=-signe;
{changer de signe à chaque ligne}
result:=result +
(signe*m[lig,1]*detn(mprim,d-1))
end;
detn:=result
end
end;
begin (* programme principal *)
entree;
appel:=0;
det:=detn(mat,dim);
writeln('résultat : ',det);
writeln('nb appels DETN : ',appel)
end.
procedure lirefic;
var i:1..100;
f:file of typepersonne;
(* variables globales :
NB et le tableau PERS *)
begin
assign(f,'annuaire'); {non standard}
reset(f);
nb:=0;
while not EOF(f) do begin
nb:=nb+1;
read(f,pers[nb)
end;
close(f)
end;
{à vous de faire la suite}
program liste(input,output);
TYPE tpoint=^tval;
tval=record
valeur:integer;
suivant:tpoint
end;
VAR prem:tpoint; {variable globale}
n:integer;
c:char;
procedure lire;
var precedent,point:tpoint;
i:integer;
{ modifie N et PREM }
begin
write('combien d''éléments?');
readln(n);
new(prem);
write('1ère valeur ? ');
readln(prem^.valeur);
precedent:=prem;
for i:=2 to n do begin
new(point);
write(i,'ième valeur ? ');
readln(point^.valeur);
precedent^.suivant:=point;
precedent:=point
end;
precedent^.suivant:=NIL
(* le dernier ne pointe sur rien *)
end;
procedure afficher;
var point:tpoint;
i:integer;
begin
point:=prem;
for i:=1 to n do begin
writeln(point^.valeur);
point:=point^.suivant
end
end;
procedure supprimer;
var point,prec:tpoint;
rep:char;
begin
point:=prem;
repeat
write(point^.valeur,' à ôter ?');
readln(rep);
if rep='O' then begin
n:=n-1;
if point<>prem then begin
prec^.suivant:=point^.suivant;
dispose(point);
point:=prec^.suivant
(* se préparer pour la suite *)
end
else begin
prem:=prem^.suivant;
dispose(point);
(* ancien premier *)
point:=prem
end
end
else begin
(* pointer sur le suivant *)
prec:=point;
point:=point^.suivant
end
until point=nil
end;
procedure rajouter;
var p1,p2,prec:tpoint;
rep:char;
begin
p1:=prem;
repeat
write(p1^.valeur,' rajouter un
élément avant (O/N) ? ');
readln(rep);
if rep='O' then begin
n:=n+1;
if p1<>prem then begin
new(p2);
write('valeur ? ');
readln(p2^.valeur);
prec^.suivant:=p2;
p2^.suivant:=p1;
prec:=p2;
end
else begin
new(p1);
write('valeur ? ');
readln(p1^.valeur);
p1^.suivant:=prem;
prem:=p1
end
end
else begin
(* pointer sur le suivant *)
prec:=p1;
p1:=p1^.suivant
end
until p1=nil;
p1:=prec;
repeat
write('ajouter un élément en fin
de liste (O/N) ? ');
readln(rep);
if rep='O' then begin
n:=n+1;
new(p2);
write('valeur ? ');
readln(p2^.valeur);
p1^.suivant:=p2;
p2^.suivant:=nil;
p1:=p2
end
until rep<>'O'
end;
BEGIN {prog principal}
lire;
repeat
writeln('A:afficher, S:supprimer R:rajouter, F:fin');
write('votre choix ? ');
readln(c);
case c of
'A':afficher;
'S':supprimer;
'R':rajouter
end
until c='F'
end.