Résolution système d'équations Gauss

Version imprimable

Salut à tous,

J'ai fait un programme de résolution d'équations de système linéaire. Seulement, si le déterminant est égal à 0, le programme ne fonctionne pas et je souhaiterais qu'íl me dise, par exemple, "résolution impossible". Du coup, je me demandais si je devais rajouter une procédure déterminant au début pour dire ensute if det différent de 0 then et lancer ma résolution d'équation. Mais je me demandais s'il n'y avait pas un truc plus simple, plus rapide ?

N'hésitez pas à commenter si j'ai une erreur dans mon programme :?

Merci

Elody

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
program Gauss;
uses crt;
 
var
    a:array[1..10,1..10] of real;
    x:array[1..10] of real;
    i,j,k,n:integer;
    P:real;
 
begin
 
//Creation de la matrice
Writeln('Matrix order ');
readln(n);
 
for i:=1 to n do
begin
  for j:=1 to n do
 
   begin
    write('A',i,j,' ');
    readln(a[i,j]);
   end;
   write('B',i,'  ');
   readln(a[i,n+1]);
end;
clrscr;
 
//Ecriture de la m
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    write(a[i,j]:4:4,' x',j);
    if j < n then write(' + ');
   end;
   writeln(' = ',a[i,n+1]:4:4);
 end;
 
 
 begin
  j:=1
   repeat
   write(a[i,j]:4:4,' x',j);
   if j < n then write(' + ');
   until j=n ;
 end;
  writeln(' = ',a[i,n+1]:4:4);
  end;
 
//Gauss procedure
 
for i:=1 to n-1 do
 for j:=i+1 to n do
 
  begin
  P:=a[j,i];
  for k:=1 to n+1 do
   a[j,k]:=a[j,k] - P*a[i,k]/a[i,i];
 end;
readln;
 
//Ecriture de Gauss
 
for i:=1 to n do
 
 
  j:=1
  while j = n do
   begin
    write(a[i,j]:4:4,' x',j);
    if j < n then write(' + ');
   end;
   writeln(' = ',a[i,n+1]:4:4);
 
//calculate the values of x
 
x[n] := a[n,n+1] / a[n,n];
 
begin
 i:=n
 repeat
 x[i]:=a[i,n+1];
 until i= 1;
 
  begin
   j:= i+1
   repeat
   x[i]:=x[i] - a[i,j]*x[j];
   until j=n;
 x[i]:=x[i]/a[i,i];
end;
 readln;
 
 
 //Resultats
 
while i = n do
 begin
 write('x',i,' = ',x[i]:4:4,'  ');
 readln;
 end;
 
end.

11/06/2015, 01h02
jurassic pork

hello ElodyE,
as-tu essayé de compiler ton programme ? avec quel compilateur ? parce que moi avec FPC 2.6.4 j'ai des erreurs de compilation du genre il manque des points virgules sur certaines lignes (ex : j:=1) ou des begin end mal placés.

Ami calmant, J.P

Bonjour.

Même si le code présenté passait la compilation, le programme ne marcherait pas correctement
car la méthode implémentée n'est pas totalement la méthode de Gauss.
Il manque une opération essentielle qu'il faut exécuter à chaque étape lorsque le terme a[i,i] est nul.

Remarque importante : les a[i,i] changent au cours du calcul !

Pour expliquer ce qu'est cette opération essentielle, je détaille ci-dessous la méthode de Gauss.

1ère étape :
Code:

1 2 3 4 5 Si a[1,1] n'est pas nul, l'utiliser comme premier pivot : pour j variant de 2 à n, remplacer ligne_j par (ligne_j - a[j,1]*ligne_1/a[1,1]) ; Si a[1,1] est nul, chercher un a[1,k] qui ne soit pas nul, pour k entre 2 et n ; si on n'en trouve pas, c'est que le déterminant est nul et on s'arrête là ; si on trouve un a[1,k] non nul, permuter colonne_1 et colonne_k, puis reprendre la 1ère étape.
2ème étape :
Code:

1 2 3 4 5 Si a[2,2] n'est pas nul, l'utiliser comme deuxième pivot : pour j variant de 3 à n, remplacer ligne_j par (ligne_j - a[j,2]*ligne_2/a[2,2]) ; Si a[2,2] est nul, chercher un a[2,k] qui ne soit pas nul, pour k entre 3 et n ; si on n'en trouve pas, c'est que le déterminant est nul et on s'arrête là ; si on trouve un a[2,k] non nul, permuter colonne_2 et colonne_k, puis reprendre la 2ème étape.
etc ...

On fait de même jusqu'a la (n-1)ème étape.

Si on peut exécuter ces (n-1) étapes sans que la méthode s'arrête, il reste alors à considérer a[n,n].

1er cas : a[n,n] est nul.
Dans ce cas le déterminant est nul et on s'arrête.

2ème cas : a[n,n] n'est pas nul.
Dans ce cas, le déterminant est, au signe près, le produit des pivots, a[n,n] étant le dernier pivot.
On résout alors le système restant par la méthode dite de la "remontée".
On trouve d'abord x[n] par a[n,n+1]/a[n,n].
Puis on trouve x[n-1,n-1] par (a[n-1,n+1]-a[n-1,n]*x[n])/a[n-1,n-1].
etc ...
On calcule ainsi les x[i] en remontant de i = n à i = 1.

