mercredi 2005 : Pascal, deuxième semestre, DEUG première année, MASS 2004--2005

mercredi 9 février 2005 : enregistrements, nombres complexes
mercredi 16 février 2005 : enregistrements
mercredi 23 février 2005 : tableaux : vecteurs
mercredi 9 mars 2005 : tableaux : matrices
mercredi 16 mars 2005 : tableaux
mercredi 23 mars 2005 : fichiers text
mercredi 30 mars 2005 : fichiers binaires
mercredi 6 avril 2005 : fichiers
mercredi 13 avril 2005 : système d'équations linéaires
mercredi 20 avril 2005 : polynômes
mercredi 11 mai 2005 : tableaux à deux dimensions
mercredi 18 mai 2005 : méthode de Newton
mercredi 25 mai 2005 : dichotomie
mercredi 1er juin 2005 : affichage de tableaux carrés

suivant sommaire

mercredi 9 février 2005 : enregistrements, nombres complexes

On veut écrire un programme qui lit trois nombres complexes et affiche leur produit. 
Donnez un nombre complexe : 1 2
Donnez un nombre complexe : 2 3
Donnez un nombre complexe : 3 4
(1.000+i2.000)(2.000+i3.000)(3.000+i4.000)=(-40.000+i5.000)

première version, sans enregistrement ni procédure

var ar,ai,br,bi,cr,ci,abr,abi,abcr,abci:real;
begin
  write('Donnez un nombre complexe : ');
  readln(ar,ai);
  write('Donnez un nombre complexe : ');
  readln(br,bi);
  write('Donnez un nombre complexe : ');
  readln(cr,ci);
  abr:=ar*br-ai*bi;
  abi:=ar*bi+ai*br;
  abcr:=abr*cr-abi*ci;
  abci:=abr*ci+abi*cr;
  writeln('(',ar:0:3,'+i',ai:0:3,')',
          '(',br:0:3,'+i',bi:0:3,')',
          '(',cr:0:3,'+i',ci:0:3,')=',
          '(',abcr:0:3,'+i',abci:0:3,')')
end.

deuxième version, sans enregistrement, avec procédures

procedure lit_c(var re,im:real);
begin
  write('Donnez un nombre real : ');
  readln(re,im)
end;
procedure mul_c(ar,ai,br,bi:real;var cr,ci:real);
begin
  cr:=ar*br-ai*bi;
  ci:=ar*bi+ai*br
end;
procedure ecrit_c(re,im:real);
begin
  write('(',re:0:3,'+i',im:0:3,')')
end;
var ar,ai,br,bi,cr,ci,abr,abi,abcr,abci:real;
begin
  lit_c(ar,ai);
  lit_c(br,bi);
  lit_c(cr,ci);
  mul_c(ar,ai,br,bi,abr,abi);
  mul_c(abr,abi,cr,ci,abcr,abci);
  ecrit_c(ar,ai);
  ecrit_c(br,bi);
  ecrit_c(cr,ci);
  write('=');
  ecrit_c(abcr,abci);
  writeln
end.

troisième version, avec enregistrements, sans procédure

var a,b,c,ab,abc:record re,im:real end;
begin
  write('Donnez un nombre complexe : ');
  readln(a.re,a.im);
  write('Donnez un nombre complexe : ');
  readln(b.re,b.im);
  write('Donnez un nombre complexe : ');
  readln(c.re,c.im);
  ab.re:=a.re*b.re-a.im*b.im;
  ab.im:=a.re*b.im+a.im*b.re;
  abc.re:=ab.re*c.re-ab.im*c.im;
  abc.im:=ab.re*c.im+ab.im*c.re;
  writeln('(',a.re:0:3,'+i',a.im:0:3,')',
          '(',b.re:0:3,'+i',b.im:0:3,')',
          '(',c.re:0:3,'+i',c.im:0:3,')=',
          '(',abc.re:0:3,'+i',abc.im:0:3,')')
end.

quatrième version, avec enregistrements et procédures

type complexe=record re,im:real end;
procedure lit_c(var a:complexe);
begin
  write('Donnez un nombre complexe : ');
  readln(a.re,a.im)
end;
procedure mul_c(a,b:complexe;var c:complexe);
begin
  c.re:=a.re*b.re-a.im*b.im;
  c.im:=a.re*b.im+a.im*b.re
end;
procedure ecrit_c(a:complexe);
begin
  write('(',a.re:0:3,'+i',a.im:0:3,')')
end;
var a,b,c,ab,abc:complexe;
begin
  lit_c(a);
  lit_c(b);
  lit_c(c);
  mul_c(a,b,ab);
  mul_c(ab,c,abc);
  ecrit_c(a);
  ecrit_c(b);
  ecrit_c(c);
  write('=');
  ecrit_c(abc);
  writeln
end.
On peut écrire d'autres opérations sur les nombres complexes 

procedure add_c(a,b:complexe;var c:complexe);
begin
  c.re:=a.re+b.re;
  c.im:=a.im+b.im
end;
procedure sou_c(a,b:complexe;var c:complexe);
begin
  c.re:=a.re-b.re;
  c.im:=a.im-b.im
end;
procedure div_c(a,b:complexe;var c:complexe);
var n:real;
begin
  n:=sqr(b.re)+sqr(b.im);
  c.re:=( a.re*b.re+a.im*b.im)/n;
  c.im:=(-a.re*b.im+a.im*b.re)/n
end;

TD : nombres rationnels

Compléter le programme : 

type entier=longint;
     fraction=record num,den:entier end;
function pgcd(a,b:entier):entier;
...
procedure reduit_frac(var a:fraction);
...
procedure lire_frac(var a:fraction);
begin
  ...
  reduit_frac(a)
end;
procedure ecrire_frac(a:fraction);
...
procedure addition_frac(a,b:fraction;var c:fraction); // c:=a+b 
...
procedure soustraction_frac(a,b:fraction;var c:fraction); // c:=a+b 
...
var x,y,z:fraction;
begin
  write('Donnez deux fractions : ');
  lire_frac(x);
  lire_frac(y);
  addition(x,y,z);
  ecrire_frac(x); write('+'); ecrire_frac(y); write('='); ecrire_frac(z); writeln;
  ...
Quand on l'exécute on doit voir sur l'écran : 
Donnez deux fractions : 1 2 2 3
(1/2)+(2/3)=(7/6)
(1/2)-(2/3)=(-1/6)
(1/2)*(2/3)=(1/3)
(1/2)/(2/3)=(3/4)

pgcd

Pour calculer le pgcd de a et b on peut utiliser l'algorithme d'Euclide : 
tant que b≠0 faire
   a:=a mod b
   échanger a et b
fait
A la fin, la valeur cherchée est dans a.

grands nombres

Le programme devra marcher avec des grands nombres comme : 
(1/1001000)+(1/999000)=(2/999999)
(2/999999)-(1/999000)=(1/1001000)
(1002000/999999)*(999000/1003002)=(1000000/1002001)
Pour cela il faut utiliser les algorithmes suivants :

addition

Les calculs à faire pour obtenir (e/f)=(a/b)+(c/d) sont : 
p=pgcd(b,d)
B=b/p
D=d/p
E=a*D+c*B
q=pgcd(E,p)
e=E/q
f=(p/q)*B*D
car 
   a   c    a    c   1  a   c    1 aD+cB    E     E/q      e
   - + - = -- + -- = - (- + -) = - ----- = --- = ------- = -
   b   d   pB   pD   p  B   D    p  BD     pBD   (p/q)BD   f
Si on suppose que a/b et c/d sont irréductibles, on fait ainsi toutes les simplifications possibles. e/f est déjà réduite. En effet comme B est premier avec a et avec D, il l'est aussi avec aD et donc aussi avec E. Il n'y a donc pas de simplification possible entre E et B, (ni entre E et D).
On peut aussi ranger E dans le numérateur du résultat, et p dans son dénominateur, puis réduire cette fraction (en appelant la procédure de réduction) et enfin multiplier son dénominateur par BD.

multiplication

Les calculs à faire pour obtenir (e/f)=(a/b)*(c/d) sont : 
p=pgcd(a,d)
q=pgcd(b,c)
e=(a/p)*(c/q)
f=(b/q)*(d/p)
car 
  a c   c a   c/q a/p   e
  - - = - - = --- --- = -
  b d   b d   b/q d/p   f
Si on suppose que a/b et c/d sont irréductibles, on fait ainsi toutes les simplifications possibles. e/f est déjà réduite.
On peut aussi échanger les numérateurs des deux fractions à multiplier, puis les réduire (en appelant la procédure de réduction) avant de faire le produit des numérateurs et le produit des dénominateurs.

Autres calculs sur des fractions

Modifier le programme pour obtenir quand on l'exécute : 
Donnez deux entiers : 9 11
La somme des inverses des nombres entiers de 9 à 11 est (299/990)
L'algorithme à utiliser est : 
s:=0
pour i:=x, x+1, ... y faire
  t:=1/i
  s:=s+t
