[Home] [Help]
PACKAGE BODY: APPS.GMD_LCF_ENGINE
Source
1 PACKAGE BODY GMD_LCF_ENGINE AS
2 /* $Header: GMDLCFPB.pls 120.3 2006/02/24 09:46:02 rajreddy noship $ */
3
4 l_debug CONSTANT VARCHAR2(1) := NVL(FND_PROFILE.VALUE('AFLOG_ENABLED'), 'N');
5 l_log_level CONSTANT VARCHAR2(1) := NVL(FND_PROFILE.VALUE('AFLOG_LEVEL'), '6');
6
7 l_LGP_EPS_ZERO CONSTANT NUMBER := 0.00000001; -- test for zero (1e-8)
8 l_LGP_BIG CONSTANT NUMBER := 1E10; -- infinity
9 l_LGP_BIGGER CONSTANT NUMBER := 1e20; -- bigger than big
10 l_MAX_ROW CONSTANT NUMBER := 102; -- corresponds to nCon <=100
11 l_MAX_COL CONSTANT NUMBER := 301; -- corresponds to nVar <=300
12
13 l_clob CLOB;
14 l_package_name CONSTANT VARCHAR2(40) := 'GMD_LCF_ENGINE';
15 l_new_line_str CONSTANT VARCHAR2(100) := '
16 ';
17
18
19 /*====================================================================
20 -- PROCEDURE:
21 -- insert_clob
22 --
23 -- DESCRIPTION:
24 -- This procedure is used to insert the clob as a blob into FND_LOBS
25 --
26 -- PARAMETERS:
27 --
28 -- HISTORY
29 --====================================================================*/
30
31 PROCEDURE insert_clob (p_spec_id IN NUMBER) IS
32 PRAGMA AUTONOMOUS_TRANSACTION;
33 l_blob BLOB;
34
35 l_des_offset INTEGER;
36 l_src_offset INTEGER;
37 l_lang_context INTEGER;
38 l_warning INTEGER;
39 l_api_name VARCHAR2(40) := 'INSERT_CLOB';
40 l_spec_id NUMBER(15);
41 BEGIN
42 l_des_offset := 1;
43 l_src_offset := 1;
44 l_lang_context := 0;
45
46 l_spec_id := -1 * p_spec_id;
47 DELETE FROM FND_LOBS WHERE FILE_ID = l_spec_id;
48
49 INSERT INTO FND_LOBS (FILE_ID, FILE_NAME, FILE_CONTENT_TYPE,
50 FILE_DATA, LANGUAGE, ORACLE_CHARSET, FILE_FORMAT)
51 VALUES (l_spec_id, 'lcf.sql', 'text/plain', EMPTY_BLOB(), USERENV('LANG'), 'UTF8', 'text');
52
53 SELECT file_data INTO l_blob
54 FROM fnd_lobs
55 WHERE file_id = l_spec_id
56 FOR UPDATE NOWAIT;
57
58 dbms_lob.convertToBlob(dest_lob => l_blob,
59 src_clob => l_clob,
60 amount => DBMS_LOB.LOBMAXSIZE,
61 dest_offset => l_des_offset,
62 src_offset => l_src_offset,
63 blob_csid => 0,
64 lang_context => l_lang_context,
65 warning => l_warning);
66 IF l_debug = 'Y' THEN
67 gmd_debug.put_line('Warning:ConvertToBlob:'||l_warning);
68 END IF;
69 COMMIT;
70 dbms_lob.FreeTemporary(l_clob);
71 EXCEPTION
72 WHEN OTHERS THEN
73 IF l_debug = 'Y' THEN
74 gmd_debug.put_line(l_api_name||':'||sqlerrm);
75 END IF;
76 FND_MSG_PUB.Add_Exc_Msg(l_package_name, l_api_name);
77 END insert_clob;
78
79
80 /*====================================================================
81 -- PROCEDURE:
82 -- print_data
83 --
84 -- DESCRIPTION:
85 -- This procedure is used to print the data in the log file.
86 --
87 -- PARAMETERS:
88 --
89 -- HISTORY
90 --====================================================================*/
91 PROCEDURE print_data ( p_constraints IN NUMBER
92 , p_variables IN NUMBER
93 , p_matrix IN matrix
94 , p_basic IN row
95 , p_reenter IN row
96 , p_var IN char_row
97 , p_cons IN char_row
98 , p_return_code IN NUMBER) IS
99
100 l_print_line VARCHAR2(4000);
101
102 l_bool_char VARCHAR2(20);
103 l_value NUMBER;
104 l_print_value VARCHAR2(40);
105
106 l_string VARCHAR2(4000);
107
108 CURSOR Cur_get_tech_data IS
109 SELECT DISTINCT tech_parm_id, tech_parm_name
110 FROM GMD_LCF_TECH_DATA_GTMP
111 ORDER BY tech_parm_id;
112
113 CURSOR Cur_get_data IS
114 SELECT d.LINE_NO, d.line_id, SUBSTR(d.CONCATENATED_SEGMENTS,1, 36) item, d.PRIMARY_UOM, t.VALUE
115 FROM GMD_LCF_DETAILS_GTMP d, GMD_LCF_TECH_DATA_GTMP t
116 WHERE d.line_id = t.line_id
117 ORDER BY d.line_no, t.tech_parm_id;
118
119 CURSOR Cur_get_cat_data (V_line_id NUMBER) IS
120 SELECT category_name
121 FROM gmd_lcf_category_hdr_gtmp h
122 WHERE EXISTS (SELECT 1
123 FROM gmd_lcf_category_dtl_gtmp d
124 WHERE d.line_id = V_line_id
125 AND NVL(value_ind, 0) = 1
126 AND d.category_id = h.category_id);
127
128 l_item VARCHAR2(40);
129 l_line_str VARCHAR2(4000);
130 l_cat_string VARCHAR2(4000);
131 l_api_name VARCHAR2(40) := 'PRINT_DATA';
132 BEGIN
133 dbms_lob.createtemporary(l_clob, FALSE, DBMS_LOB.call);
134 dbms_lob.open(l_clob, DBMS_LOB.lob_readwrite);
135 FND_MESSAGE.SET_NAME('GMD', 'GMD_LCF_LOG_DATA');
136 l_string := FND_MESSAGE.GET||l_new_line_str;
137 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
138
139 l_string := RPAD(' Item',41,' ')||RPAD('Category', 30);
140 FOR l_rec IN Cur_get_tech_data LOOP
141 l_string := l_string||LPAD(l_rec.tech_parm_name, 10, ' ');
142 END LOOP;
143 l_string := l_string||l_new_line_str;
144
145 l_line_str := RPAD('=', length(l_string), '=')||l_new_line_str;
146 dbms_lob.writeAppend(l_clob, length(l_line_str), l_line_str);
147 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
148 dbms_lob.writeAppend(l_clob, length(l_line_str), l_line_str);
149
150 l_string := NULL;
151 FOR l_rec IN Cur_get_data LOOP
152 IF NVL(l_item, ' ') <> l_rec.item THEN
153 IF l_string IS NOT NULL THEN
154 l_string := l_string || l_new_line_str;
155 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
156 l_string := NULL;
157 END IF;
158 END IF;
159 IF l_string IS NULL THEN
160 l_cat_string := NULL;
161 FOR l_cat IN Cur_get_cat_data(l_rec.line_id) LOOP
162 IF l_cat_string IS NULL THEN
163 l_cat_string := l_cat.category_name;
164 ELSE
165 l_cat_string := l_cat_string||','||l_cat.category_name;
166 END IF;
167 END LOOP;
168 l_cat_string := RPAD(NVL(l_cat_string, ' '), 30);
169 l_string := LPAD(l_rec.line_no,3,' ')||'.'||RPAD(l_rec.item, 37, ' ')||l_cat_string;
170 END IF;
171 l_string := l_string||LPAD(TO_CHAR(l_rec.value, '9990.99999'), 10, ' ');
172 l_item := l_rec.item;
173 END LOOP;
174 l_string := l_string || l_new_line_str;
175 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
176 dbms_lob.writeAppend(l_clob, length(l_line_str), l_line_str);
177 EXCEPTION
178 WHEN OTHERS THEN
179 IF l_debug = 'Y' THEN
180 gmd_debug.put_line(l_api_name||':'||sqlerrm);
181 END IF;
182 FND_MSG_PUB.Add_Exc_Msg(l_package_name, l_api_name);
183 END print_data;
184
185 /*====================================================================
186 -- PROCEDURE:
187 -- print_constraints
188 --
189 -- DESCRIPTION:
190 -- This procedure is used to print the data in the log file.
191 --
192 -- PARAMETERS:
193 --
194 -- HISTORY
195 --====================================================================*/
196 PROCEDURE print_constraints ( p_constraints IN NUMBER
197 , p_variables IN NUMBER
198 , p_matrix IN matrix
199 , p_basic IN row
200 , p_reenter IN row
201 , p_var IN char_row
202 , p_cons IN char_row
203 , p_solved_matrix IN matrix
204 , p_solved_basic IN row
205 , p_return_code IN NUMBER) IS
206
207 l_print_line VARCHAR2(4000);
208
209 l_bool_char VARCHAR2(20);
210 l_value NUMBER;
211 l_print_value VARCHAR2(40);
212
213 l_string VARCHAR2(4000);
214
215
216 l_api_name VARCHAR2(40) := 'PRINT_CONSTRAINTS';
217 BEGIN
218 l_string := ' '||l_new_line_str;
219 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
220
221 l_string := '# Constraints: '||p_constraints||' # Variables: '||p_variables||l_new_line_str;
222 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
223
224 l_string := ' '||l_new_line_str;
225 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
226
227 l_string := 'Basic Constraint set:'||l_new_line_str;
228 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
229
230 l_string := RPAD(p_cons(1), 25, ' ')||' = '||RPAD(ROUND(p_matrix(1)(0), 5),20);
231 IF (ABS(p_solved_matrix(1)(0)) > l_LGP_EPS_ZERO) AND p_reenter(p_basic(1)) = 0 THEN
232 l_string := l_string||'**** Infeasible ****';
233 END IF;
234 l_string := l_string||l_new_line_str;
235 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
236
237 FOR i IN 2..p_constraints LOOP
238 IF p_reenter(p_basic(i)) = 0 THEN
239 l_string := RPAD(p_cons(i), 25, ' ')||' <= '||RPAD(ROUND(p_matrix(i)(0), 5), 20);
240 ELSE
241 l_string := RPAD(p_cons(i), 25, ' ')||' >= '||RPAD(ROUND(p_matrix(i)(0), 5), 20);
242 END IF;
243 IF (ABS(p_solved_matrix(i)(0)) > l_LGP_EPS_ZERO) AND p_reenter(p_solved_basic(i)) = 0 THEN
244 l_string := l_string||'**** Infeasible ****';
245 END IF;
246 l_string := l_string||l_new_line_str;
247 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
248 END LOOP;
249
250 l_string := ' '||l_new_line_str;
251 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
252 EXCEPTION
253 WHEN OTHERS THEN
254 IF l_debug = 'Y' THEN
255 gmd_debug.put_line(l_api_name||':'||sqlerrm);
256 END IF;
257 FND_MSG_PUB.Add_Exc_Msg(l_package_name, l_api_name);
258 END print_constraints;
259
260
261 /*====================================================================
262 -- PROCEDURE:
263 -- print_debug
264 --
265 -- DESCRIPTION:
266 -- This procedure is used to print the output of the matrix.
267 --
268 -- PARAMETERS:
269 -- P_matrix - Matrix.
270 --
271 -- HISTORY
272 --====================================================================*/
273 PROCEDURE print_debug ( p_constraints IN NUMBER
274 , p_variables IN NUMBER
275 , p_matrix IN matrix
276 , p_basic IN row
277 , p_reenter IN row
278 , p_var IN char_row
279 , p_cons IN char_row
280 , p_return_code IN NUMBER) IS
281 l_print_line VARCHAR2(4000);
282 l_bool_char VARCHAR2(20);
283 l_value NUMBER;
284 l_print_value VARCHAR2(40);
285
286 l_string VARCHAR2(4000);
287
288 l_item VARCHAR2(40);
289 l_line_str VARCHAR2(4000);
290 l_cat_string VARCHAR2(4000);
291 l_api_name VARCHAR2(40) := 'PRINT_DEBUG';
292 BEGIN
293 l_string := ' '||l_new_line_str;
294 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
295 l_string := '*** Debugging Information (Printed only if log level set to statement) ***';
296 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
297 l_string := 'Functional: '||-1*p_matrix(0)(0)||' Error code: '||p_return_code||l_new_line_str;
298 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
299
300 l_string := ' '||l_new_line_str;
301 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
302
303 l_string := 'Basic set:'||l_new_line_str;
304 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
305
306 FOR i IN 1..p_constraints LOOP
307 l_string := RPAD(p_cons(i), 25, ' ')||' '||p_basic(i)||'. '||RPAD(p_var(p_basic(i)), 25, ' ')||' '||ROUND(p_matrix(i)(0), 5)||l_new_line_str;
308 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
309 END LOOP;
310
311 l_string := ' '||l_new_line_str;
312 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
313
314 l_string := 'Shadow costs:'||l_new_line_str;
315 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
316
317
318 FOR j IN 1..p_variables LOOP
319 IF p_reenter(j) = 1 THEN
320 l_bool_char := 'True';
321 ELSE
322 l_bool_char := 'False';
323 END IF;
324 l_value := ROUND(p_matrix(0)(j),5);
325 l_print_value := RPAD(TO_CHAR(l_value, '9990.99999'), 10);
326
327 l_string := j||'. '||RPAD(p_var(j),30, ' ')||' '||l_print_value||' '||l_bool_char||l_new_line_str;
328 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
329 END LOOP;
330
331 l_string := ' '||l_new_line_str;
332 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
333
334 l_string := 'Matrix:'||l_new_line_str;
335 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
336
337
338 FOR i IN 0..p_constraints+1 LOOP
339 l_value := ROUND(p_matrix(i)(0),5);
340 l_print_value := RPAD(TO_CHAR(l_value, '9990.99999'), 10);
341
342 l_string := RPAD(i,4, ' ')||' '||l_print_value||' '||l_new_line_str;
343 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
344
345 l_print_line := NULL;
346 FOR j IN 1..p_variables LOOP
347 l_value := ROUND(p_matrix(i)(j),5);
348 l_print_value := RPAD(TO_CHAR(l_value, '9990.99999'), 10);
349 l_print_line := l_print_line||l_print_value||' ';
350 END LOOP;
351 l_print_line := l_print_line||l_new_line_str;
352 dbms_lob.writeAppend(l_clob, length(l_print_line), l_print_line);
353 END LOOP;
354
355 l_string := ' '||l_new_line_str;
356 dbms_lob.writeAppend(l_clob, length(l_string), l_string);
357
358 EXCEPTION
359 WHEN OTHERS THEN
360 IF l_debug = 'Y' THEN
361 gmd_debug.put_line(l_api_name||':'||sqlerrm);
362 END IF;
363 FND_MSG_PUB.Add_Exc_Msg(l_package_name, l_api_name);
364 END print_debug;
365
366 /*====================================================================
367 -- PROCEDURE:
368 -- evaluate
369 --
370 -- DESCRIPTION:
371 -- This is the main procedure that is invoked from the form to solve
372 -- the give problem.
373 --
374 -- PARAMETERS:
375 -- P_constraints - Number of constraints in the problem.
376 -- P_variables - Number of variables in the problem.
377 -- x_return - Status of the call
378 -- 0 - Optimum Found,
379 -- 1 - Unbounded
380 -- 2 - Max Iterations
381 -- 3 - Infeasible
382 --
383 -- SYNOPSIS:
384 -- GMD_LCF_ENGINE.evaluate (p_constraints => l_constraints,
385 -- p_variables => l_variables,
386 -- x_return => l_return);
387 --
388 -- HISTORY
389 --====================================================================*/
390
391 PROCEDURE evaluate (P_spec_id IN NUMBER,
392 P_constraints IN NUMBER,
393 P_variables IN NUMBER,
394 P_matrix IN matrix,
395 p_rhs_matrix IN char_matrix,
396 p_var_row IN char_row,
397 X_solved_tab OUT NOCOPY solved_tab,
398 X_return OUT NOCOPY NUMBER) IS
399 l_matrix matrix;
400 l_solved_matrix matrix;
401 l_basic row;
402 l_out_basic row;
403 l_reenter row;
404 l_variables NUMBER;
405 l_return_status VARCHAR2(1);
406 l_print_line VARCHAR2(2000);
407 l_var char_row;
408 l_cons char_row;
409 l_row_count BINARY_INTEGER := 0;
410 BEGIN
411 /* Initialize the return code */
412 x_return := 0;
413
414 Read_Table (p_constraints => p_constraints,
415 p_variables => p_variables,
416 p_matrix => p_matrix,
417 p_rhs_matrix => p_rhs_matrix,
418 p_var => p_var_row,
419 x_matrix => l_matrix,
420 x_basic => l_basic,
421 x_reenter => l_reenter,
422 x_variables => l_variables,
423 x_con => l_cons,
424 x_var => l_var,
425 x_return_status => l_return_status);
426
427 IF l_debug = 'Y' THEN
428 Print_Data ( p_constraints => p_constraints
429 , p_variables => l_variables
430 , p_matrix => l_matrix
431 , p_basic => l_basic
432 , p_reenter => l_reenter
433 , p_var => l_var
434 , p_cons => l_cons
435 , p_return_code => x_return);
436 END IF;
437
438
439 Solve_lgp (P_constraints => P_constraints
440 ,P_variables => l_variables
441 ,P_matrix => l_matrix
442 ,p_reenter => l_reenter
443 ,p_basic => l_basic
444 ,x_matrix => l_solved_matrix
445 ,x_basic => l_out_basic
446 ,X_return => X_return);
447
448 IF l_debug = 'Y' THEN
449 Print_Constraints ( p_constraints => p_constraints
450 , p_variables => l_variables
451 , p_matrix => l_matrix
452 , p_basic => l_basic
453 , p_reenter => l_reenter
454 , p_var => l_var
455 , p_cons => l_cons
456 , p_solved_matrix => l_solved_matrix
457 , p_solved_basic => l_out_basic
458 , p_return_code => x_return);
459 END IF;
460
461
462 FOR i IN 1..p_constraints LOOP
463 IF l_out_basic(i) <= p_variables THEN
464 l_row_count := l_row_count + 1;
465 x_solved_tab(l_row_count).item := l_var(l_out_basic(i));
466 x_solved_tab(l_row_count).qty := ROUND(l_solved_matrix(i)(0), 5);
467 END IF;
468 END LOOP;
469
470 /* If the log level is set to statement then print the debug information */
471 IF l_log_level = 1 AND l_debug = 'Y' THEN
472 Print_Debug( p_constraints => p_constraints
473 , p_variables => l_variables
474 , p_matrix => l_matrix
475 , p_basic => l_basic
476 , p_reenter => l_reenter
477 , p_var => l_var
478 , p_cons => l_cons
479 , p_return_code => x_return);
480 END IF;
481
482 IF l_debug = 'Y' THEN
483 insert_clob (p_spec_id => p_spec_id);
484 END IF;
485 END evaluate;
486
487 /*====================================================================
488 -- PROCEDURE:
489 -- read_table
490 --
491 -- DESCRIPTION:
492 -- This procedure is used to read the constraints and build the
493 -- tables needed for solving the problem.
494 --
495 -- PARAMETERS:
496 -- P_constraints - Number of constraints in the problem.
497 -- P_variables - Number of variables in the problem.
498 -- P_matrix - Set of constraints in matrix format.
499 -- P_rhs_matrix - Right hand side values for the constraints
500 -- X_matrix - Out matrix
501 -- X_basic - Out row
502 -- X_reenter - Out row
503 -- X_variables - Actual number of variables
504 -- x_return_status - Status of the call
505 -- S - SUCCESS,
506 -- E,U - Error
507 --
508 -- HISTORY
509 --====================================================================*/
510 PROCEDURE read_table(P_constraints IN NUMBER,
511 P_variables IN NUMBER,
512 P_matrix IN matrix,
513 P_rhs_matrix IN char_matrix,
514 p_var IN char_row,
515 X_matrix OUT NOCOPY matrix,
516 X_basic OUT NOCOPY row,
517 X_reenter OUT NOCOPY row,
518 X_variables OUT NOCOPY NUMBER,
519 X_con OUT NOCOPY char_row,
520 X_var OUT NOCOPY char_row,
521 X_return_status OUT NOCOPY VARCHAR2) IS
522 l_y ROW;
523 l_iLo NUMBER;
524 l_iHi NUMBER;
525 l_pen_low NUMBER;
526 l_pen_high NUMBER;
527 l_rhs NUMBER;
528 l_temp NUMBER;
529 BEGIN
530 IF l_debug = 'Y' THEN
531 gmd_debug.put_line('LPReadTable:');
532 END IF;
533
534 /* initialize return status */
535 x_return_status := FND_API.g_ret_sts_success;
536 x_var := p_var;
537
538 /* calculate the actual number of variables */
539 x_variables := P_variables + 2*P_constraints;
540
541 IF l_debug = 'Y' THEN
542 gmd_debug.put_line('LGP:Cons:'||P_constraints||' Var:'||P_variables||' Total Var:'||x_variables);
543 END IF;
544
545 /* Initialize the arrays */
546 FOR i IN 0..P_constraints + 1 LOOP
547 X_basic(i) := 0;
548 FOR j IN 0..x_variables LOOP
549 X_matrix(i)(j) := 0;
550 END LOOP;
551 END LOOP;
552
553 FOR j IN 0..x_variables LOOP
554 IF j BETWEEN 1 AND p_variables THEN
555 X_reenter(j) := 1;
556 ELSE
557 X_reenter(j):= 0;
558 END IF;
559 END LOOP;
560
561 FOR j IN 1..p_variables LOOP
562 /* Read the optimizing constraint row */
563 X_matrix(0)(j) := P_matrix(0)(j);
564 END LOOP;
565
566 /* read matrix, rows 1 ... ncon+1 are constraints */
567 x_con(p_constraints + 1) := 'ArtCosts';
568 FOR i IN 1..P_constraints LOOP
569 /* index of slack for row */
570 l_iLo := P_variables+ 2*i-1;
571 /* index of excess for row */
572 l_iHi := P_variables +2*i;
573
574 x_con(i) := p_rhs_matrix(i)(0);
575 /* Assign the righ hand side value */
576 l_rhs := P_rhs_matrix(i)(1);
577 x_matrix(i)(0) := l_rhs;
578 /* Assign the penalties */
579 l_pen_low := P_rhs_matrix(i)(2);
580 l_pen_high := P_rhs_matrix(i)(3);
581
582 FOR j IN 1..P_variables LOOP
583 x_matrix(i)(j) := p_matrix(i)(j);
584 END LOOP;
585
586 /* Reverse the signs */
587 IF l_rhs < 0 THEN
588 FOR j IN 0..x_variables LOOP
589 x_matrix(i)(j) := -1 * x_matrix(i)(j);
590 l_temp := l_pen_low;
591 l_pen_low := l_pen_high;
592 l_pen_high := l_temp;
593 END LOOP;
594 END IF; /* IF l_rhs < 0 */
595
596 IF l_log_level = 1 THEN
597 gmd_debug.put_line('i:'||'Low:'||l_iLo||' High:'||l_iHi||'Cons:'||x_con(i)||' Pen Low:'||l_pen_low||' Pen Hi:'||l_pen_high);
598 END IF;
599
600 X_var(l_iLo) := X_con(i)||'+';
601
602 IF l_pen_low < l_LGP_BIG THEN
603 X_reenter(l_iLo) := 1;
604 x_matrix(0)(l_iLo) := l_pen_low; -- Save slack cost
605 ELSE
606 x_matrix(0)(l_iLo) := 0; -- artificial cost
607 X_reenter(l_iLo) := 0; -- don't allow entering
608 END IF;
609 x_matrix(i)(l_iLo) := 1; -- Slack cooefficient
610 x_basic(i) := l_iLo; -- Slack in initial basis
611
612 x_var(l_iHi) := x_con(i)||'-';
613
614 IF l_pen_high < l_LGP_BIG THEN
615 X_reenter(l_iHi) := 1;
616 x_matrix(0)(l_iHi) := l_pen_high; -- Save excess cost
617 ELSE
618 x_matrix(0)(l_iHi) := 0; -- artificial cost
619 X_reenter(l_iHi) := 0; -- don't allow entering
620 END IF;
621 x_matrix(i)(l_iHi) := -1; -- Excess cooefficient
622 END LOOP;
623
624 /* adjust costs for basic vars */
625 FOR i IN 1..p_constraints LOOP
626 l_y(i) := x_matrix(0)(x_basic(i));
627 END LOOP;
628
629 FOR j IN 1..x_variables LOOP
630 FOR i IN 1..p_constraints LOOP
631 x_matrix(0)(j) := x_matrix(0)(j) - l_y(i) * x_matrix(i)(j);
632 END LOOP;
633 END LOOP;
634 END read_table;
635
636
637 /*====================================================================
638 -- PROCEDURE:
639 -- solve_lgp
640 --
641 -- DESCRIPTION:
642 -- This procedure is invoked from the main evaluate routine to solve
643 -- the given problem to find feasible and then optimal solution.
644 --
645 -- PARAMETERS:
646 -- P_constraints - Number of constraints in the problem.
647 -- P_variables - Number of variables in the problem.
648 -- P_matrix - Set of constraints in matrix format.
649 -- P_reenter - row marking the entry
650 -- p_basic - row type
651 -- x_return - Status of the call
652 -- 0 - Optimum Found,
653 -- 1 - Unbounded
654 -- 2 - Max Iterations
655 -- 3 - Infeasible
656 --
657 --
658 --IN: nCon = number of constraint rows (costs are row #0)
659 -- nVar = # of variables (RHS = 0)
660 --INOUT: iBasic(0..nCon+1) = basic variable index vecter
661 -- Tableau(0..nCon+1,0..nVar) = Tableau for LP problem:
662 -- 1 2 nVar
663 --0 | Opt | | | ... | | Cost row
664 --1 | RHS(1) | | | ... | | 1st constraint row
665 --...
666 --nCon | RHS(nCon) | | | ... | | nCon constraint row
667 --nCon+1 | | | | ... | | artificial costs for Phase I
668 --NOTES: Optimum solution is -Tableau(0,0). Shadow costs are in Tableau(0,1..nVar).
669 -- Solution is in Tableau(1..nCon,0).
670 --
671 -- HISTORY
672 --====================================================================*/
673 PROCEDURE solve_lgp (P_constraints IN NUMBER,
674 P_variables IN NUMBER,
675 P_matrix IN matrix,
676 P_reenter IN row,
677 P_basic IN row,
678 X_matrix OUT NOCOPY matrix,
679 X_basic OUT NOCOPY row,
680 X_return OUT NOCOPY NUMBER) IS
681 l_max_iterations PLS_INTEGER;
682 l_temp_col ROW;
683 l_cost_row NUMBER;
684 l_iteration NUMBER;
685 l_min_cost NUMBER;
686 l_enter NUMBER;
687 l_print_line VARCHAR2(2000);
688 l_leave PLS_INTEGER;
689 l_min NUMBER;
690 l_var_tie NUMBER;
691 l_broken_tie BOOLEAN;
692 l_x NUMBER;
693 l_diff NUMBER;
694 l_row NUMBER;
695 BEGIN
696 /* initialize global variables and constants */
697 X_return := 0; -- No error
698 x_matrix := p_matrix;
699 x_basic := p_basic;
700
701 /* set maximum number of iterations */
702 l_max_iterations := 10 * P_constraints;
703
704 IF l_debug = 'Y' THEN
705 gmd_debug.put_line('LPSolve:Cons:'||P_constraints||' Var:'||P_variables||' Max Iter:'||l_max_iterations);
706 END IF;
707
708 /* set up artificial costs */
709 FOR i IN 1..P_constraints LOOP
710 /* infinite penaly, treat as artificial var */
711 IF P_reenter(x_basic(i)) = 0 THEN
712 FOR j IN 0..P_variables LOOP
713 /* cost is neg sum of coefs in column */
714 x_matrix(p_constraints + 1)(j) := x_matrix(p_constraints + 1)(j) - x_matrix(i)(j);
715 END LOOP;
716 END IF;
717 END LOOP;
718
719 /* first phase, use artificial costs */
720 l_cost_row := P_constraints + 1;
721
722 /* zero iteration counter */
723 l_iteration := 0;
724 /* simplex iteration loop - endless loop until error or optimal */
725 WHILE 1 = 1 LOOP
726 /* find variable to enter (minimum (neg) value of reduced cost) */
727 l_min_cost := 0;
728 /* temp index */
729 l_enter := 0;
730 FOR j IN 1..P_variables LOOP
731 /* cost is negative and can enter */
732
733 IF (x_matrix(l_cost_row)(j) < 0) AND
734 (p_reenter(j) = 1) THEN
735
736 /* found a smaller cost */
737 IF (l_min_cost > x_matrix(l_cost_row)(j)) THEN
738 l_min_cost := x_matrix(l_cost_row)(j);
739 l_enter := j;
740 END IF;
741 END IF;
742 END LOOP;
743
744 IF l_enter = 0 THEN
745 /* no variable lowers cost: optimal or Non-implementable */
746 IF (l_cost_row = 0) THEN
747 X_return := 0;
748 EXIT;
749 END IF;
750
751 /* check for feasibility (iCostRow = ncon+1 here) */
752 FOR j IN 1..P_variables LOOP
753 IF (x_matrix(l_cost_row)(j) > l_LGP_EPS_ZERO) THEN
754 /* Non-implementable */
755 X_return := 3;
756 EXIT;
757 END IF;
758 END LOOP;
759
760 /* Quit */
761 IF X_return = 3 THEN
762 EXIT;
763 END IF;
764
765 /*if we get here, solution is implementable */
766
767 IF l_debug = 'Y' THEN
768 gmd_debug.put_line('Solution is implementable:');
769 FOR i IN 1..P_constraints LOOP
770 l_print_line := NULL;
771 FOR j IN 1..P_variables LOOP
772 l_print_line := l_print_line||x_matrix(i)(j)||' ';
773 END LOOP;
774 gmd_debug.put_line(l_print_line);
775 END LOOP;
776 END IF;
777
778 /* set to actual costs */
779 l_cost_row := 0;
780 ELSE
781 /* have entering variable to include */
782 l_leave := 0; -- find variable to leave
783 l_min := l_LGP_BIG; -- set to infinity initially
784
785 FOR i IN 1..P_constraints LOOP
786 /* consider only variables with positive coefficients */
787 IF (x_matrix(i)(l_enter) > l_LGP_EPS_ZERO) THEN
788 l_var_tie := 0;
789 l_broken_tie := FALSE;
790 WHILE NOT (l_broken_tie) LOOP
791 IF (l_var_tie = 0) THEN -- first time
792 /* max amount can change RHS/coef */
793 l_x := x_matrix(i)(0) / x_matrix(i)(l_enter);
794 ELSE -- have tie
795 l_x := x_matrix(i)(x_basic(l_var_tie + 1)) / x_matrix(i)(l_enter);
796 END IF;
797
798 l_diff := l_x - l_min;
799 /* keep min value esitmate */
800 IF (l_diff <= l_LGP_EPS_ZERO) THEN
801 /* keep smallest max amt */
802 l_min := x_matrix(i)(0) / x_matrix(i)(l_enter);
803 l_leave := i; -- and row
804 l_broken_tie := TRUE;
805 ELSIF (abs(l_diff) < l_LGP_EPS_ZERO) THEN -- have tie
806 l_var_tie := l_var_tie + 1;
807 l_min := x_matrix(l_leave)(x_basic(l_var_tie + 1)) / x_matrix(i)(l_enter);
808 ELSE
809 l_broken_tie := TRUE;
810 END IF;
811 END LOOP; /* WHILE NOT (l_broken_tie) */
812 END IF; /* IF (x_matrix(i)(l_enter) > l_LGP_EPS_ZERO) */
813 END LOOP; /* FOR i IN 1..P_constraints */
814
815 /* unbounded .. no positive coefficients */
816 IF l_leave = 0 THEN
817 X_return := 1; -- unbounded solution;
818 EXIT;
819 END IF;
820
821 /* gaussian elimination to replace iLeave with iEnter */
822 x_basic(l_leave) := l_enter; -- keep new variable number
823 l_x := x_matrix(l_leave)(l_enter); -- pivot value
824 IF (l_cost_row = 0) THEN
825 l_row := p_constraints;
826 ELSE
827 l_row := p_constraints + 1;
828 END IF;
829
830 FOR i IN 0..l_row LOOP
831 l_temp_col(i) := x_matrix(i)(l_enter);
832 END LOOP;
833
834 /* calculate new pivot row */
835 FOR j IN 0..P_variables LOOP
836 x_matrix(l_leave)(j) := x_matrix(l_leave)(j) / l_x;
837 END LOOP;
838
839 FOR i IN 0..l_row LOOP
840 IF (i <> l_leave) THEN
841 FOR j IN 0..p_variables LOOP
842 x_matrix(i)(j) := x_matrix(i)(j) - l_temp_col(i) * x_matrix(l_leave)(j);
843 END LOOP;
844 END IF;
845 END LOOP;
846
847 /* increment iteration count */
848 l_iteration := l_iteration + 1;
849 -- utl_file.put_line(l_file, 'At Iteration#'||l_iteration||' Value is:'||ROUND((-1*x_matrix(l_cost_row)(0)), 9)||' Entering is:'||x_basic(l_leave));
850 IF l_debug = 'Y' THEN
851 gmd_debug.put_line('At Iteration#'||l_iteration||' Value is:'||(-1*x_matrix(l_cost_row)(0))||' Entering is:'||x_basic(l_leave));
852 END IF;
853
854 IF l_iteration > l_max_iterations THEN
855 X_return := 2; -- max iterations
856 EXIT;
857 END IF;
858 END IF; /* IF l_enter = 0 */
859
860 END LOOP; /* WHILE 1 = 1 */
861 END solve_lgp;
862
863
864 END GMD_LCF_ENGINE;