Перевод кода на VB 6.0

@Yorksik · Регистрация: 10.12.2011

Студворк — интернет-сервис помощи студентам

Форумчане переведите пожалуйста на вб этот код написанный наверное в паскале(!)
Код взят из учебника
Ю.С.ДЕОРДИЦА Ю.М.НЕФЕДОВ
ИССЛЕДОВАНИЕ ОПЕРАЦИЙ В ПЛАНИРОВАНИИ И УПРАВЛЕНИИ
Киев
«Выща школа»
1991
Глава 5
Большая просьба перевести на VB 6

Pascal
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
PROGRAM ПРЯМОЙ_ПОИСК(INPUT,OUTPUT); 
(******************************************************************************)
МЕТОД ПРЯМОГО ПОИСКА, Т.Е. БЕЗ ИСПОЛЬЗОВАНИЯ ПРОИЗВОДНЫХ, МИНИМАЛЬНОГО ЗНАЧЕНИЯ НЕЛИНЕЙНОЙ ФУНКЦИИ БЕЗ ОГРАНИЧЕНИЙ. 
РЕАЛИЗОВАНА СТРАТЕГИЯ ПОИСКА ВДОЛЬ ВЫБРАННОГО НАПРАВЛЕНИЯ           *)
CONST NM=10;
    MAXREAL=1E20;
TYPE ARRN=ARRAY[1..NM]  OF REAL;
VAR    X,Y,B           :  ARRN;
N,PR,NT     :  INTEGER; 
HX,H,Z,EPS,DZ :  REAL;
(******************************************************************************)
FUNCTION FUNC : REAL;
(* ПОД FUNC ЗАДАЕТСЯ КОНКРЕТНОЕ ВЫРАЖЕНИЕ ФУНКЦИИ, ДЛЯ КОТОРОЙ ОПРЕДЕЛЯЕТСЯ МИНИМУМ                                                                                                      *) 
VAR  
Z1,Z2,Z3: REAL;   
BEGIN      
Z1:=SQR(X[1]*X[1]+X[2]+X[3]-15);                        
Z2:=SQR(X[1]+X[2]*X[2]+X[З]-ll);
Z3:=SQR(X[1]+X[2]*X[2]+X[З]-2l);
FUNC:=Z1+Z2+Z3  
END;
РRОСЕDURE ВВОД; 
VAR  I:INTEGER; 
BEGIN                  
WRITELN('BBEДИTE ЧИСЛО ПЕРЕМЕННЫХ N');
READLN(N);
WRITELN('ВВЕДИТЕ НАЧАЛЬНЫЕ ЗНАЧЕНИЯ ПЕРЕМЕННЫХ');
FOR I:=l TO N DO READ(X[I]); 
READELN;
WRITELN(' ВВЕДИТЕ ВЕЛИЧИНУ ШАГА ПОИСКА');     
READLN(HX); 
H:=HX;
WRITELN('BBЕДИТЕ ТОЧНОСТЬ РЕШЕНИЯ');
READLN(EPS);
WRITELN;      
WRITELN('ВВОД ОКОНЧЕН');       
FOR I:=l TO N DO 
BEGIN 
B[l]:=X[I]; 
Y[I]:=0.0 
END;
Z:=FUNC;
WRITELN; 
WRITE(' НАЧАЛЬНОЕ ЗНАЧЕНИЕ ФУНКЦИИ : '); 
WRITELN(Z:10:2)
END;
(******************************************************************************)
PROCEDURE ПОИСК; 
(*
ПОИСК ВЫГОДНОГО НАПРАВЛЕНИЯ В ОКРЕСТНОСТИ БАЗИСНОЙ ТОЧКИ. ЕСЛИ ТАКОГО НАПРАВЛЕНИЯ НЕТ, ТО БАЗИСНАЯ ТОЧКА СООТВЕТСТВУЕТ ОПТИМАЛЬНОМУ РЕШЕНИЮ                                                                                                    *) 
VAR  I   : INTEGER;
 ZN,A : REAL; 
BEGIN 
PR:=0;
Z:=FUNC;
REPEAT  
FOR  I:=1 TO M DO
 BEGIN                    
X[I]:=B[I]+H;  
ZN:=FUNC; 
IF ZN<Z THEN 
BEGIN 
Y[I]:=(Z-ZN);
PR:=1 
END  
ELSE    
BEGIN
X[I]:=B[I]-H; 
ZN:=FUNC; 
IF ZN<Z THEN 
BEGIN
Y[I]:=(ZN-Z); 
PR:=1 
END 
END; 
X[I]:=B[I] 
END;
 IF (H>=EPS) OR (PR=0) THEN 
H:=0.5*H 
UNTIL (PR=1) OR (H<EPS); 
IF (PR=1) THEN         
BEGIN  
A:=ABS(Y[1]);
FOR I:=2 TO N DО                 
IF A<ABS(Y[I]) THEN 
A:=ABS(Y[I]); 
FOR I:=l TO N DO 
Y[I]:=(Y[l]/A)*H 
END 
END;     
(******************************************************************************)
PROCEDURE НОВЫЙ_БАЗИС; (*
ПИСК НОВОЙ БАЗИСНОЙ ТОЧКИ ВДОЛЬ ВЫБРАННОГО НАПРАВЛЕНИЯ                  *)
VAR I  : INTEGER;
ZN : REAL;
BEGIN                         
IF PR=1 THEN
  BEGIN                             