fait
s et t sont des fractions. Donc s:=0 consiste à ranger 0 et 1 dans le numérateur et le dénominateur de s. De même t:=1/i consiste à ranger 1 et i dans le numérateur et le dénominateur de t. Enfin s:=s+t se traduit par un appel à la procédure addition_frac.
suivant précédent sommaire

mercredi 16 février 2005 : enregistrements

racine carrée d'un nombre complexe et équation du second degré à coefficients complexes


type complexe=record re,im:real end;
procedure lit_c(var a:complexe);

begin
  write('Donnez un nombre complexe : ');
  readln(a.re,a.im)
end;

procedure ecrit_c(a:complexe);
begin
  write('(',a.re:0:3,'+i',a.im:0:3,')')
end;

procedure mul_c(a,b:complexe;var c:complexe);
begin
  c.re:=a.re*b.re-a.im*b.im;
  c.im:=a.re*b.im+a.im*b.re
end;

procedure add_c(a,b:complexe;var c:complexe);
begin
  c.re:=a.re+b.re;
  c.im:=a.im+b.im
end;

procedure sou_c(a,b:complexe;var c:complexe);
begin
  c.re:=a.re-b.re;
  c.im:=a.im-b.im
end;

procedure div_c(a,b:complexe;var c:complexe);
var n:real;
begin
  n:=sqr(b.re)+sqr(b.im);
  c.re:=( a.re*b.re+a.im*b.im)/n;
  c.im:=(-a.re*b.im+a.im*b.re)/n
end;

function module(a:complexe):real;
begin
  module:=sqrt(sqr(a.re)+sqr(a.im))
end;

procedure rac_c(z:complexe;var r:complexe);
var m:real;
begin
  m:=module(z);
  if m=0 then r:=z else
  if z.re>0 then begin r.re:=sqrt((m+z.re)/2); r.im:=z.im/(2*r.re) end
            else begin r.im:=sqrt((m-z.re)/2); r.re:=z.im/(2*r.im) end
end;

var a,b,c,d,z1,z2:complexe;
begin
  writeln('Donnez les trois coefficients de l''équation du second degré :');
  lit_c(a);
  lit_c(b);
  lit_c(c);
  write('L''équation ');ecrit_c(a);write('X*X+');ecrit_c(b);write('X+');ecrit_c(c);
  write('=0 a pour solutions ');
  b.re:=b.re/-2;
  b.im:=b.im/-2;
  mul_c(b,b,z1);
  mul_c(a,c,z2);
  sou_c(z1,z2,d);
  rac_c(d,d);
  add_c(b,d,z1); div_c(z1,a,z1);
  sou_c(b,d,z2); div_c(z2,a,z2);
  if module(z2)>module(z1) then z1:=z2;
  div_c(c,a,z2);
  div_c(z2,z1,z2);
  ecrit_c(z1); write(' et ');
  ecrit_c(z2); readln
end.

voitures

Les enregistrements peuvent contenir des champs de types différents. 

type voiture=record
               immatriculation:string[10];
	       contenu,capacite:real; // du réservoir
	       kilometrage:real;
	     end;
	     
procedure roule(var v:voiture;distance,consommation:real);
begin
  v.kilometrage:=v.kilometrage+distance;
  v.contenu:=v.contenu-consommation;
  if v.contenu<0 then
  begin
    write('La voiture immatriculée ',v.immatriculation,' est tombée en panne sèche.');
    readln;
    halt
  end
end;

procedure plein(var v:voiture);
begin
  with v do contenu:=capacite
end;

procedure siphonnage(var v1,v2:voiture;quantite:real);
begin 
  if v1.contenu<quantite then quantite:=v1.contenu;
  if v2.contenu+quantite>v2.capacite then quantite:=v2.capacite-v2.contenu;
  v1.contenu:=v1.contenu-quantite;
  v2.contenu:=v2.contenu+quantite
end;

procedure affiche(v:voiture);
begin
  with v do
  writeln('La voiture immatriculée ',immatriculation,' a ',
  kilometrage:0:2,' kilomètres au compteur et ',
  contenu:0:2,' litres d''essence dans son réservoir, qui peut en contenir ',
  capacite:0:2)
end;

var tacot,rouge,bleue:voiture;
begin
  tacot.immatriculation:='1234AA75';
  tacot.capacite:=100;
  tacot.contenu:=40;
  tacot.kilometrage:=326621;
  rouge.immatriculation:='654CDE75';
  rouge.capacite:=40;
  rouge.contenu:=4;
  rouge.kilometrage:=25231;
  bleue:=rouge;
  bleue.immatriculation:='655CDE75';
  bleue.kilometrage:=27321;
  affiche(rouge);
  affiche(bleue);
  affiche(tacot);
  roule(tacot,50,25);
  roule(bleue,10,1); // pour aller jusqu'à la pompe
  plein(bleue);
  roule(bleue,10,1); // pour revenir au garage
  siphonnage(bleue,tacot,20);
  siphonnage(bleue,rouge,10);
  roule(rouge,123,7);
  affiche(bleue);
  affiche(rouge);
  affiche(tacot)
end.
Le programme précédent écrit :
La voiture immatriculée 654CDE75 a 25231.00 kilomètres au compteur et 4.00 litres d'essence dans son réservoir, qui peut en contenir 40.00
La voiture immatriculée 655CDE75 a 27321.00 kilomètres au compteur et 4.00 litres d'essence dans son réservoir, qui peut en contenir 40.00
La voiture immatriculée 1234AA75 a 326621.00 kilomètres au compteur et 40.00 litres d'essence dans son réservoir, qui peut en contenir 100.00
La voiture immatriculée 655CDE75 a 27341.00 kilomètres au compteur et 9.00 litres d'essence dans son réservoir, qui peut en contenir 40.00
La voiture immatriculée 654CDE75 a 25354.00 kilomètres au compteur et 7.00 litres d'essence dans son réservoir, qui peut en contenir 40.00
La voiture immatriculée 1234AA75 a 326671.00 kilomètres au compteur et 35.00 litres d'essence dans son réservoir, qui peut en contenir 100.00

TD : compte en banque

Compléter le programme : 
type compte=record
              nom:string[30]; // du titulaire du compte
              solde:longint;  // en euros
	    end;
procedure ...


var dup,dur:compte;
begin
  dup.nom:='Jean Dupont';
  dup.solde:=3000;
  dur.nom:='Jacques Durand';
  dur.solde:=-244;
  crediter(dup,325);
  crediter(dur,1287);
  debiter(dup,23);
  debiter(dup,423);
  crediter(dur,43);
  virer(dup,dur,127);
  afficher(dup);
  afficher(dur)
end.

retour sur les rationnels

Ecrire un programme qui calcule : ∑j=121232 1/(j2+j). Il doit trouver 112/28193.
Ecrire un programme qui calcule : ∏j=100200 (j+1)/(j-2). Il doit trouver 13333/1617.
Ecrire un programme qui calcule : (∑i=1100 (i2+i+5)/pgcd(i+10,9000))/ (∑i=1100 (i2-i+5)/pgcd(i+10,9000))
suivant précédent sommaire

mercredi 23 février 2005 : tableaux : vecteurs

var r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12,
    s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12:integer;
begin
  write('Donnez les recettes des 12 mois : ');
  readln(r1,r2,r3,r4,r5,r6,r7,r8,r9,r10,r11,r12);
  write('Donnez les dépenses des 12 mois : ');
  readln(s1,s2,s3,s4,s5,s6,s7,s8,s9,s10,s11,s12);
  writeln(r1:8,'-',s1:8,'=',r1-s1:8);
  writeln(r2:8,'-',s2:8,'=',r2-s2:8);
  writeln(r3:8,'-',s3:8,'=',r3-s3:8);
  writeln(r4:8,'-',s4:8,'=',r4-s4:8);
  writeln(r5:8,'-',s5:8,'=',r5-s5:8);
  writeln(r6:8,'-',s6:8,'=',r6-s6:8);
  writeln(r7:8,'-',s7:8,'=',r7-s7:8);
  writeln(r8:8,'-',s8:8,'=',r8-s8:8);
  writeln(r9:8,'-',s9:8,'=',r9-s9:8);
  writeln(r10:8,'-',s10:8,'=',r10-s10:8);
  writeln(r11:8,'-',s11:8,'=',r11-s11:8);
  writeln(r12:8,'-',s12:8,'=',r12-s12:8);
  readln
end.
Le programme précédent peut s'écrire de façon plus concise avec des tableaux : 
var r,s:array[1..12] of integer;
    j:integer;
begin
  write('Donnez les recettes des 12 mois : ');
  for j:=1 to 12 do read(r[j]);
  readln;
  write('Donnez les dépenses des 12 mois : ');
  for j:=1 to 12 do read(s[j]);
  readln;
  for j:=1 to 12 do writeln(r[j]:8,'-',s[j]:8,'=',r[j]-s[j]:8);
  readln
end.
On peut utiliser les tableaux pour traiter des vecteurs. 
const dim=3;
type real=extended;
     vec=array[1..3] of real;
