var array mm nn of double fun array nn of integer Коэффициенты целевой

 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
var A : array[1..mm, 1..nn] of double;
fun : array[1..nn] of integer; // Коэффициенты целевой функции
m, n : integer; // m ограничений, n переменных.
basis : array[1..nn] of integer; // Здесь храним номера базисных переменных
i, j : integer;
x : array[1..nn] of double; // Здесь будут значения переменных при расшифровке плана
procedure solve;
var i, j, i0, j0 : integer;
tmp : double;
opt : boolean;
begin
opt := false;
repeat
j0 := 1; i0 := 0;
while (j0 < m+n+1) and (A[m+1, j0] >= 0) do inc(j0);
if A[m+1, j0] >= 0 then opt := true;
if not opt then begin
tmp := 10000;
for i := 1 to m do
if (A[i, j0] > 0) and (A[i, m+n+1] / A[i, j0] < tmp) then
begin
tmp := A[i, m+n+1] / A[i, j0]; i0 := i
end;
// i0 - выводим, j0 - добавляем
basis[i0] := j0; // Ввод нового элемента в базис
// [i0, j0] - ведущий эл-т в Гауссе:
for i := 1 to m + 1 do
if i <> i0 then
begin
tmp := A[i, j0];
for j := 1 to m + n + 1 do
A[i,j] := A[i,j] - A[i0,j]*tmp/A[i0,j0];
end;
tmp := A[i0, j0];
for j := 1 to m + n + 1 do
A[i0, j] := A[i0, j] / tmp;
end;
until opt;
end;
begin
assign(input, 'input.txt'); reset(input);
// -------Ввод данных---------------------------
read(n); read(m);
for i := 1 to n do read(fun[i]); //Читаем коэффициенты целевой функции
for i := 1 to m do
for j := 1 to n do
read(A[i, j]);
for i := 1 to m do
read(A[i, n+m+1]); // Читаем правые части ограничений
for i := 1 to m do // Вводим дополнительные переменные
A[i, n+i] := 1;
fillchar(A[m+1], sizeof(A[m+1]), 0);
// базис из доп. переменных
for i := 1 to m do
basis[i] := n + i;
for j := 1 to n do
A[m+1,j] := -fun[j]; // Оценки для небазисных переменных = -fun[j], для базисных - 0
solve; // DO IT! +)
// -- вывод базиса --
for i := 1 to m do
if basis[i] <= n then
x[basis[i]] := A[i, m+n+1];
for i := 1 to n do writeLn('x[', i, '] = ', x[i]:0:3);
writeLn('min f(x) = ', A[m+1, m+n+1]:0:3);
end.