Vouloir calculer le déterminant du système avant d'appliquer la méthode de Gauss est un non sens,
puisque le calcul du déterminant est justement un sous-produit de la méthode de Gauss.

Quant au code suivant :
Code:

1 2 3 4 5 6 7 8 //Gauss procedure for i:=1 to n-1 do for j:=i+1 to n do begin P:=a[j,i]; for k:=1 to n+1 do a[j,k]:=a[j,k] - P*a[i,k]/a[i,i]; end;
il serait correct si tous les termes a[i,i] rencontrés étaient non nuls.

Malheureusement, il n'y a aucune raison pour que cela soit le cas, même quand le déterminant du système est non nul.

Si ça peut aider

C'est un programme tiré d'un livre Basic et modifié:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
    for i:=0 to v do begin //l.280 //v est le nombre d'équation a résoudre
        for j:=i to v do//l.290 et l.305 //compréhension
            if a[j,i]<>0 then break;//l.300if ak[j,i]<>0 then break;//l.300
 
        if i<>j then for k:=0 to v+1 do begin//l.340 à 380:Interchange
            b:=a[i,k];//l.350//ak[i,k];//l.350
            a[i,k]:=a[j,k];//l.360;
            a[j,k]:=b;//l.370
            end;//l.380
//résolution du systeme d'équation
        try
            z:=1/a[i,i];//l.390
            for k:=i+1 to v+1 do //l.400               //****anciennement 0
                a[i,k]:=a[i,k]*z;//l.410
            a[i,i]:=1;
            for j:=0 to v do begin//l.430
                if j=i then continue;//l.440
                z:=-a[j,i];//l.450
                for k:=i+1 to v+1 do//l.460          //**anciennement 0
                a[j,k]:=a[j,k]+z*a[i,k];//l.470
                end;//l.490
        except
           exit;
           end
        end;//l.500
 
//coefficient de la droite : valeur des inconnues
    setlength(Coefficient,v+1);
    for i:=0 to v do//l.525 et 530//faire attention au zéro ici je considere que la constante est x^0
        coefficient[i]:=a[i,v+1];//l.540

Salut,

Merci à tous pour vos réponses, désolée j'ai pas eu le temps de répondre la semaine derniere...

J'ai un peu modifié mon programme, sauf que mes calculs ne se font pas !!! :calim2: :calim2: :calim2:

Voici le code, ouverte a toute suggestion toujours... merciiii

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
program Gauss;
uses crt;
type
     tmat=array[1..10,1..10] of real;
 
var
    a:array[1..10,1..10] of real;
    x:array[1..10] of real;
    i,j,k,l,n,m,found :integer;
    P, temp:real;
procedure writematrix (a:tmat);
var
    i,j : integer ;
    begin
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    write(a[i,j]:4:4,' x',j);
    if j < n then write(' + ');
   end;
   writeln(' = ',a[i,n+1]:4:4);
 end;
writeln;
     end;
 
begin
 
//Creation of the matrix
Writeln('Matrix order ');
readln(n);
 
for i:=1 to n do
begin
  for j:=1 to n do
 
   begin
    write('A',i,j,' ');
    readln(a[i,j]);
   end;
   write('B',i,'  ');
   readln(a[i,n+1]);
end;
clrscr;
 
Writematrix(a);
 
//Gaussian elimination
 
 
for i := 1 to n-1  do
 begin
  if a[i,i]<>0 then
  begin
 
  for k := i+1 to n do
    for l:= i to n+1 do
      a[k,l] := a[k,l] - (a[i,l]*a[k,i]/a[i,i]) ;  ;
    writematrix(a)
  end
 
  else
  begin
		    found:= 0 ;
          l:= i+1 ;
          while found =0 do
                begin
                 if a [i,l]<>0 then
                    begin
                         found := l ;
                         for m:= i to n do
                             begin
                             temp:=a[m,i]  ;
                             a[m,i]:=a[m,found] ;
                             a[m,found]:=temp ;
                             end ;
                         writematrix(a);
                         writeln('permutee')
					     end ;
                 if a [i,l] = 0 then
                    begin
                    l:= l+1 ;
                    if l>n then
                     found:=-1 ;
						  end;
					  end ;
          If found= -1 then
          begin
               writeln('impossible, enter to exit');
               readln;
               exit;
			 end
          else
          for k := i+1 to n do
              for l:= i to n+1 do
              a[k,l] := a[k,l] - (a[i,l]*a[k,i]/a[i,i]) ; ;
    end;
 
 end;
 If a[n,n] = 0
 then
 begin
      writeln('impossible, enter to exit') ;
      readln;
      exit;
 end;
readln;
 
 
//calculate the values of x
If a[i,i]= 0
then
begin
     writeln('det=0, press enter');
     readln;
     exit;
end
 
else
x[n] := a[n,n+1] / a[n,n];
 
for i:=n downto 1 do
begin
 x[i]:=a[i,n+1];
 for j:=i+1 to n do
  begin
   x[i]:=x[i] - a[i,j]*x[j];
  end;
 x[i]:=x[i]/a[i,i];
end;
 readln;
 
 
 //write the results
 
 for i:=1 to n do
 write('x',i,' = ',x[i]:4:4,'  ');
 readln;
 
end.

23/06/2015, 10h59
ElodyE

Probleme resolu. Merci à tous pour votre aide.

Elody