procedure addv(a,b:vec;var c:vec); // c:=a+b
var j:integer;
begin
  for j:=1 to dim do c[j]:=a[j]+b[j]
end;
procedure souv(a,b:vec;var c:vec); // c:=a-b
var j:integer;
begin
  for j:=1 to dim do c[j]:=a[j]-b[j]
end;
procedure litv(var a:vec); // readln(a)
var j:integer;
begin
  write('Donnez ',dim,' nombres : ');
  for j:=1 to dim do read(a[j]);
  readln
end;
procedure ecritv(a:vec); // writeln(a)
var j:integer;
begin
  for j:=1 to dim do write(a[j]:15:3);
  writeln
end;
var a,b,c,d:vec;
begin
  litv(a);
  litv(b);
  addv(a,a,c); // c:=2a
  addv(c,c,d); // d:=4a
  souv(a,d,c); // c:=-3a
  addv(c,b,d); // d:=b-3a
  ecritv(c);
  ecritv(d);
  readln
end.

TD :

somme, maximum et minimum

Modifier le programme vu en cours traitant des recettes et des dépenses, pour qu'il calcule et affiche aussi les 9 nombres : ∑i=1nr[i], ∑i=1ns[i], ∑i=1nr[i]-t[i], mini=1nr[i], mini=1ns[i], mini=1nr[i]-t[i], maxi=1nr[i], maxi=1ns[i] et maxi=1nr[i]-t[i].
On pourra éventuellement écrire des procédures qui affichent la somme ou le plus grand ou le petit des éléments d'un tableau de douze entiers. On pourra aussi déclarer un troisième tableau t que l'on remplira avec t[i]=r[i]-s[i].

norme et produit scalaire de vecteurs

Ecrire un programme contenant les deux fonctions ayant pour entête
function normev(a:vec):real;
function prodscal(a,b:vec):real;
qui calculent la norme euclidienne d'un vecteur, √∑i=1na[i]2 et le produit scalaire de deux vecteurs ∑i=1na[i]b[i].
Le programme lira deux vecteurs et affichera leurs normes et leur produit scalaire.

tri d'un tableau d'entier

Ecrire un programme qui contienne
const n=10;
type tab=array[1..n] of integer;
function posmax(a:tab;k:integer):integer;
...
procedure tri(var a:tab);
...
posmax(a,k) doit être l'indice (et non pas la valeur) du plus grand parmi les k premiers éléments de a. Par exemple, si le plus grand des quatre nombres a[1], a[2], a[3] et a[4] est a[3], alors posmax(a,4) vaut 3.
La procédure tri(a) permute les éléments du tableau a, de manière à les mettre dans l'ordre croissant. Elle utilisera l'algorithme suivant : 
pour k=n, n-1, ... 1 faire
   déterminer où se trouve le plus grand des k premiers éléments de a,
   puis l'échanger avec a[k]
fait
Il y a donc une boucle for qui contient un appel à la fonction posmax.
suivant précédent sommaire

mercredi 9 mars 2005 : tableaux : matrices

Produit d'une matrice par un vecteur ou de deux matrices.
Lecture et écriture de matrices. 
const dim=3;
type real=extended;
     vec=array[1..3] of real;
     mat=array[1..3] of vec;
procedure litv(var a:vec); // readln(a)
var j:integer;
begin
  write('Donnez ',dim,' nombres : ');
  for j:=1 to dim do read(a[j]);
  readln
end;
procedure ecritv(a:vec); // writeln(a)
var j:integer;
begin
  for j:=1 to dim do write(a[j]:15:3);
  writeln
end;
procedure litm(var a:mat); // readln(a)
var j:integer;
begin
  writeln('Entrez une matrice, ligne par ligne :');
  for j:=1 to dim do litv(a[j])
end;
procedure ecritm(a:mat); // writeln(a)
var j:integer;
begin
  writeln;  // pour que la première ligne soit bien à gauche
  for j:=1 to dim do ecritv(a[j])  // écrit la jème ligne
end;
procedure mulmvv(a:mat;b:vec;var c:vec); // c:=a*b
var s:real;
    i,j:integer;
begin
  for i:=1 to dim do
  begin
    s:=0;
    for j:=1 to dim do s:=s+a[i,j]*b[j];
    c[i]:=s
  end
end;
procedure mulmmm(a,b:mat;var c:mat); // c:=a*b
var s:real;
    i,j,k:integer;
begin
  for i:=1 to dim do
  for k:=1 to dim do
  begin
    s:=0;
    for j:=1 to dim do s:=s+a[i,j]*b[j,k];
    c[i,k]:=s
  end
end;
var a,b,c:vec;
    m1,m2,m3:mat;
begin
  litv(a);
  litm(m1);
  litm(m2);
  mulmvv(m1,a,b);      // b:=m1*a
  mulmvv(m2,b,c);      // c:=m2*b
  write('a=');         ecritv(a);
  write('m1=');        ecritm(m1);
  write('m2=');        ecritm(m2);
  write('m1 a=');      ecritv(b);
  write('m2 (m1 a)='); ecritv(c);
  mulmmm(m2,m1,m3);    // m3:=m2*m1
  mulmvv(m3,a,c);      // c:=m3*a
  write('m2 m1=');     ecritm(m3);
  write('(m2 m1) a='); ecritv(c);
  readln;
  readln
end.
Le programme précédent écrit par exemple : 
Donnez 3 nombres : 1 2 1
Entrez une matrice, ligne par ligne :
Donnez 3 nombres : 1 2 3
Donnez 3 nombres : 4 5 6
Donnez 3 nombres : 7 8 9
Entrez une matrice, ligne par ligne :
Donnez 3 nombres : 4 1 2
Donnez 3 nombres : 2 4 1
Donnez 3 nombres : 1 2 4
a=          1.000          2.000          1.000
m1=
          1.000          2.000          3.000
          4.000          5.000          6.000
          7.000          8.000          9.000
m2=
          4.000          1.000          2.000
          2.000          4.000          1.000
          1.000          2.000          4.000
m1 a=          8.000         20.000         32.000
m2 (m1 a)=        116.000        128.000        176.000
m2 m1=
         22.000         29.000         36.000
         25.000         32.000         39.000
         37.000         44.000         51.000
(m2 m1) a=        116.000        128.000        176.000

TD :

transposée et trace

Ecrire un programme qui contienne des procédures calculant le produit de deux matrices et la tranposée d'une matrice, et une fonction qui calcule la trace d'une matrice carrée.
Le programme principal doit calculer tr(A B C) et tr(B C A) et tr(tA tB tC) où 
    ( 1 2 3 )     ( 9 8 7 )     ( 4 1 1 )
A = ( 4 5 6 )   B=( 6 5 4 )   C=( 1 4 1 )
    ( 7 8 9 )     ( 3 2 1 )     ( 1 1 4 )

suite de vecteurs

Soit H la matrice carrée 20x20, contenant les coefficients H[i,j]=1/(i+j-1). On définit une suite de vecteurs qui a pour premier terme (1,1,...,1). Après cela chaque terme se déduit du précédent en le multipliant par la matrice H, puis en divisant le produit par sa première composante. La suite de vecteurs ainsi obtenue converge. Vous devez écrire un programme qui calcule sa limite. On peut utiliser l'algorithme suivant 
v:=(1,1,...,1)
répéter
  u:=v
  v:=H v
  v:=v/v[1]
jusqu'à ce que u et v soient très proches
suivant précédent sommaire

mercredi 16 mars 2005 : tableaux

const n=10;
type tab=array[1..n] of integer;
procedure aff(a:tab);
var i:integer;
begin
  for i:=1 to n do write(a[i]:5);
  writeln
end;

procedure remplitaleat(var a:tab;min,max:integer);
var i:integer;
begin
  for i:=1 to n do a[i]:=min+random(max-min+1)
end;

procedure addition(a,b:tab;var c:tab); // c:=a+b
var i:integer;
begin
  for i:=1 to n do c[i]:=a[i]+b[i]
end;

procedure soustraction(a,b:tab;var c:tab); // c:=a-b
var i:integer;
begin
  for i:=1 to n do c[i]:=a[i]-b[i]
end;

function somme(a:tab;n:integer):integer;
var s,i:integer;
begin
  s:=0;
  for i:=1 to n do s+=a[i];
  somme:=s
end;

function produit(a:tab;n:integer):integer;
var s,i:integer;
begin
  s:=1;
  for i:=1 to n do s*=a[i];
  produit:=s
end;

function max(a:tab;n:integer):integer;
var m,i:integer;
begin
  m:=a[1];
  for i:=2 to n do if a[i]>m then m:=a[i];
  max:=m
end;

function min(a:tab;n:integer):integer;
var m,i:integer;
begin
  m:=a[1];
  for i:=2 to n do if a[i]<m then m:=a[i];
  min:=m
end;

function posmax(a:tab;n:integer):integer;
var p,i:integer;
begin
  p:=1;
  for i:=2 to n do if a[i]>a[p] then p:=i;
  posmax:=p
