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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
| unit gencol;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,saisie,matrice2, StdCtrls, Buttons,fformul;
type
Tfgencol = class(TForm)
BitBtn1: TBitBtn;
ScrollBox1: TScrollBox;
procedure FormActivate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
fgencol: Tfgencol;
a,b0,invb:rcomat;
b,c,cb,bbar,pi,Ass,abarss,B0_col:rcovec;
var_base:array of integer;
implementation
function fact(var n00:integer):integer;
var i,p:integer;
begin
p:=1;
for i:=1 to n00 do p:=p*i;
fact:=p;
end;
{$R *.dfm}
procedure Tfgencol.FormActivate(Sender: TObject);
var i,j,indice_min,indice_min0,negatif,indice_min_rap,repeter,iteration,nombre_col_traite,i0:integer;
nombre_iteration:extended;
s,min0,min,min_rap:real;
temps:tdatetime;
col_a_tr,col_b0_tr:array of integer;
n_m:integer;
begin
//
// debut de traitement
//
temps:=time;
n:=arc*nflux+nombre_var_artif+nombre_var_ecart;
m:=nombre_var_artif+nombre_var_ecart;
matzero(m,n,a);
matzero(m,m,b0);
copiemat(af,a);
copievec(cf,c);
copievec(bf,b);
// marquage initiale des col de A et B0 pour eviter le double traitement
//setlength(col_a_tr,n-m);
//for i:=0 to n-m-1 do col_a_tr[i]:=0;
//setlength(col_b0_tr,n-m);
//for i:=0 to m-1 do col_b0_tr[i]:=0;
// Fin de marquage
//initialisation de la base B0
for i:=0 to m-1 do
for j:=n-m to n-1 do b0[i,j-n+m]:=a[i,j];
repeter:=1;
veczero(m,cb);
veczero(m,pi);
veczero(m,bbar);
veczero(m,ass);
veczero(m,abarss);
veczero(m,b0_col);
// initialisation de CB
// for i:=n-m to n-1 do cb[i-n+m]:=c[i];
//remplissage du tab de var de base
SetLength(var_base,m);
for j:=n-m to n-1 do var_base[j-n+m]:=j;
//nombre_col_traite:=0;
n_m:=n-m;
nombre_iteration:=int(fact(n)/(fact(n_m)*fact(m)));
showmessage(floattostr(nombre_iteration));
//while (repeter=1) and (nombre_col_traite<=m-1) do
while (repeter=1) and (nombre_iteration>=1) do
begin
//iteration:=iteration+1;
nombre_iteration:=nombre_iteration-1;
invmat(b0,invb);
// calcul bbar
matvec(invb,b,bbar);
// initialisation de CB
i:=0;
while i<= m-1 do begin
cb[i]:=c[var_base[i]];
i:=i+1;
end;
//calcul de pi
for i:=0 to m-1 do
begin
s:=0;
for j:=0 to m-1 do s:=s+cb[j]*invb[j,i];
pi[i]:=s;
end;
// cherche la premiere col non traite
//i:=0;
//while i<=n-m-1 do
//if col_a_tr[i]=0 then begin
// i0:=i;
// break;
// end
// else i:=i+1;
//
// calcul C bar S
min0:=0;
indice_min0:=0;
for j:=0 to m-1 do min0:=min0+pi[j]*a[j,0];
min0:=c[0]-min0;
for i:=1 to n-1 do begin
//if col_a_tr[i]=0 then
// begin
min:=0;
indice_min:=i;
for j:=0 to m-1 do min:=min+pi[j]*a[j,i];
min:=c[i]-min;
if min<=min0 then begin
min0:=min;
indice_min0:=indice_min; // indice colonne s
end;
// end;
end;
//col_a_tr[indice_min0]:=1;
//nombre_col_traite:=nombre_col_traite+1;
if min0>=0 then begin
showmessage('la solution optimale est XB=Bbar');
repeter:=0;
end
else begin
copiecolonnemat(A,indice_min0,Ass);
matvec(invb,ass,abarss);
// verifie si abarss est negatif
negatif:=1;
j:=0;
while (j<=m-1) and (negatif=1) do begin
if abarss[j]>0 then negatif:=0;
j:=j+1;
end;
if negatif=1 then begin
showmessage('optimum est non borné');
repeter:=0;
end
else begin
if abarss[0]>0 then begin
min_rap:=bbar[0]/abarss[0];
indice_min_rap:=0;
end
else begin
min_rap:=100; //valeur aleatoire
indice_min_rap:=1;
end;
for i:=1 to m-1 do begin
//if col_b0_tr[i]=0 then
if abarss[i]>0 then if (bbar[i]/abarss[i])<= min_rap then begin
min_rap:=bbar[i]/abarss[i];
indice_min_rap:=i; // indice colonne t
end;
end;
//col_b0_tr[indice_min_rap]:=1;
// sauvegarder la colonne t pour transfere dans A
copiecolonnemat(B0,indice_min_rap,B0_col);
//remplacer dans b0 la colonne At par la colonne As
for i:=0 to m-1 do b0[i,indice_min_rap]:=a[i,indice_min0];
// copier la colonne t dans A
for i:=0 to m-1 do a[i,indice_min]:=B0_col[indice_min_rap];
// remplacer dans le tab_var de base
var_base[indice_min_rap]:= indice_min0;
end;
end;
end;
showmessage('temps='+timetostr(time-temps));
// affichage final des resultats
scrollbox1.Visible:=true;
for i:=fgencol.Scrollbox1.ComponentCount-1 DownTo 0 Do
If fgencol.Scrollbox1.Components[i] Is TEdit Then
fgencol.Scrollbox1.Components[i].Free;
//for i:=0 to fgencol.Scrollbox1.ComponentCount-1 do
for i:=0 to m-1 do
With TEdit.Create(fgencol.Scrollbox1) Do //on crée un Tedit
Begin
Parent := fgencol.Scrollbox1;
Text :='';
Left := 10;
top :=i*30;
Width:=100;
End;
For i:=0 to fgencol.Scrollbox1.ComponentCount-1 Do
Tedit(fgencol.Scrollbox1.Components[i]).Text:=tab_var[var_base[i]]+'='+floattostr(bbar[i]);
end;
procedure Tfgencol.BitBtn1Click(Sender: TObject);
begin
fgencol.close;
end;
end. |
Delphi 7 et génération de colonnes
Répondre avec citation
Partager