Z:=FUNC; 
NT:=0;
FOR I:=l TO N DO
X[I]:=X[I]+Y[I];                                
ZN:=FUNC; 
WHILE  (ZN<Z) AND (NT=0) DO    
BEGIN 
Z:=ZN; 
FOR I:=l TO N DO
X[I]:=X[I]+Y[I]; 
ZN:=FUNC;
IF (ZN<=(-MAXREAL) THEN 
NT:=l 
END;
DZ:=ABS(ZN-Z); 
IF (ZN>Z) THEN  
BEGIN 
FOR I:=l TO N DO  
X[I]:=X[I]-Y[I]; 
ZN:=FUNC
END;                    
FOR I:=l TO N DO 
B[I]:=X[I] 
END 
END;
(******************************************************************************)
PROCEDURE ВЫВОД;                               
VAR  I : INTEGER; 
BEGIN
IF (NT=1) THEN             
BEGIN   
WRITELN('ФУНКЦИЯ НЕ ИМЕЕТ ЭКСТРЕМУМА ТИПА ');
WRITELN('МИНИМУM');                           
END                                    
ELSE      
BEGIN                   
WRITELN('ОПТИМАЛЬНОЕ РЕШЕНИЕ : '); 
WRITELN ('——————————————');
FOR I:=l TO N DO
BEGIN                           
WRIТЕ('Х',I:2,'= ',X[I]:5:3); 
WRITELN  
END;                   
WRITELN; 
WRITELN(' МИНИМАЛЬНОЕ ЗНАЧЕНИЕ ФУНКЦИИ : '); 
WRITELN(Z:11:3)
END 
END;
(******************************************************************************)
BEGIN                                                                       (*     ОСНОВНАЯ ЧАСТЬ ПРОГРАММЫ *) 
ВВОД;
WHILE (H>EPS) OR (DZ>EPS) DО 
BEGIN 
ПОИСК;
НОВЫИ_БАЗИС; 
END;                                              
END.
ЭВМ-> ВВЕДИТЕ ЧИСЛО ПЕРЕМЕННЫХ N
ЛПР-> 3 
ЭВМ-> ВВЕДИТЕ НАЧАЛЬНЫЕ ЗНАЧЕНИЯ ПЕРЕМЕННЫХ
ЛПР-> 111
ЭВМ-> ВВЕДИТЕ ВЕЛИЧИНУ ШАГА ПОИСКА
ЛПР-> 0.1
ЗВМ-> ВВЕДИТЕ ТОЧНОСТЬ РЕШЕНИЯ
ЛПР->    0.001 . 
ЗВМ->  ВВОД ОКОНЧЕН
НАЧАЛЬНОЕ ЗНАЧЕНИЕ ФУНКЦИИ : 532.00
ОПТИМАЛЬНОЕ РЕШЕНИЕ :
X 1 = 3.000 
X 2 = 2.000 
X 3 = 3.999 
МИНИМАЛЬНОЕ НАЧЕНИЕ ФУНКЦИИ : 
                   0.000

Pascal
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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
(\U+,K-,R-,Y-*) 
PROGRAM МЕТОД_ДЕФОРМ_СИМПЛЕКСА(INPUT,OUTPUT);
(*******************************************************************************
МЕТОД ДЕФОРМИРУЕМОГО N-МЕРНОГО СИМПЛЕКСА МИНИМИЗАЦИИ НЕЛИНЕЙНОЙ ФУНКЦИИ, ОСНОВАННЫЙ НА ЗЕРКАЛЬНОМ ОТРАЖЕНИИ, РАСТЯЖЕНИИ И СЖАТИИ СИМПЛЕКСА ОТНОСИТЕЛЬНО ГРАНИ, ПРОТИВО-ПОЛОЖНОИ ВЕРШИНЕ С НАИБОЛЬШИМ ЗНАЧЕНИЕМ ФУНКЦИИ                               *)
CONST NMAX=10;
     MAXREAL=1E38;
ALFA=l;                      
ВЕТА=2;
GАММА=0.5; 
TYPE  ARRMN=ARRAY[0...NMAX,l..NMAX] OF REAL;
ARRN=ARRAY[l..NMAX] OF REAL; 
VAR    XS                                     : ARRMN;
X,C,U,V                             : ARRN;
N,K,A,B                             : INTEGER;
L,H,EPS,Z,MINZ,MAXZ  : REAL;
(******************************************************************************)
FUNCTION FUNC : REAL;
VAR Zl,Z2,Z3 : REAL; 
BEGIN
Zl:=SQR(X[1]*X[1]+X[2]+X[3]-15);
Z2:=SQR(X[l]+X[2]*X[2]+X[3]-ll);
Z3:=SQR(X[1]+X[2]+X[3]*X[3]-21);
FUNC:=Zl+Z2+Z3 
END;
PROCEDURE ВBOД;
VAR J : INTEGER; 
BEGIN
WRITELN(' ВВЕДИТЕ ЧИСЛО ПЕРЕМЕННЫХ N'); 
READLN(N);                              
WRITELN(' ВВЕДИТЕ НАЧАЛЬНЫЕ ЗНАЧЕНИЯ ПЕРЕМЕННЫХ'); 
FOR J:=l TO N DO                                 
BEGIN
READ(XS[0,J]); 
X[J]:=XS[0,J] 
END;
READLN;
WRIТЕLN('ВВЕДИТЕ ДЛИНУ РЕБРА НАЧАЛЬНОГО СИМПЛЕКСА'); 
READLN(L);
WRITELN('BBEДИTE ТОЧНОСТЬ РЕШЕНИЯ'); 
READLN(EPS);                      
WRITELN;
WRITELN('BBOД ОКОНЧЕН'); 
Z:=FUNC;
WRITE('НАЧАЛЬНОЕ ЗНАЧЕНИЕ ФУНКЦИИ:'); 
WRITELN(Z:10:2) 
END;
PROCEDURE ИСХОДНЫЙ_СИМПЛЕКС;
(*
ВЫЧИСЛЕНИЕ КООРДИНАТ ВЕРШИН НАЧАЛЬНОГО СИМПЛЕКСА СДЛИНОЙ РЕБЕР L                                                                                                                                                          *)
VAR I,J : INTEGER; 
BEGIN
FOR I:=l TO N DO 
FOR J:=l TO N DO
IF I=J THEN XS[I,J]=X[J]+L 
ELSE XS[I,J]:=X[J] 
END;
(******************************************************************************)
PROCEDURE ПРОЕКЦИЯ;            (*
ЗАМЕНА ВЕРШИНЫ С МАКСИМАЛЬНЫМ ЗНАЧЕНИЕМ ФУНКЦИИ НА
НОВУЮ ВЕРШИНУ ПУТЕМ ОТРАЖЕНИЯ                                                                            *)
VAR  I,J     : INTEGER;
D,ZN,ZM : REAL; 
BEGIN
MAXZ:=-MAXREAL; 
MINZ:=MAXREAL; 
FOR I:=0 TO N DO  
BEGIN
FOR J:=l TO N DO
X[J]:=XS[I,J]; 
ZN:=FUNC;  
ZM:=ZN; 
IF (ZN>MAXZ) THEN
BEGIN 
MAXZ:=ZN; 
B:=I 
END; 
IF (ZM<MINZ) THEN
BEGIN 
MINZ:=ZM; 
A:=I 
END 
END; 
ZN:=MINZ;
FOR I:=0 TO N DO 
IF (I<>B) THEN 
BEGIN 
FOR J:=l TO N DO
X[J]:=XS[I,J]; 
Z:=FUNC; 
IF (Z>ZN) THEN 
ZM:=Z 
END; 
FOR J:=l TO N DO 
BEGIN
D:=0;
FOR I:=0 TO N DO 
IF (I<>B) THEN
D:=D+XS[I,J]; 
C[J]:=D/N 
END; 
FOR J:=l TO N DO 
BEGIN
U[J]:=C[J]+ALFA* (C[J]-XS[B,J]);
X[J]:=U[J]
END; 
Z:=FUNC;                                           
IF (MINZ>Z) THEN K:=1;                                                                           (* РАСТЯЖЕНИЕ *) 
IF (ZN<Z) THEN K:=2;                                                                                           (* СЖАТИЕ *)
IF (MINZ<=Z) AND (ZN>=Z) THEN K:=3                                                   (* ОТРАЖЕНИЕ *) 
END;
PROCEDURE РАСТЯЖЕНИЕ;
(* НАПРАВЛЕНИЕ ПРОЕКТИРОВАНИЯ ОКАЗАЛОСЬ ПЕРСПЕКТИВНЫМ. В ЭТОМ НАПРАВЛЕНИИ ДЕЛАЕТСЯ ПОПЫТКА РАСТЯНУТЬ СИМПЛЕКС                                 *)
VAR J : INTEGER;                                    
         ZM : REAL; 
BEGIN
FOR J:=l TO N DO 
BEGIN
V[J]:=C[J]+BETA*(U[J]-C[J]); 
X[J]:=V[J] 
END;
ZN:=FUNC;
IF (ZN<Z) THEN   
FOR J:=l TO N DO
XS[B,J:=V[J] 
ELSE
FOR J:=l TO N DO
XS[B,J]:=U[J] 
END;
(******************************************************************************)
PROCEDURE СЖАТИЕ; (*
НАПРАВЛЕНИЕ ПРОЕКТИРОВАНИЯ ОКАЗАЛОСЬ НЕПЕРСПЕКТИВНЫМ. В ЭТОМ НАПРАВЛЕНИИ СИМПЛЕКС СЖИМАЕТСЯ
*)
VAR I,J : INTEGER;
ZN : REAL; 
BEGIN
IF (Z>=MAXZ) THEN 
FOR J:=l TO N DO 
BEGIN
V[J]:=C[J]+GAMMA*(XS[B,J]-C[J]); 
X[J]:=V[J] 
END 
ELSE
FOR J:=l TO N DO 
BEGIN                         
V[J]:=C[J]+GAMMA*(U[J]-C[J]; 
X[J]:=V[J]
END;                                           
ZN:=FUNC;                                           
IF (ZN<MAXZ) AND (ZN<Z) THEN 
FOR J:=l TO N DO
XS[B,J]:=V[J] 
ELSE
FOR I:=0 TO N DO 
BEGIN
IF (I<>A) THEN
FOR J:=l TO N DO                   
XS[I,J]:=XS[I,J]+0.5*(XS[A,J]-XS[I,J)
END
END;
PROCEDURE ОТРАЖЕНИЕ;
(*
ОТРАЖЕНИЕ ХУДШЕИ ВЕРШИНЫ СИМПЛЕКСА ОТНОСИТЕЛЬНО ПРОТИВО¬ЛЕЖАЩЕЙ ГРАНИ
*)
VAR J : INTEGER; 
BEGIN
FOR J:=l TO N DO
XS[B,J]:=U[J] 
END;                          
(******************************************************************************)
PROCEDURE УСЛОВИЕ;
(* ПРОВЕРКА ДОСТИЖЕНИЯ МИНИМУМА ФУНКЦИИ ПО ЗАДАННОЙ ТОЧНОСТИ *) 
VAR ZN   : REAL;
I,J : INTEGER; 
BEGIN 
H:=0; 
FOR I:=0 TO N DO 
IF (А<>I) THEN 
BEGIN             
FOR J:=1 TO К DO
X[J]:=XS[I,J]; 
ZN:=FUNC; 
H:=H+SQR(ZN-MINZ) 
END;
H:=SQRT(H/N) 
END;
(******************************************************************************)
PROCEDURE ВЫВОД;
VAR J : INTEGER;
ZN : REAL; 
BEGIN
WRITELN(' ОПТИМАЛЬНОЕ РЕШЕНИЕ : '); 
WRITELN (‘——————————— ');
FOR J:=l TO N DO  
BEGIN
X[J]:=XS[B,J];
WRITE('X',J:2,' =',X[J]:6:2);
  WRITELN 
END;
ZN:=FUNC; 
WRITELN;
WRITELN(' НАИМЕНЬШЕЕ ЗНАЧЕНИЕ ФУНКЦИИ :'); 
WRITELN(ZN:12:3) 
END;
(******************************************************************************)
BEGIN                                                                       (*     ОСНОВНАЯ ЧАСТЬ ПРОГРАММЫ *) 
ВВОД;
ИСХОДНЫЙ_СИМПЛЕКС; 
REPEAT 
ПРОЕКЦИЯ; 
CASE К OF
1 : РАСТЯЖЕНИЕ;
2 : СЖАТИЕ;
3 : ОТРАЖЕНИЕ; END;
УСЛОВИЕ UNTIL (H<EPS);
ВЫВОД 
END.
ЭВМ-> ВВЕДИТЕ ЧИСЛО ПЕРЕМЕННЫХ N
ЛПР-> 3
ЭВМ-> ВВЕДИТЕ НАЧАЛЬНЫЕ ЗНАЧЕНИЯ ПЕРЕМЕННЫХ
ЛПР-> l 1 1
ЭВМ-> ВВЕДИТЕ ДЛИНУ РЕБРА НАЧАЛЬНОГО СИМПЛЕКСА
ЛПР-> 1
ЭВМ-> ВВЕДИТЕ ТОЧНОСТЬ РЕШЕНИЯ
ЛПР-> 0.001                     
ЭВМ-> ВВОД ОКОНЧЕН
НАЧАЛЬНОЕ ЗНАЧЕНИЕ ФУНКЦИИ:  532.00
ОПТИМАЛЬНОЕ РЕШЕНИЕ :
 
Х l = 3.00 
Х 2 = 2.00 
X 3 = 4.00
НАИМЕНЬШЕЕ ЗНАЧЕНИЕ ФУНКЦИИ : 0.000

Pascal
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
(*\U+,K-,R-,Y-*) 
PROGRAM ГРАДИЕНТНЫЙ_МЕТОД(INPUT,OUTPUT);
(*******************************************************************************
ВАРИАНТ ГРАДИЕНТНОГО МЕТОДА - МЕТОД НАИСКОРЕЙШЕГО СПУСКА. ПОИСК МИНИМУМА ФУНКЦИИ ОСУЩЕСТВЛЯЕТСЯ ВДОЛЬ НАПРАВЛЕНИЯ АНТИГРАДИЕНТА                                                                                                                         *) 
CONST NM=10;
MINREAL=1E-10;
TYPE ARRN=ARRAY[l..NM] OF REAL; 
VAR   X,GR      : ARRN;
N            : INTEGER; 
EPS,H,Z,G : REAL;
PR,EXTR   : BOOLEAN;
FUNCTION FUNC(X:ARRN):REAL;
VAR Z1,Z2,Z3 : REAL; 
BEGIN
Zl:=SQR(X[1]*X[l]+X[2]+X[3]-15);
Z2:=SQR(X[1]+X[2]*X[2]+X[3]-11);
Z3:=SQR(X[1]+X[2]+X[3]*X[3]-21);
FUNC:=Z1+Z2+Z3 
END;
(******************************************************************************)
PROCEDURE ГРАДИЕНТ; 
VAR I : INTEGER;
BEGIN 
GR[1]:=4*X[1]*(X[1]*X[l]+X[2]*X[3]-15);
GR[1]:=GR[l]+2*(X[l]+X[2]*X[2]+X[3]-ll);
GR[1]:=GR[1]+2*(X[1]+X[2]+X[3]*X[3]-21); 
GR[2]:=2*(X[1]*X[1]+X[2]+X[3]-15);
GR[2]:=GR[2]+4*X[2]*(X[1]+X[2]*X[2]+X[3]-ll);
  GR[2]:=GR[2]+2*(X[l]+X[2]+X[3]*X[3]-21);
GR[3]:=2*(X[1]*X[1]+X[2+X[3]-15);
GR[3]:=GR[3]+2*(X[l]+X[2]*X[2]+X[3]-ll);
GR[3]:=GR[3]+4*X[3]*(X[1]+X[2]+X[3]*X[3]-21);
G:=0;
FOR I:=l TO N DO
G:=G+SQR(GR[I]);
G:=SQRT(G)                                                                            (* МОДУЛЬ ГРАДИЕНТА *) 
END;
(******************************************************************************)
PROCEDURE ВВОД;
VAR I : INTEGER; 
BEGIN
WRITELN(‘BBEДИTE ЧИСЛО ПЕРЕМЕННЫХ N');
READLN(N);
WRITELN(' ВВЕДИТЕ НАЧАЛЬНЫЕ ЗНАЧЕНИЯ ПЕРЕМЕННЫХ');
FOR I:=l TO N DO 
READ(X[I]); 
READLN;
WRITELN(' ВВЕДИТЕ ВЕЛИЧИНУ ШАГА ПОИСКА');
READLN (H);
WRITELN (' ВВЕДИТЕ  ТОЧНОСТЬ РЕШЕНИЯ'); 
READLN(EPS);          
WRITELN;
WRITELN('BBOД ОКОНЧЕН');
PR:=FALSE;
EXTR:=TRUE;       
WRITELN;      
WRITELN('HAЧАЛЬHOE ЗНАЧЕНИЕ ФУНКЦИЙ :');
Z:=FUNC(X);
WRITELN(Z:l2:3); 
WRITELN         
END;
(******************************************************************************)
PROCEDURE ПОИСК;
(*
В НАПРАВЛЕНИИ АНТИГРАДИЕНТА ОПРЕДЕЛЯЕТСЯ ТОЧКА НАИБОЛЬШЕГО, ЛОКАЛЬНОГО УМЕНЬШЕНИЯ ФУНКЦИИ С ПОМОЩЬЮ - КВАДРАТИЧНОЙ , ИНТЕРПОЛЯЦИИ                                                                                                                          *) 
VAR A,B,C,D        : ARRN;    
I               : INTEGER; 
ZMAX,X1,X2    : REAL; 
ZA,ZB,ZC,ZD,ZE : REAL;                              
BEGIN                              
ZD:=Z;                                                   
FOR I:=l TO N DO           
IF (ABS(G)>MINREAL) THEN D[I]:=0           
ELSE D[I]=-GR[I]/G;
FOR I:=l TO N DO A[I]:=X[I];             
ZA:=FUNC(A);             
FOR I:=l TO N DO В[I]:=Х[I]+Н*D[I];             
ZB:=FUNC(B);
IF ZB>ZA THEN                                           
BEGIN
FOR I:=l TO N DO                    
BEGIN                     
C[I]:=X[I]-H*D[I];
ZMAX:=ZB  
END;              
 ZC:=FUNC(C)
END                                         
ELSE                                       
BEGIN            
FOR I:=l TO N DO                                       
BEGIN               
C[I]:=X[I]+2*H*D[I]; 
MAX:=ZA
END;              
ZC:=FUNC(C)                                 
END;                   
IF ZC>MAX THEN ZMAX:=ZC;
FOR I:=1 TO N DO 
BEGIN
Xl:=(B[I]-C[I])*ZA+(C[I]-A[I])*ZB+(A[I]-B[I])*ZC;
IF (ABS(Xl) < MINREAL) THEN
Z:=FUNC(X) 
ELSE 
BEGIN
X2:=0.5*(ZA-ZB)*(B[I]-C[I])*(C[I]-A[I]); 
X[I]:=0.5*(A[I]+B[I])+X2/X1
END 
END;
Z:=FUNC(X);
ZE:=ABS(Z-ZD); 
IF ZE<EPS THEN H:=0.5*H; 
IF Z<(1/MINREAL) THEN EXTR:=FALSE; 
IF Z>ZMAX THEN PR:=TRUE 
END;
(******************************************************************************)
PROCEDURE ВЫВОД;                
VAR I : INTEGER; 
BEGIN
IF (NOT EXTR) THEN
WRITEIN(' ФУНКЦИЯ НЕ ИМЕЕТ ЭКСТРЕМУMА'); 
IF PR THEN
WRITELN(' ФУНКЦИЯ ИМЕЕТ ЛОКАЛЬНЫЙ МАКСИМУМ') 
ELSE
BEGIN
WRITELN(' ОПТИМАЛЬНОЕ PЕШЕНИE :'); 
WRITELN (' ——————————————');
FOR I:=1 TO N DO
WRITELN('X',I:2,' = ',Х[I]:6:3); 
WRITELN;
WRITELN(' МИНИМАЛЬНОЕ ЗНАЧЕНИЕ ФУНКЦИИ :'); 
WRITELN(Z:12:3) 
END 
END;
(******************************************************************************)
BEGIN                                                                        (*    ОСНОВНАЯ ЧАСТЬ ПРОГРАММЫ *)
ВВОД;
ГРАДИЕНТ;
WHILE (G>EPS) AND (NOT PR) AND EXTR DO 
BEGIN                              
ПОИСК;    
ГРАДИЕНТ; 
END;
 ВЫВОД 
END.
 
3BM-> ВВЕДИТЕ ЧИСЛО ПЕРЕМЕННЫХ N
ЛПР-> 3
ЭВМ-> ВВЕДИТЕ НАЧАЛЬНЫЕ ЗНАЧЕНИЯ ПЕРЕМЕННЫХ
ЛПР-> 1 1 1
ЭBМ-> ВВЕДИТЕ ВЕЛИЧИНУ ШАГА ПОИСКА
ЛПР->  0.1
ЭВМ->  ВВЕДИТЕ ТОЧНОСТЬ РЕШЕНИЯ
ЛПР->  0.001
ЭВМ->  ВВОД ОКОНЧЕН
НАЧАЛЬНОЕ ЗНАЧЕНИЕ ФУНКЦИИ 
532.000
ОПТИМАЛЬНОЕ РЕШЕНИЕ :
X 1 = -5.018 
X 2 = -4.643 
X 3 = -5.537
МИНИМАЛЬНОЕ ЗНАЧЕНИЕ ФУНКЦИИ :
0.000

Pascal
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
(*\U+,K-,R-,Y-*)
PROGRAM МЕТОД_ПЕРЕМЕННОИ_МЕТРИКИ(INPUT,ОUТPUТ);
(*******************************************************************************
МОДИФИКАЦИЯ МЕТОДА НЬЮТОНА - МЕТОД ПЕРЕМЕННОЙ МЕТРИКИ. ПОЗВОЛЯЕТ МИНИМИЗИРОВАТЬ НЕЛИНЕЙНУЮ ФУНКЦИЮ.НАПРАВЛЕНИЕ ПОИСКА ОПРЕДЕЛЯЕТСЯ АППРОКСИМИРОВАННОЙ МАТРИЦЕЙ ВТОРЫХ ПРОИЗВОДНЫХ, КОТОРАЯ ОБНОВЛЯЕТСЯ НА КАЖДОЙ ИТЕРАЦИИ                          *) 
CONST NM =10;
MINREAL = 1Е-20;
TYPE ARRN = ARRAY[1..NM] OF REAL;
ARRNN = ARRAY[1..NM,1..NM] OF REAL;
VAR  X,A,GR,G        : ARRN;
H               : ARRNN;
N               : INTEGER;
Z,EPS,UMOD,VMOD : REAL;
FUNCTION FUNC(X:ARRN):REAL;
VAR Z1,Z2,Z3 : REAL;
BEGIN
Z1:=SQR(X[1]*X[1]+X[2]+X[3]-15);
Z2:=SQR(X[1]+X[2]*X[2]+X[3]-11);
Z3:=SQR(X[1]+X[2]+X[3]*X[3]-21);
FUNC:=Z1+Z2+Z3 
END;
PROCEDURE ГРАДИЕНТ;
BEGIN
GR[1]:=4*X[l]*(X[1]*X[1]+X[2]+X[3]-15); 
GR[1]:=GR[1]+2*(X[1]+X[2]*X[2]+X[3]-ll); 
GR[1]:=GR[1]+2*(X[1]+X[2]+X[3]*X[3]-21); 
GR[2]:=2*(X[l]*X[1]+X[2]+X[3]-15);
GR[2]:=GR[2]+4*X[2]*(X[1]+X[2]*X[2]+X[3]-ll); 
GR[2]:=GR[2]+2*(X[1]+X[2]+X[3]*X[3]-21); 
GR[3]:=2*(X[1]*X[1]+X[2]+X[3]-15);
GR[3]:=GR[3]+2*(X[1]+X[2]*X[2]+X[3]-ll);
GR[3]:=GR[3]+4*X[3]*(X[1]+X[2]+X[3]*(X[3]-2l) 
END;
PROCEDURE ВВОД;
VAR I,J : INTEGER;
BEGIN
WRITELN('ВВЕДИТЕ ЧИСЛО ПЕРЕМЕННЫХ N');
READLN(N);
WRITELN(' ВВЕДИТЕ НАЧАЛЬНЫЕ ЗНАЧЕНИЯ ПЕРЕМЕННЫХ');
FOR I:=l TO N DO
READ(X[I]); 
READLN;
WRITELN('ВВЕДИTE ТОЧНОСТЬ РЕШЕНИЯ');
READLN(EPS);
WRITELN;
WRITELN('BBOД ОКОНЧЕН');
WRITELN;
WRITELN('НАЧАЛЬНОЕ ЗНАЧЕНИЕ ФУНКЦИИ :');
Z:=FUNC(X);
WRITELN(Z:12:3);
WRITELN;
FOR I:=1 TO N DO 
BEGIN 
FOR J:=l TO N DO H[I,J]:=0;
H[I,J]:=l 
END 
END;
PROCEDURE ПОИСК_РЕШЕНИЯ;
(* ОПРЕДЕЛЯЕТСЯ НАПРАВЛЕНИЕ УМЕНЬШЕНИЯ ФУНКЦИИ И В ЭТОМ НАПРАВЛЕНИИ НАХОДИТСЯ УЛУЧШЕННОЕ РЕШЕНИЕ                                                *)
VAR   D              : ARRN;
I,J            : INTEGER;
ALFA,DMOD,GP,ZA : REAL; 
BEGIN
ГРАДИЕНТ;
ALFA:=1;
FOR I:=l TO N DO 
BEGIN
G[I]:=GR[I];
D[I]:=0;
FOR J:=l TO N DO
D[I]:=D[I]-H[I,J]*G[I] 
END;
FOR  I:=l TO N DO А[I]:=Х[I];
ZA:=FUNC(A);
DMOD:=0;
FOR I:=1 TO N DO
DMOD:=DMOD+SQR(D[I]); 
DMOD:=SQRT(DMOD);
IF (ABS(DMOD) > MINREAL) THEN
D[I]:=D[I]/DMOD ELSE D[I]:=0;
GP:=0;
FOR I:=l TO N D0
GP:=GP+G[I]*D[I]; 
IF GP > 0 THEN 
FOR I:=l TO N DO 
D[I]:=-D[I];
FOR I:=l TO N DO
X[I]:=A[I]+ALFA*D[I];
Z:=FUNC(X);
WHILE (Z > ZA) DO 
BEGIN
ALFA:=ALFA*0.5;
FOR I:=1 TO N DO
X[I]:=A[I]+ALFA*D[I]; 
Z:=FUNC(X) 
END
END;
(******************************************************************************)
PROCEDURE ОБНОВЛЕНИЕ_МАТРИЦЫ;
(*   ОБНОВЛЯЕТСЯ ПОЛОЖИТЕЛЬНО ОПРЕДЕЛЕННАЯ СИММЕТРИЧЕСКАЯ МАТРИЦА КОТОРАЯ В ПРЕДЕЛЕ СТАНОВИТСЯ РАВНОЙ ОБРАТНОМУ ГЕССИАНУ*)
VAR   M,U,V : ARRN;              
I,J   : INTEGER;
MU, VU : REAL;
BEGIN
ГРАДИЕНТ;
MU:=0; 
VU:=0; 
FOR I:=l TO N DO 
BEGIN 
M[Y]:=0;
U[I]:=GR[I]-G[I]; 
V[I]:=X[I]-A[I] 
END;
UMOD:=0; 
VMOD:=O;
FOR I:=l TO N DO 
BEGIN
UMOD:=UMOD+SQR(U[I]);
VMOD:=VMOD+SQR(V[I]) 
END;
UMOD:=SQRT(UMOD);
VMOD:=SQRT(VMOD);
IF (UMOD > EPS) OR (UMOD > EPS) THEN 
BEGIN
FOR I:=l TO N DO 
BEGIN
FOR J:=l TO N DO
M[I]:=M[I]+H[I,J]*U[J];
MU:=MU+M[I]*(U[I]; 
VU:=VU+V[I]*U[I] 
END;
IF (MU <> 0) AND (VU <> 0) THEN 
FOR I:=l TO N DO 
FOR J:=l TO N DO
BEGIN                          
H[I,J]:=H[I,J]-M[I]*M[J]/MU; 
H[I,J]:=H[I,J]+V[I]*V[J]/VU 
END 
END 
END;
(****************************************************************************)
PROCEDURE ВЫВОД;
VAR I : INTEGER; 
BEGIN                                            
WRITELN(' ОПТИМАЛЬНОЕ РЕИЕНИЕ :'); 
WRITELN (' ————————') ;
FOR I:=l TO N DО
WRITELN('X',I:2,' = ',X[I]:6:3); 
WRITELN;
WRITELN('МИНИМАЛЬНОЕ ЗНАЧЕНИЕ ФУНКЦИИ :'); 
WRITELN(Z:12:3) 
END;
(******************************************************************************)
BEGIN                                                                        (*    ОСНОВНАЯ ЧАСТЬ ПРОГРАММЫ *) 
ВВОД;
   REPEAT 
ПОИСК_РЕШЕНИЯ; 
ОБНОВЛЕНИЕ_МАТРИЦЫ 
UNTIL (UMOD < EPS) AND (UMOD < EPS); 
ВЫВОД 
END.
ЭBM-> ВВЕДИТЕ ЧИСЛО ПЕРЕМЕННЫХ N
ЛПР-> 3
ЭВМ-> ВВЕДИТЕ НАЧАЛЬНЫЕ ЗНАЧЕНИЯ ПЕРЕМЕННЫХ
ЛПР-> 1 1 1
ЭВМ-> ВВЕДИТЕ ТОЧНОСТЬ РЕШЕНИЯ
ЛПР-> 0.01
ЭВМ-> ВВОД ОКОНЧЕН
НАЧАЛЬНОЕ ЗНАЧЕНИЕ ФУНКЦИИ :     532.000
ОПТИМАЛЬНОЕ РЕШЕНИЕ :
Х 1 = 3.000
Х 2 = 2.000 
Х 3 = 4.000
МИНИМАЛЬНОЕ ЗНАЧЕНИЕ ФУНКЦИИ : 0.000

Добавлено через 10 минут
http://nashaucheba.ru/v21461/д... нии?page=9

@Апострофф · 24.03.2013, 17:55

Сообщение от Yorksik

Форумчане переведите пожалуйста на вб этот код написанный наверное в паскале

Yorksik, попробуйте сформулировать задачу здесь (без ссылок на левые сайты)

@Yorksik · 24.03.2013, 18:56 **[ТС]**

Апострофф, хотельсь увидеть приведеный выше код реализованный в вб

@Апострофф · 24.03.2013, 19:07

Yorksik, извините, но тупо переводить занятие для переводчиков (и платное)

@Yorksik · 24.03.2013, 19:16 **[ТС]**

Апострофф, существуют ли темы на форуме с обсуждением реализации приведенных алгоритмов

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Обработчик клика мыши в браузере ПК и касания экрана в браузере на мобильном устройстве 8Observer8 02.02.2026 Содержание блога Для начала пошагово создадим рабочий пример для подготовки к экспериментам в браузере ПК и в браузере мобильного устройства. Потом напишем обработчик клика мыши и обработчик. . .	Философия технологии iceja 01.02.2026 На мой взгляд у человека в технических проектах остается роль генерального директора. Все остальное нейронки делают уже лучше человека. Они не могут нести предпринимательские риски, не могут. . .	SDL3 для Web (WebAssembly): Вывод текста со шрифтом TTF с помощью SDL3_ttf 8Observer8 01.02.2026 Содержание блога В этой пошаговой инструкции создадим с нуля веб-приложение, которое выводит текст в окне браузера. Запустим на Android на локальном сервере. Загрузим Release на бесплатный. . .	SDL3 для Web (WebAssembly): Сборка C/C++ проекта из консоли 8Observer8 30.01.2026 Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .
SDL3 для Web (WebAssembly): Установка Emscripten SDK (emsdk) и CMake для сборки C и C++ приложений в Wasm 8Observer8 30.01.2026 Содержание блога Для того чтобы скачать Emscripten SDK (emsdk) необходимо сначало скачать и уставить Git: Install for Windows. Следуйте стандартной процедуре установки Git через установщик. . . .	SDL3 для Android: Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 29.01.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами. Версия v3 была полностью переписана на Си, в. . .	Инструменты COM: Сохранение данный из VARIANT в файл и загрузка из файла в VARIANT bedvit 28.01.2026 Сохранение базовых типов COM и массивов (одномерных или двухмерных) любой вложенности (деревья) в файл, с возможностью выбора алгоритмов сжатия и шифрования. Часть библиотеки BedvitCOM Использованы. . .	SDL3 для Android: Загрузка PNG с альфа-каналом с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 28.01.2026 Содержание блога SDL3 имеет собственные средства для загрузки и отображения PNG-файлов с альфа-каналом и базовой работы с ними. В этой инструкции используется функция SDL_LoadPNG(), которая. . .

@Yorksik 31 / 50 / 2 Регистрация: 10.12.2011 Сообщений: 383
	24.03.2013, 18:56 [ТС]
	Апострофф, хотельсь увидеть приведеный выше код реализованный в вб 0

@Апострофф 9908 / 3924 / 742 Регистрация: 11.10.2011 Сообщений: 5,904
	24.03.2013, 19:07
	Yorksik, извините, но тупо переводить занятие для переводчиков (и платное) 0

@Yorksik 31 / 50 / 2 Регистрация: 10.12.2011 Сообщений: 383
	24.03.2013, 19:16 [ТС]
	Апострофф, существуют ли темы на форуме с обсуждением реализации приведенных алгоритмов 0