end;

function posmin(a:tab;n:integer):integer;
var p,i:integer;
begin
  p:=1;
  for i:=2 to n do if a[i]<a[p] then p:=i;
  posmin:=p
end;

procedure triselection(var a:tab;n:integer);
var j,x:integer;
begin
  while n>1 do
  begin
    j:=posmax(a,n);
    x:=a[j]; a[j]:=a[n]; a[n]:=x;
    n:=n-1
  end
end;

procedure tribulle(var a:tab;n:integer);
var k,kmax,x:integer;
begin
  while n>1 do
  begin
    kmax:=1;
    for k:=1 to n-1 do if a[k]>a[k+1] then
    begin
      x:=a[k]; a[k]:=a[k+1]; a[k+1]:=x;
      kmax:=k
    end;
    n:=kmax
  end
end;

var a,b,c,d:tab;
begin
  remplitaleat(a,-4,6);
  remplitaleat(b,-7,9);
  addition(a,b,c);
  soustraction(a,b,d);
  aff(a);
  writeln('Le plus grand est ',max(a,n),' Il est en position ',posmax(a,n));
  writeln('Le plus petit est ',min(a,n),' Il est en position ',posmin(a,n));
  writeln('La somme est ',somme(a,n));
  writeln('Le produit est ',produit(a,n));
  aff(b);
  aff(c);
  aff(d);
  triselection(c,n);
  tribulle(d,n);
  aff(c);
  aff(d)
end.
Le programme précédent écrit 
    3    1   -4    4    0   -3    6    4    5    2
Le plus grand est 6 Il est en position 7
Le plus petit est -4 Il est en position 3
La somme est 18
Le produit est 0
    5    1    4   -5   -1   -2    3   -6    1    9
    8    2    0   -1   -1   -5    9   -2    6   11
   -2    0   -8    9    1   -1    3   10    4   -7
   -5   -2   -1   -1    0    2    6    8    9   11
   -8   -7   -2   -1    0    1    3    4    9   10

TD : 

procedure stath(a:tab);
begin
end;

function nbcommuns(a,b:tab):integer;
begin
end;

var a,b:tab;
begin
  remplitaleat(a,5,10);
  remplitaleat(b,7,12);
  aff(a);
  stath(a);
  aff(b);
  writeln('il y a ',nbcommuns(a,b),' éléments communs.')
end.
Compléter le programme précédent pour qu'il affiche par exemple 
    9    8    5    9    7    5   10    9    9    8
2x5
1x7
2x8
4x9
1x10
   11    9   11    7    9    9   10    7    9   12
il y a 6 éléments communs.
Il y a un 7, quatre 9 et un 10, ce qui fait bien six éléments communs. suivant précédent sommaire

mercredi 23 mars 2005 : fichiers text

Un programme peut écrire ou lire des données dans un fichier sur le disque dur ou une disquette ou une clef USB. En fait tous les programmes écrits en pascal depuis le début de l'année utilisent des fichiers, car le pascal considère l'écran comme un fichier dans lequel on écrit, et le clavier comme un fichier dans lequel on lit. Par exemple le programme 
var j:integer;
begin
  write('Donnez un nombre : ');
  readln(j);
  writeln(j,'+',j,'=',j+j);
  readln
end.
utilise implicitement le fichier prédéfini OUTPUT qui correspond à l'écriture sur l'écran ainsi que le fichier prédéfini INPUT qui correspond à la lecture au clavier. On aurait pu l'écrire en utilisant explicitement les fichiers OUTPUT et INPUT : 
var j:integer;
begin
  write(output,'Donnez un nombre : ');
  readln(input,j);
  writeln(output,j,'+',j,'=',j+j);
  readln(input)
end.
Le programme précédent est aussi équivalent au programme suivant, où on n'utilise pas les fichiers prédéfinis OUTPUT et INPUT, mais on les redéfinit. De plus on a étendu les instructions write, writeln et readln. 
var j:integer;
    output,input:text;
begin
  assign(output,'con');  // 'con' veut dire console
  assign(input,'con');
  rewrite(output);
  reset(input);
  write(output,'Donnez un nombre : ');
  read(input,j); readln(input);
  write(output,j); write(output,'+'); write(output,j); write(output,'=');
  write(output,j+j); writeln(output);
  readln(input);
  close(input);
  close(output)
end.
Voici un exemple de programme qui écrit un vrai fichier sur le disque dur. 

var f:text;
begin
  assign(f,'c:\dev-pas\dupont\pi.txt');
  rewrite(f);
  writeln(f,'Que j''aime à faire connaître un nombre utile aux sages !');
  writeln(f,'Immortel Archimède, artiste ingénieur,');
  writeln(f,'qui de ton jugement peut priser la valeur ?');
  writeln(f,'Pour moi, ton problème eut de pareils avantages.');
  close(f);
  readln
end.
Voici un autre programme qui lit le fichier créé précédemment et l'affiche sur l'écran. 

var f:text;
    c:char;
begin
  assign(f,'c:\dev-pas\dupont\pi.txt');
  reset(f);
  while not eof(f) do
  if eoln(f) then
  begin
    readln(f);
    writeln
  end        else
  begin
    read(f,c);
    write(c)
  end;
  close(f);
  readln
end.
Lorsque l'on veut utiliser un fichier il faut appeler dans l'ordre :

la procédure assign

procedure assign(var f:text;nom:string);
pour dire sur quel support (a: pour une disquette, c: pour le disque dur, e: pour une clef USB, con pour la console), dans quel répertoire et sous quel nom se trouvera le fichier f.

une des trois procédures d'ouverture de fichier

procedure rewrite(var f:text);
pour écrire un nouveau fichier (Il est d'abord détruit s'il existait déjà). 
procedure append(var f:text);
pour écrire à la suite d'un fichier existant déjà. 
procedure reset(var f:text);
pour lire un fichier existant déjà à partir du début.

les procédures read, write, readln et writeln

On peut les utiliser autant qu'on veut tant que le fichier est ouvert. On peut utiliser read et readln sur un fichier ouvert en lecture par reset. On peut utiliser write et writeln sur un fichier ouvert en écriture par rewrite ou append.
Sur un fichier ouvert en lecture, on peut aussi utiliser les deux fonctions booléennes eof et eoln. eof(f) est vrai si on est à la fin (End Of File) du fichier f, et qu'il n'y a donc plus rien à lire dedans. eoln(f) est vrai si on est à la fin d'une ligne (End Of LiNe) dans le fichier f, et qu'il n'y a donc plus rien à lire avant le passage à la ligne.

la procédure de fermeture

close(f) permet de fermer le fichier f quand on n'a plus rien à lire ou à écrire dedans.
Lorsque l'on veut être sûr que les données sont bien écrites sur le disque et ne restent pas en attente dans un tampon en mémoire, on peut appeler close(f) suivi immédiatement par append(f) si on veut continuer à écrire dans le fichier. On peut aussi remplacer ces deux appels par un seul appel : flush(f), qui s'assure que toutes les données qui sont encore dans le tampon de f sont bien écrites dans f, en gardant f ouvert.

TD :

Ecrire le programme vu en cours qui lit le fichier pi.txt et l'affiche sur l'écran.
Ecrire un programme qui affiche la suite des longueurs des mots du fichier pi.txt.
Ecrire un programme qui demande un nom de fichier puis affiche le nombre de 'e' dans ce fichier.
Ecrire un programme qui demande un nom de fichier existant et un nom de fichier à créer, et qui met dans le deuxième fichier, une copie du premier dans laquelle on a enlevé tous les blancs qui suivent un autre blanc, autrement dit, les groupes de plusieurs blancs consécutifs sont remplacés par un seul blanc.
suivant précédent sommaire

mercredi 30 mars 2005 : fichiers binaires

write et writeln

write et writeln peuvent avoir un nombre quelconque d'arguments mais on peut toujours se ramener à au cas où write a deux arguments : un premier de type text et un second de type caractère, chaîne de caractères, entier, réel ou booléen et où writeln a un seul argument de type text. Pour cela il suffit d'appliquer les trois règles suivantes :
1) Si le premier argument n'est pas un fichier, alors tout se passe comme si on avait ajouté output comme argument supplémentaire en tête. Par exemple writeln('i=',i) est équivalent à writeln(output,'i=',i)
2) Un writeln avec plusieurs arguments est équivalent à un write avec les mêmes arguments suivi d'un writeln appliqué seulement au fichier. Par exemple writeln(output,'i=',i) est équivalent à begin write(output,'i=',i); writeln(output) end
3) Un write avec plus de deux arguments revient à écrire dans le même fichier, qui est le premier argument, successivement, dans l'ordre chacun des autres arguments. Par exemple write(output,'i=',i) est équivalent à begin write(output,'i='); write(output,i) end
En appliquant ces trois règles on obtient par exemple que writeln('i=',i) est équivalent à begin write(output,'i='); write(output,i); writeln(output) end
Le deuxième argument d'un write peut être un caractère, une chaîne de caractères, un entier, un réel ou un booléen. On peut préciser sur combien de caractères il doit être écrit. Cela rajoute éventuellement des blancs à gauche. Par exemple, sur chaque ligne qui suit, les deux instructions sont équivalentes. 
write(f,34)         write(f,'34')
write(f,34:4)       write(f,'  34')
write(f,'ab':4)     write(f,'  ab')
write(f,3=3)        write(f,'TRUE')
write(f,3=3:2)      write(f,'TRUE')
write(f,3=4:8)      write(f,'   FALSE')
writeln(f,3.4)      write(f,' 3.4000000000000000E+0000')
writeln(f,3.4:6)    write(f,' 3.4E+0000')
writeln(f,3.4:6:2)  write(f,'  3.40')
writeln(f,3.4:6:0)  write(f,'     3')
Pour les réels, on peut préciser aussi le nombre de chiffres après le point que l'on veut écrire. Dans ce cas on n'utilise pas la notation exponentielle E+0003. Si on demande zéro chiffre décimal, le point n'est pas écrit.
writeln(f) écrit un passage à la ligne dans le fichier. Un fichier text peut être considéré comme une suite de caractères et de passages à ligne. Une ligne est l'ensemble des caractères se trouvant entre deux passages à la ligne. Une ligne vide correspond à deux passages à la lignes qui se suivent directement sans aucun caractère entre eux.

read et readln

read et readln peuvent avoir un nombre quelconque d'arguments mais on peut toujours se ramener à au cas où read a deux arguments : un premier de type text et un second de type caractère, chaîne de caractères, entier, réel ou booléen et où readln a un seul argument de type text. Pour cela il suffit d'appliquer les trois règles suivantes :
1) Si le premier argument n'est pas un fichier, alors tout se passe comme si on avait ajouté input comme argument supplémentaire en tête. Par exemple readln(j,i) est équivalent à readln(input,j,i)
2) Un readln avec plusieurs arguments est équivalent à un read avec les mêmes arguments suivi d'un readln appliqué seulement au fichier. Par exemple readln(input,j,i) est équivalent à begin read(input,j,i); readln(input) end
3) Un read avec plus de deux arguments revient à lire dans le même fichier, qui est le premier argument, successivement, dans l'ordre chacun des autres arguments. Par exemple read(input,j,i) est équivalent à begin read(input,j); read(input,i) end
En appliquant ces trois règles on obtient par exemple que readln(j,i) est équivalent à begin read(input,j); read(input,i); readln(input) end
read appliqué à une variable de type caractère lit un caractère. On ne doit pas le faire quand on est en fin de ligne, c'est-à-dire si la prochaine chose à lire est un passage à la ligne.
read appliqué à une chaine de charactères lit autant de caractères que possible, c'est-à-dire jusqu'à la fin de la ligne où j'usqu'à ce que la chaîne de caractères ait sa longueur maximale. On ne change jamais de ligne (on ne mange jamais de passage à la ligne).
readln mange le prochain passage à la ligne ainsi que tous les caractères qui le précèdent. Il fait donc passer au début de la ligne suivante en ignorant la fin la ligne courante.
La lecture d'un nombre (entier ou réel) se fait en ignorant d'abord tous les blancs et les passages à la ligne qui précèdent ce nombre. Après le nombre il doit y avoir un blanc qui est mangé ou un passage à la ligne qui est laissé.
Par exemple si on a déclaré
var s,t:string[4];
    c,d:char;
    i,j:integer;
et que f correspond à un fichier contenant 
abcdef<cr>
<cr>
 12 3456<cr>
ghi<cr>
klmnopqrstuvwx<cr>
<cr>
7 8 9<cr>
Les instructions 
readln(f,s,t,i,c,d,j);
readln(s,t);
readln(s,t);
read(i,c,d,j)
sont équivalentes à 
s:='abcd'; t:='ef'; i:=12; c:='3'; d:='4'; j:=56;
s:='ghi'; t:='';
s:='klmn'; t:='opqr';
i:=7; c:='8'; d:=' '; j:=9

fichiers binaires


var f:file of integer;
    j:integer;
begin
  assign(f,'10a1');
  rewrite(f);
  for j:=10 downto 1 do write(f,j);
  close(f)
end.
<pre><xmp>
var g:file of integer; j:integer; begin assign(g,'10a1'); reset(g); while not eof(g) do begin read(g,j); write(j:5) end; readln end.

TD :

exercice 1

Ecrire un programme qui crée un fichier d'entiers dont on demande à l'utilisateur le nom puis le contenu. L'exécution pourra ressembler à 
Nom du fichier d'entiers à créer : truc
Contenu du fichier : 10 20 13 2 4
5 -8 -9 10 40 a
On pourra utiliser une boucle infinie, comme repeat ... until false, pour remplir le fichier. On sortira de cette boucle en tapant une lettre au lieu d'un chiffre. Cela provoque une erreur d'entrée-sortie qui normalement arrête l'exécution du programme, mais que l'on peut récupérer en remplaçant read(j) par 

  (*$i-*)
  read(j);
  if ioresult<>0 then break
  (*$i+*)
ioresult est une fonction qui rend 0 si la dernière entrée-sortie s'est effectuée sans erreur, et sinon un nombre qui indique quelle erreur a eu lieu.
break fait sortir d'une boucle for ou repeat.
(*$i-*) et (*$i+*) sont des faux commentaires car ils commencent par un dollar. (*$i+*) indique que dans ce qui suit, toute instruction d'entrée-sortie qui se passe mal provoque l'arrêt immédiat du programme. (*$i-*) indique que dans ce qui suit, une instruction d'entrée-sortie qui se passe mal ne provoquera l'arrêt du programme que si on essaye d'exécuter une autre instruction d'entrée-sortie sans avoir entre temps appelé la fonction ioresult.

exercice 2

Ecrire un programme qui demande à l'utilisateur un nom de fichier d'entiers et qui affiche son contenu à l'écran.

exercice 3

Ecrire un programme qui demande à l'utilisateur un nom de fichier d'entiers et ajoute 1 à chacun de ses éléments.

exercice 4

Ecrire un programme qui échange le plus petit et le plus grand des éléments d'un fichier d'entiers

exercice 5

Ecrire un programme qui trie dans l'ordre croissant les éléments d'un fichier d'entiers
suivant précédent sommaire

mercredi 6 avril 2005 : fichiers

lecture d'un fichier binaire à l'envers

var f:file of integer;
    j,k:integer;
begin
  assign(f,'truc');
  reset(f);
  for j:=filesize(f)-1 downto 0 do
  begin
    seek(f,j);
    read(f,k);
    write(k,' ')
  end;
  close(f)
end.

var f:file of integer;
    k:integer;
begin
  assign(f,'truc');
  append(f);
  while not eof(f) do
  begin
    seek(f,filepos(f)-1):
    read(f,k);
    seek(f,filepos(f)-1):
    write(k,' ')
  end;
  close(f)
end.

modification de fichiers, mélange de read et de write

var f:file of integer;
    j:integer;
begin
  assign(f,'truc');
  reset(f);
  while not eof(f) do
  begin
    read(f,j);
    write(f,j)
  end;
  close(f)
end.
Ce programme duplique un élément sur deux. Par exemple si le fichier contenait 23 4 56 32 7 avant l'exécution du programme, son contenu devient 23 23 56 56 7 7. Le premier write a remplacé 4 par 23, le second a remplacé 32 par 56 et le troisième a créé un nouvel enregistrement à la fin du fichier contenant 7. 

var f:file of integer;
    j:integer;
begin
  assign(f,'truc');
  append(f);
  while filepos(f)>2 do
  begin
    seek(f,filepos(f)-3);
    read(f,j);
    write(f,j)
  end;
  close(f)
end.
Si par exemple le fichier contenait 23 4 56 32 7 avant l'exécution du programme, son contenu devient 23 23 4 56 7. A la première itération de la boucle, 32 est remplacé par 56. A la deuxième le premier 56 est remplacé par 4. A la deuxième le premier 4 est remplacé par 23.

la fonction readkey

La fonction readkey rend le prochain caractère tapé au clavier. Ce caractère n'est pas affiché sur l'écran et il n'a pas besoin d'être validé par la touche entrée. On n'a donc pas droit à l'erreur : On ne peut pas le supprimer en tapant la touche backspace, comme avec read(input, ...) . Cette fonction se trouve dans l'unité crt. 
uses crt;
var c:char;
begin
  repeat
    c:=readkey;
    writeln(ord(c))
  until (c='q') or (c='Q') or (c=#3)
end.
Le programme précédent lit un caractère au clavier et affiche son code ascii à l'écran, puis recommence jusqu'à ce que l'on tape Q ou <ctrl>C. A donne 65, B donne 66, C donne 67, ..., Z donne 90, a donne 97, b donne 98, c donne 99, ..., z donne 122, + donne 43, - donne 45, l'espace donne 32. Ce programme permet donc de connaître les codes ascii de certains caractères, mais il permet surtout de savoir quels caractères donnent les touches spéciales du clavier. Par exemple la touche backspace donne le caractère de code ascii 8, noté #8 en pascal. Les touches de déplacement du curseur donnent deux caractères #0 et un autre : à droite #0 #77, à gauche #0 #75, en haut #0 #72, en bas #0 #80. La touche insertion donne #0 #82. La touche suppression donne #0 #83. La touche échapement donne #27. <ctrl>A donne #1, <ctrl>B donne #2, <ctrl>C donne #3, etc..

TD :

exercice 1

Ecrire un programme appelé sommefic.pas qui lit deux fichiers d'entiers et en crée un troisième qui contient la somme des premiers éléments, puis la somme des seconds éléments etc.. Il devra d'abord demander le nom des trois fichiers. 
truc : 7 3 5 ...
machin : 8 4 3 ...
->
bidule : 15 7 8 ...

exercice 2

Ecrire un programme appelé doubledemific.pas qui modifie un fichier d'entiers. Chaque nombre pair est remplacé par sa moitié et chaque nombre impair par son double. Il devra d'abord demander le nom du fichier. 
truc : 20 10 7 3 5 8
->
truc : 10 5 14 6 10 4

exercice 3

Ecrire un programme appelé concatfic.pas qui lit deux fichiers d'entiers et en crée un troisième qui contient les deux premiers mis bout à bout. Il devra d'abord demander le nom des trois fichiers. 
truc : 3 4 7
machin : 6 4 2 8
->
bidule : 3 4 7 6 4 2 8
suivant précédent sommaire

mercredi 13 avril 2005 : système d'équations linéaires

On veut résoudre le système d'équations linéaires suivant par la méthode du pivot de Gauss. 
2x+4y+z=5
3x+9y+z=6
 x+ y+z=3
Dans la première colonne, parmi 3, 3 et 1, le coefficient ayant la plus grande valeur absolue est 3. Il se trouve sur la deuxième ligne. On échange donc les deux premières équations pour amener le 3 (le pivot) en haut à gauche. 
3x+9y+z=6
2x+4y+z=5
 x+ y+z=3
On divise la première équation par 3, pour remplacer le pivot par 1. 
 x+3y+(1/3)z=2
2x+4y+     z=5
 x+ y+     z=3
On soustrait le double de la première équation à la seconde pour en éliminer les x. Eq2:=Eq2-2Eq1 On soustrait la première équation à la troisième pour en éliminer les x. Eq3:=Eq3-Eq1 
 x+3y+(1/3)z=2
  -2y+(1/3)z=1
  -2y+(2/3)z=1
On recommence les opérations précédentes avec le système des deux dernières équations. -2 et -2 ont la même valeur absolue. On n'a donc pas besoin d'échanger les deux dernières équations.
On divise l'équation 2 par -2. 
 x+3y+(1/3)z=2
    y-(1/6)z=-1/2
  -2y+(2/3)z=3
On ajoute le double de la deuxième équation à la troisième pour en éliminer y. 
 x+3y+(1/3)z=2
    y-(1/6)z=-1/2
     -(1/3)z=0
On divise la troisième équation par -1/3. 
 x+3y+(1/3)z=2
    y-(1/6)z=-1/2
           z=0
On a maintenant un système triangulaire supérieur, avec des 1 sur la diagonale. On peut le résoudre en calculant d'abord z, puis y et enfin x. 
z=0
y=-1/2+(1/6)z=-1/2+(1/6)0=-1/2
x=2-3y-(1/3)z=2-3(-1/2)-(1/3)0=7/2
On a utilisé l'algorithme suivant, écrit en pseudo-pascal 
for m:=1 to 3 do
begin
  Dans la colonne M dans les lignes M à 3, on cherche
  le coefficient ayant la plus grande valeur absolue.
  Soit J le numéro de sa ligne.

  On échange les équations J et M.
  Eqm:=Eqm/a[m,m]
  for j:=m+1 to 3 do
  begin
    Eqj:=Eqj-a[m,j]Eqm
  end
end
for j:=3 downto 1 do
begin
  x[j]:=b[j]-∑k=j+1dima[j,k] x[k]
end
En pascal cela donne : 
procedure resoutgauss(a:mat;b:vec;var x:vec); (* A X=B *)
var m,j,k:integer;
    l:vec;
    p,s:real;
begin
  for m:=1 to dim do
  begin
    (* On met dans J le numéro de la ligne où se trouve le plus grand
    en valeur absolue parmi les nombres situé dans la colonne M sur la diagonale
    et en dessous.
    abs(a[j,m])=maxm≤k≤dimabs a[k,m] *)
    j:=m;
    for k:=m+1 to dim do if abs(a[k,m])>abs(a[j,m]) then j:=k;

    (* On échange les équations J et M pour amener ce grand coefficient
    sur la diagonale. On l'appellera le pivot. *)
    l:=a[j]; a[j]:=a[m]; a[m]:=l;
    s:=b[j]; b[j]:=b[m]; b[m]:=s;

    (* On divise la ligne du pivot par le pivot.
    eqm:=eqm/a[m,m] *)
    p:=a[m,m]; (* ancienne valeur du pivot (a[m,m] va devenir 1) *)
    for k:=m to dim do a[m,k]/=p;
    b[m]/=p;

    for j:=m+1 to dim do  (* pour chaque ligne J en dessous du pivot *)
    begin 
      (* On soustrait un multiple de la ligne du pivot à la ligne J de façon à faire
      apparaître un 0 dans la colonne du pivot.
      eqj:=eqj-a[j,m]*eqm *)
      p:=a[j,m];  (* ancienne valeur de a[j,m]. La nouvelle valeur est 0 *)
      for k:=m to dim do a[j,k]-=p*a[m,k];
      b[j]-=p*b[m]
    end
  end;
  (* Le système est maintenant triangulaire supérieur avec des 1 sur la diagonale.
  Il faut maintenant résoudre ce système. *)
  for j:=dim downto 1 do
  begin
    (* La ligne J du système A X=B est
    ∑k=1dima[j,k] x[k]=b[j]
    Puisque A est triangulaire supérieure, a[j,k] est nul si k>j et vaut 1 si k=j. Donc :
    x[j]+∑k=j+1dima[j,k] x[k]=b[j]
    On peut donc calculer :
    x[j]:=b[j]-∑k=j+1dima[j,k] x[k]
    On calculera donc dans l'ordre
    x[dim  ]:=b[dim]
    x[dim-1]:=b[dim-1]-a[dim-1,dim]*x[dim]
    x[dim-2]:=b[dim-2]-a[dim-2,dim]*x[dim]-a[dim-2,dim-1]*x[dim-1]
    ... *)
    s:=b[j];
    for k:=j+1 to dim do s-=a[j,k]*b[k];
    x[j]:=s
  end
end;

TD :

exercice 1

Intégrer la procédure vue en cours dans un programme qui résout le système vu en exemple en cours.

exercice 2

Si trois matrices vérifient A B=C alors A Bi=Ci où Bi et Ci représentent les ièmes colonnes de B et C. Utiliser cette propriété pour calculer l'inverse d'une matrice A colonne par colonne, en résolvant tous les sytèmes d'équations linéaires ayant pour matrice A et pour membre droit une colonne de la matrice identité.
suivant précédent sommaire

mercredi 20 avril 2005 : polynômes

const dmax=30;
type real=extended;
     poly=array[0..dmax] of real;
procedure litpoly(var a:poly);
var j:integer;
begin
  for j:=0 to dmax do a[j]:=0;
  for j:=0 to dmax do
  begin
    (*$i-*)
    read(a[j]);
    (*$i+*)
    if ioresult<>0 then exit
  end
end;
procedure ecritpoly(a:poly);
var j:integer;
    nul:boolean;
    x:real;
begin
  nul:=true;
  for j:=0 to dmax do if a[j]<>0 then
  begin
    if a[j]<0 then write('-') else
    if not nul then write('+');
    nul:=false;
    x:=abs(a[j]);
    if x=int(x) then if (x<>1) or (j=0) then write(x:0:0)
                                        else
                else write(x:0:4);
    case j of
      0:;
      1:write('X');
    //2:write('X²');
      else write('X^',j)
    end
  end;
  if nul then write(0)
end;
procedure addpol(a,b:poly;var c:poly); // c:=a+b
var j:integer;
begin
  for j:=0 to dmax do c[j]:=a[j]+b[j]
end;
procedure subdpol(a,b:poly;var c:poly); // c:=a-b
var j:integer;
begin
  for j:=0 to dmax do c[j]:=a[j]-b[j]
end;
function degre(a:poly):integer;
var j:integer;
begin
  degre:=-1;
  for j:=0 to dmax do if a[j]<>0 then degre:=j
end;
procedure mulpol(a,b:poly;var c:poly); // c:=a*b
var da,db,j,k:integer;
begin
  da:=degre(a);
  db:=degre(b);
  if da+db>dmax then
  begin
    write('Le produit de '); ecritpoly(a); write(' et de ');
    ecritpoly(b); writeln(' a un degre trop eleve.');
    halt
  end;
  for j:=0 to dmax do c[j]:=0;
  for j:=0 to da do if a[j]<>0 then
  for k:=0 to db do c[j+k]+=a[j]*b[k]
end;
function valpol(a:poly;x:real):real;
var v:real;
    j:integer;
begin
  v:=0;
  for j:=dmax downto 0 do v:=v*x+a[j];
  valpol:=v
end;
procedure derpol(a:poly;var b:poly); // b:=a'
var j:integer;
begin
  for j:=1 to dmax do b[j-1]:=j*a[j];
  b[dmax]:=0
end;

TD :

Avec les procédures vues en cours, écrire un programme qui calcule les deux polynômes ∏i=14(1-Xi) et ∏i=14(X2+i X-1). 
var a,b:poly;
    j:integer;
begin
  for j:=0 to dmax do a[j]:=0;
  a[0]:=1;
  b:=a;
  for j:=1 to 4 do
  begin
    b[j]:=-1;
    mulpol(a,b,a);
    b[j]:=0
  end;
  ecritpoly(a); writeln;// ∏i=14(1-Xi)
  for j:=0 to dmax do a[j]:=0;
  a[0]:=1;
  b:=a;
  b[0]:=-1;
  b[2]:=1;
  for j:=1 to 4 do
  begin
    b[1]:=j;
    mulpol(a,b,a)
  end;
  ecritpoly(a); writeln;// ∏i=14(X2+i X-1)
  readln
end.
Ce programme écrit : 
1-X-X^2+2X^5-X^8-X^9+X^10
1-10X+31X^2-20X^3-40X^4+20X^5+31X^6+10X^7+X^8
suivant précédent sommaire

mercredi 11 mai 2005 : tableaux à deux dimensions


type tab=array[1..6,1..6] of integer;

procedure affdiag1(a:tab);
var j:integer;
begin
  for j:=1 to 6 do write(a[j,j])
end;

procedure affdiag2(a:tab);
var j:integer;
begin
  for j:=1 to 6 do write(a[j,7-j])
end;

procedure aff1(a:tab);
var j,k:integer;
begin
  for j:=1 to 6 do
  for k:=1 to 6 do write(a[j,k])
end;

procedure aff2(a:tab);
var j,k:integer;
begin
  for j:=1 to 6 do
  for k:=1 to 6 do write(a[j,k]:3)
end;

procedure aff3(a:tab);
var j,k:integer;
begin
  for j:=1 to 6 do
  for k:=1 to 6 do writeln(a[j,k]:3)
end;

procedure affmat(a:tab);
var j,k:integer;
begin
  for j:=1 to 6 do
  begin
    for k:=1 to 6 do write(a[j,k]:3);
    writeln
  end
end;

procedure affmat2(a:tab);
var j,k:integer;
begin
  writeln;
  for j:=1 to 6 do
  begin
    for k:=1 to 6 do write(a[j,k]:3);
    writeln
  end
end;

procedure affmat3(a:tab);
var j,k:integer;
begin
  writeln;
  for j:=6 downto 1 do
  begin
    for k:=1 to 6 do write(a[k,j]:3);
    writeln
  end
end;

procedure transpose(a:tab;var b:tab);
var x,y:integer;
begin
  for x:=1 to 6 do
  for y:=1 to 6 do b[x,y]:=a[y,x]
end;

procedure miroirhorizontal(a:tab;var b:tab);
var x,y:integer;
begin
  for x:=1 to 6 do
  for y:=1 to 6 do b[x,y]:=a[7-x,y]
end;

procedure miroirhorizontalfaux(var a:tab;var b:tab);
var x,y:integer;
begin
  for x:=1 to 6 do
  for y:=1 to 6 do b[x,y]:=a[7-x,y]
end;

procedure miroirvertical1(a:tab;var b:tab);
var x,y:integer;
begin
  for x:=1 to 6 do
  for y:=1 to 6 do b[x,y]:=a[x,7-y]
end;

procedure miroirvertical2(a:tab;var b:tab);
begin
  transpose(a,b);
  miroirhorizontal(b,b);
  transpose(b,b)
end;

var a,b:tab;
    j,k:integer;
begin
  for j:=1 to 6 do
  for k:=1 to 6 do a[j,k]:=10*j+k;
  affdiag1(a); affdiag2(a); aff1(a); aff2(a);
  write('matrice A : '); aff3(a); 
  write('matrice A : '); affmat(a); 
  write('matrice A : '); affmat2(a); 
  write('matrice A : '); affmat3(a);
  transpose(a,b); affmat2(b); 
  miroirhorizontal(a,b); affmat2(b); 
  miroirvertical1(a,b); affmat2(b); 
  miroirvertical2(a,b); affmat2(b); 
  miroirhorizontalfaux(a,a); affmat2(a); 
  readln
end.
Ce programme écrit : 
112233445566162534435261111213141516212223242526313233343536414243444546515253545556616263646566 11 12 13 14 15 16 21 22 23 24 25 26 31 32 33 34 35 36 41 42 43 44 45 46 51 52 53 54 55 56 61 62 63 64 65 66matrice A :  11
 12
 13
 14
 15
 16
 21
 22
 23
 24
 25
 26
 31
 32
 33
 34
 35
 36
 41
 42
 43
 44
 45
 46
 51
 52
 53
 54
 55
 56
 61
 62
 63
 64
 65
 66
matrice A :  11 12 13 14 15 16
 21 22 23 24 25 26
 31 32 33 34 35 36
 41 42 43 44 45 46
 51 52 53 54 55 56
 61 62 63 64 65 66
matrice A : 
 11 12 13 14 15 16
 21 22 23 24 25 26
 31 32 33 34 35 36
 41 42 43 44 45 46
 51 52 53 54 55 56
 61 62 63 64 65 66
matrice A : 
 16 26 36 46 56 66
 15 25 35 45 55 65
 14 24 34 44 54 64
 13 23 33 43 53 63
 12 22 32 42 52 62
 11 21 31 41 51 61

 11 21 31 41 51 61
 12 22 32 42 52 62
 13 23 33 43 53 63
 14 24 34 44 54 64
 15 25 35 45 55 65
 16 26 36 46 56 66

 61 62 63 64 65 66
 51 52 53 54 55 56
 41 42 43 44 45 46
 31 32 33 34 35 36
 21 22 23 24 25 26
 11 12 13 14 15 16

 16 15 14 13 12 11
 26 25 24 23 22 21
 36 35 34 33 32 31
 46 45 44 43 42 41
 56 55 54 53 52 51
 66 65 64 63 62 61

 16 15 14 13 12 11
 26 25 24 23 22 21
 36 35 34 33 32 31
 46 45 44 43 42 41
 56 55 54 53 52 51
 66 65 64 63 62 61

 61 62 63 64 65 66
 51 52 53 54 55 56
 41 42 43 44 45 46
 41 42 43 44 45 46
 51 52 53 54 55 56
 61 62 63 64 65 66

TD :

Ecrire un programme qui quand on l'exécute affiche par exemple : 
taille du carré : 6
  1  2  3  4  5  6
 20 21 22 23 24  7
 19 32 33 34 25  8
 18 31 36 35 26  9
 17 30 29 28 27 10
 16 15 14 13 12 11
Corrigé : 
const dim=20;
var a:array[1..dim,1..dim] of integer;
    i,j,dx,dy,z,k,n:integer;
begin
  write('Taille du carre : ');
  readln(n);
  for i:=1 to n do
  for j:=1 to n do a[i,j]:=0;
  i:=1;
  j:=1;
  dx:=0;
  dy:=1;
  for k:=1 to n*n do
  begin
    a[i,j]:=k;
    if (i+dx>0) and (i+dx<=n) and
       (j+dy>0) and (j+dy<=n) and (a[i+dx,j+dy]=0) then else
    begin
      z:=dx; dx:=dy; dy:=-z
    end;
    i+=dx;
    j+=dy
  end;
  for i:=1 to n do
  begin
    for j:=1 to n do write(a[i,j]:4);
    writeln
  end;
  readln
end.
suivant précédent sommaire

mercredi 18 mai 2005 : méthode de Newton

type real=extended;
function f(x:real):real;
begin
  f:=sin(x)/cos(x)-x
end;
function fp(x:real):real;
begin
  fp:=1/sqr(cos(x))
end;
function newton(x:real):real;
var y:real;
begin
  repeat
    y:=x;
    x-=f(x)/fp(x)
  until x=y;
  newton:=x
end;
var i:integer;
    x:real;
begin
  for i:=1 to 10 do
  begin
    x:=newton((i+0.5)*3.14);
    writeln(i:2,x:30:22,sin(x)/cos(x):30:22)
  end
end.
Le programme précédent écrit : 
 1           4.49340945790906420           4.49340945790906420
 2           7.72525183693770720           7.72525183693770720
 3          10.90412165942890000          10.90412165942890000
 4          14.06619391283147300          14.06619391283147400
 5          17.22075527193076900          17.22075527193076900
 6          20.37130295928756300          20.37130295928756300
 7          23.51945249868900700          23.51945249868900700
 8          26.66605425881267400          26.66605425881267400
 9          29.81159879089295900          29.81159879089296000
10          32.95638903982247700          32.95638903982247700

const dmax=30;
type real=extended;
     poly=array[0..dmax] of real;
function degre(a:poly):integer;
var j:integer;
begin
  degre:=-1;
  for j:=0 to dmax do if a[j]<>0 then degre:=j
end;
function valpol(a:poly;x:real):real;
var v:real;
    j:integer;
begin
  v:=0;
  for j:=dmax downto 0 do v:=v*x+a[j];
  valpol:=v
end;
procedure derpol(a:poly;var b:poly); // b:=a'
var j:integer;
begin
  for j:=1 to dmax do b[j-1]:=j*a[j];
  b[dmax]:=0
end;
function newtonpol(p:poly;x:real):real;
var dp:poly;
    y,z:real;
begin
  derpol(p,dp);
  y:=x;
  repeat
    z:=y; y:=x;
    x-=valpol(p,x)/valpol(dp,x)
  until x=z;
  newtonpol:=x
end;
function newtonpol2(p:poly;x:real):real;
var dp:poly;
    y,z,px,dpx:real;
    j,d:integer;
begin
  d:=degre(p);
  derpol(p,dp);
  y:=x;
  repeat
    z:=y; y:=x;
    px:=0;
    dpx:=0;
    for j:=d downto 0 do
    begin
      dpx:=dpx*x+dp[j];
       px:= px*x+ p[j]
    end;
    x-=px/dpx
  until x=z;
  newtonpol2:=x
end;
function newtonpol3(p:poly;x:real):real;
var y,z,px,dpx:real;
    j,d:integer;
begin
  d:=degre(p);
  y:=x;
  repeat
    z:=y; y:=x;
    px:=0;
    dpx:=0;
    for j:=d downto 0 do
    begin
      dpx:=dpx*x+px;
       px:= px*x+p[j]
    end;
    x-=px/dpx
  until x=z;
  newtonpol3:=x
end;
var a:poly;
    i:integer;
begin
  for i:=0 to dmax do a[i]:=0;
  a[0]:=1;
  a[2]:=-5;
  a[4]:=1;
  for i:=-3 to 3 do if odd(i) then
  writeln(i:2,newtonpol(a,i):25:20,newtonpol2(a,i):25:20,newtonpol3(a,i):25:20)
end.
Le programme précédent écrit : 
-3     -2.18890105931673390     -2.18890105931673390     -2.18890105931673390
-1     -0.45685025174785665     -0.45685025174785665     -0.45685025174785665
 1      0.45685025174785665      0.45685025174785665      0.45685025174785665
 3      2.18890105931673390      2.18890105931673390      2.18890105931673390
La procédure newtonpol utilise la fonction valpol qui fait une boucle de 30 à 0. Les 26 premières itérations de cette boucle calculent 0*x+0=0. La procédure newtonpol2 fait exactement les mêmes calculs sans faire ces 26 premières itérations inutiles. La procédure newtonpol3 fait à peu près les mêmes calculs que newtopol2, sans utiliser la variable DP qui contenait le polynôme dérivé de P. Sa boucle calcule : 
dpx:=0
px :=0
dpx:=0*x+0=0
px :=0*x+a=a
dpx:=0*x+a=a
px :=a*x+b
dpx:=a*x+(a*x+b)=2*a*x+b
px :=(a*x+b)*x+c=a*x2+b*x+c
dpx:=(2*a*x+b)*x+(a*x2+b*x+c)=3*a*x2+2*b*x+c
px :=(a*x2+b*x+c)*x+d=a*x3+b*x2+c*x+d
On voit que l'expression de dpx est bien la dérivée par rapport à x de l'expression de dx.
suivant précédent sommaire

mercredi 25 mai 2005 : dichotomie

type real=extended;
     fonc=function(a:real):real;

function newton(f,df:fonc;x:real):real;
var j,n:integer;
    y:real;
begin
  for j:=1 to 1000 do
  begin
    y:=x;
    for n:=1 to 10 do
    begin
      x-=f(x)/df(x);
      if x=y then begin newton:=x; exit end
    end
  end;
  writeln('raté'); readln; halt
end;

function f1 (x:real):real;begin f1 :=sin(x)/cos(x)-x end;
function f1p(x:real):real;begin f1p:=1/sqr(cos(x))-1 end;
function f2 (x:real):real;begin f2 :=1/(1+x*x)-0.7   end;
function f2p(x:real):real;begin f2p:=-2*x/sqr(1+x*x) end;
function f3 (x:real):real;begin f3 :=x*x-3*x+2       end;
function f3p(x:real):real;begin f3p:=2*x-3           end;
function f4 (x:real):real;begin f4 :=x*ln(x)         end;
function dichotomie(f:fonc;a,b:real):real;
var m,fa,fb:real;
begin
  fa:=f(a);
  fb:=f(b);
  if fa=0 then dichotomie:=a else
  if fb=0 then dichotomie:=b else
  if (fa<0)=(fb<0) then begin write('raté');readln;halt end else
  if fa>0 then dichotomie:=dichotomie(f,b,a) else
  repeat
    m:=(a+b)/2;
    if (m=a) or (m=b) then begin dichotomie:=a; break end;
    if f(m)<0 then a:=m
              else b:=m
  until false
end;
function minconv(f:fonc;a,b,c:real):real;
var m:real;
begin
  repeat
    if abs(a-b)>abs(b-c) then begin m:=a; a:=c; c:=m end;
    m:=(2*b+c)/3;
    if (m=b) or (m=c) then break;
    if f(m)<f(b) then begin a:=b; b:=m end
                 else             c:=m
  until false;
  minconv:=m
end;

begin
  writeln(newton(@f1,@f1p,4.5):25:20,dichotomie(@f1,4,4.7):25:20);
  writeln(newton(@f2,@f2p,1  ):25:20,dichotomie(@f2,0,1  ):25:20);
  writeln(newton(@f3,@f3p,4  ):25:20,dichotomie(@f3,1.1,5):25:20);
  writeln(minconv(@f3,0   ,5  ,10):25:20,1.5    :25:20);
  writeln(minconv(@f4,0.01,0.5,1 ):25:20,exp(-1):25:20);
  readln
end.
Le programme précédent écrit : 
      4.49340945790906420      4.49340945790906420
      0.65465367070797714      0.65465367070797714
      2.00000000000000000      2.00000000000000000
      1.49999999956980420      1.50000000000000000
      0.36787944111355262      0.36787944117144232
précédent sommaire

TD : mercredi 1er juin 2005 : affichage de tableaux carrés

Ecrire un programme qui lit un nombre n puis affiche des tableaux carrés de tailles n selon l'exemple suivant : 
Donnez un nombre : 5

1 1 1 1 1
1 1 1 1 1
1 1 1 1 1
1 1 1 1 1
1 1 1 1 1

1 2 3 4 5
1 2 3 4 5
1 2 3 4 5
1 2 3 4 5
1 2 3 4 5

1 1 1 1 1
2 2 2 2 2
3 3 3 3 3
4 4 4 4 4
5 5 5 5 5

1 1 1 1 1
1 2 2 2 2
1 2 3 3 3
1 2 3 4 4
1 2 3 4 5

1 2 3 4 5
2 3 4 5 6
3 4 5 6 7
4 5 6 7 8
5 6 7 8 9

1 0 0 0 1
0 1 0 1 0
0 0 1 0 0
0 1 0 1 0
1 0 0 0 1

1  6 10 13 15
0  2  7 11 14
0  0  3  8 12
0  0  0  4  9
0  0  0  0  5

2 1 0 0 1 2 1 0 0 1 2   (si n=11)
1 2 1 0 1 2 1 0 1 2 1
0 1 2 1 1 2 1 1 2 1 0
0 0 1 2 1 2 1 2 1 0 0
1 1 1 1 2 2 2 1 1 1 1
2 2 2 2 2 2 2 2 2 2 2
1 1 1 1 2 2 2 1 1 1 1
0 0 1 2 1 2 1 2 1 0 0
0 1 2 1 1 2 1 1 2 1 0
1 2 1 0 1 2 1 0 1 2 1
2 1 0 0 1 2 1 0 0 1 2
On fera deux versions du programme :
Une première version qui remplit un tableau à deux dimensions puis l'affiche (en utilisant une procédure).
Une deuxième qui n'utilisera aucun tableau.

fichiers

Ecrire un programme qui copie un fichier de texte dans un autre en renversant l'ordre des lettres dans chaque mot. Par exemple, si le fichier marquise.txt contient
Marquise, vos beaux yeux me font mourir d'amour.
Lors de l'exécution du programme on verra :
Quel fichier voulez-vous renverser ? marquise.txt
Comment voulez-vous appeler la copie renversée ? esiuqram.txt
Le fichier esiuqram.txt sera créé et contiendra :
esiuqraM, sov xuaeb xuey em tnof riruom d'ruoma.