Linear planning source program (C language version)

zhaozj2021-02-16  52

BBS Shuimu Tsinghua Station - Essence Article Reading

-------------------------------------------------- ------------------------------ Sender: Fangq (F the world), the letter area: Numcomp Title: Re: Urgent Source program (C language version) in linear planning: BBS Shuimu Tsinghua Station (Sat Jun 30 15:45:48 2001)

Message 5 in thread shippers: Vic Smyth (vicsmyth@megsinet.net): Re: linear programming News Group: Comp.Programming Date: 1999/05/25

Tim,

Do not know about C , but Linear Programming and Simplex are coveredin chapter 10 of Numerical Recipies in C. You can review the codeon-line at http://beta.ulib.org/webRoot/Books/Numerical_Recipes/

- BILL CLAY

A program that we use at college in the linear programming (math) class is called Lindo. But I do not know if it's available as freeware. Math software Maple can also do Simplex. (Though I have not taken the class yet and Haven't Tried It.)

[In the masterpiece of Aliali (Cheng Xuan) mentioned:]: Thank you.

-

http://fangqq.dhs.org/

※ Source: · BBS Shuimu Tsinghua Station Smth.org · [From: 129.170.67.237] Sender: Fangq (F THE World), Word Area: Numcomp Title: Re: Emergency Linear Planning Source Procedure (C Language Edition) ) Sending station: BBS Shuimu Tsinghua Station (Sat Jun 30 15:48:32 2001)

Attached Below Is A Fairly Simplex Solver (Written Forturbo Pascal 3.0). Please let me know of how you use theprogram, as well..

REGARDS,

Stephen

============================================================================================================================================================================================================= =================== Stephen F. Gale, B.SC., CCP, ISPSFGALE@freenet.calgary.ab.cahttp: //www.freeet.calgary. Ab.ca/~sfgale/============================================= =================================================== Populati / communit / asmcal / asmcal.html ========================================= ============================ ***************************** ***** SIMPLEX Software ***********************************

PROGRAM linearoptimization;

Const rowmx = 72; colmx = 112; mxval = 1.0e 35; zero = 0.0; eqzero = 0.00000001;

Var Matrix: Array [0..Rowmx, 0..colmx] of real; baris: array [1..rowmx] of integer; Basisp: array [1..rowmx] of integer; minmax: real; error: integer name: string [70]; filename: string [14]; ncon: integer; {number of constraints} nvar: integer; {number of variables} nltcon: integer; {number of less than constraints} neqcon: integer; {number of equal to constraints} ngtcon: integer; {number of greater than contraints} trows1: integer; trows2: integer; tcols1: integer; tcols2: integer; tcols3: integer; function getmatrix (row, col: integer): real; begin getmatrix: = Matrix [Row, Col]; END;

Procedure Putmatrix (Row, Col: Integer; Value: Real); Begin Matrix [Row, Col]: = Value;

Procedure Initmatrix; Var Row, Col: Integer; Begin for Row: = 0 To RowMx Do for Col: = 0 To Colmx Do Putmatrix (Row, Col, Zero); End;

Procedure Price (VAR Xcol: Integer; Var Error: Integer; VAR QUANT, VAL: REAL; Col: = - EQZERO; For Col: = 1 To Tcols3 Do Begin Val: = GetMatrix TROW, COL); if (Val

Procedure Leave (VAR Xrow: Integer; Var Error: Integer); Var Quant, Val: Real; Row: Integer; Begin Quant: = MXVAL; For Row: = 1 To Ncon Do Begin Val: = getMatrix (Row , Xcol); if (Val> Eqzero) The begin Val: = getMatrix (Row, Tcols2) / Val; IF (Val xrow) THEN BEGIN VL: = GetMatrix (Row, Xcol); for col: = 1 to Tcols2 DO if (col <> xcol) THEN BEGIN VAL: = GetMatrix (Row, Col) - VL * getMatrix (Xrow, Col) / Value; IF (ABS (VAL)

Procedure Optimize (TROW: Integer; Var Xrow, Xcol, Iterate: Integer; Begin Repeat Price (XROU, TROW, ERROR); if (Error = 0) Then Leave (Xrow, Xcol, Error); IF (Error = 0) THEN PIVOT (XROW, XCOL); Until (Error <> 0) end; procedure simplex (var); VAR: REAL; ROW, Col: Integer; Flag: Boolean; label 1000; Begin IF (NCON <> nltcon) THEN BEGIN OPTIMIZE (TROWS1, ERROR); if (Error> 1) THEN EXIT; error: = 3; for row: = 1 to ncon do if (Basis [Row]> Tcols3) THEN Begin IF (GetMatrix (Row, Tcols2)> EQZERO) THEN EXIT; FLAG: = FALSE; Col: = 1; Repeat IF (ABS (GetMatrix (Row, Col))> = EQZERO) THEN BEGIN PIVOT (Row, Col); Flag: = True; end; Col: = col 1; Until ((flag) or (col> tcols3)); end; end; error: = 0; Optimize (TROWS2, ERROR); END;

Procedure Reader; Var Row, Col, Column: Integer; Value, Amt: Real; Filevar: Text; Begin Error: = 0; Writeln (Con, 'Problem File Should Be in The Following Format:') Writeln (Con, 'Line 1: Up to 70 Character Problem Description'); Writeln (Con, 'Line 2: 1 (for MIN); # of constraints; # of variables'); Writeln (Con, 'Line 3: # of <= constraints; # of> = constraints'); Writeln (Con,' Next: ConsTRAINTS COEFFICIENTS AND RHS VALUE for Each Constraint '); Writeln (Con,' Last: Objective Function Coefficients'); Writeln (Con); Write (Con, 'Enter the FileName Containing The Problem:'); Readln (Con, FileName); Assign (FileVar); RESET (FileVar); {Read THE problem description} readln (filevar, name); {read the minmax, number of constraints, number of variables} readln (filevar, minmax, ncon, nvar); minmax: = -minmax; {read the number of less than, equal to , Greater TH An contraints}}}; ngtcon; IF (NCON <> NLTCON NEQCON NGTCON) THEN Error: = -1; trows1: = nCon 1; TROWS2: = NCON 2; tcols1: = nvar NCON NGTCON; TCOLS2: = Tcols1 1; tcols3: = nvar nltcon ngtcon; {prepare matrix and basis} for row: = 1 to trows2 do for col: = 1 To Tcols2 Do Putmtrix (Row, Col, Zero ); For row: = 1 to ncon do basis [row]: = 0; {prepare artificial and surplus variables} for row: = 1 to nCON DO if (ROW <=

Nltcon column: = nvar row; basis [row]: = column; putmatrix (row, column, 1.0); Else Begin column: = nvar ngtcon row; baSis [row]: = column; putmatrix (Row, Column, 1.0); if (row> nltcon neqcon) THEN BEGIN Column: = NVAR - Neqcon Row; PUTMAMATRIX (Row, Column, -1.0); PUTMAMATRIX (TROWS1, Column, 1.0); End end ; {Read matrix and right hand side} for row: = 1 to ncon do beg: = 1 to nvar do begin read (filevar, value); PUTMATRIX (Row, Col, Value); end; read (filevar, value ); PUTMATRIX (Row, 0, Value); PUTMAMATRIX (Row, Tcols2, Value); Readln (FileVar); End; {Read the Coeffects of the Objective Function} for col: = 1 To NVAR Do Begin Read (Filevar, Value); Putmatrix (0, Col, Value * Minmax); PUTMAMATRIX (TROWS2, COL, VALUE * MinMax); End; Readln (FileVar); {Calculate Artifical Variables} for col: = 1 to nVar do Begin Value: = zero; for row: = nltcon 1 to ncon do value: = value - getMatrix (Row, col); PUTMATRIX (TROWS1, COL, VALUE); END; Close (filevar);

Procedure stats; begin writeln; Writeln ('* your); if (nltcon> 0) THEN WRITELN (' * slack variables: ', nvar 1,' through ', nvar nltcon); if (NGTCON> 0) THEN WRITELN ('* surplus variables:', NVAR NLTCON 1, 'Through', Tcols3); if (Nltcon <> NCON) THEN WRITELN ('* artificial variables:', tcols3 1, ' THROUGH ', TCOLS1); End; Procedure setBasis; Var Row, Col: Integer; Flag: Boolean; Begin for Col: = 1 to nVar NCON Do Begin Flag: = false; row: = 1; Repeat IF (Basis [Row " ] = col) THEN flag: = True else row: = row 1; Until (ROW> NCON)); if (flag) Then Basisp [Col]: = Row else Basisp [col]: = 0 ;

Procedure Problem; Var Row, Col: Integer;

begin {filename and problem description} writeln ( 'Filename:', filename); writeln ( 'Problem:', name); writeln; {objective function} if minmax <0 then writeln ( 'Maximize:') else writeln ( 'Minimize : '); For col: = 1 to NVAR Do Begin Write (TROWS2, COL): 18: 8,' * Var # ', Col: 3); if col <> nvar Then Write (' ' ); Writeln; end; writeln; {constraints }writeln ('Subject to:'); for row: = 1 to ncon do begin for col: = 1 to nVAR do begin if (col = 1) THEN WRITE ('connectiont # ', Row: 3,' ... ') Else Write (' ': 20); Write (GetMatrix (Row, Col): 18: 8,' * Var # ', Col: 3); if Col <> nvar THEN WRITELN (' '); end; if (ROW <= nltcon) THEN WRITE ('<=') Else IF (Row> NLTCON NEQCON) THEN WRITE ('> =') Else Write ('=');Writeln (ROW, TCOLS2): 18: 8); end; end; procedure answer; var smallpos: real; smallptr: Integer; Largeneg: Real; ROW, REAL; REAL; ROW, COL, ROW1: Integer;

Begin setbasis; stats; {Objective value} Writeln; Writeln ('* value of objective function:', -minmax * getMatrix (TROWS2, TCOLS2): 18: 8); Writeln; writeln ('* variable analysis *'); WriteLn ('Var': 3, 'Value': 18, 'Reduced COST': 18); Writeln ('---': 3, '-----': 18, '-------- ---- ': 18); for col: = 1 to nvar do begin Write (col: 3); if (Basisp [Col => 0) THEN WRITE (Basisp [col], tcols2: 18: 8) Else Write (0.0: 18: 8); Write (TROWS2, COL): 18: 8); Writeln; End; Writeln; Writeln ('* constraint analyysis *'); WriteLn ('Row' : 3, 'RHS Value': 18, 'SLACK / SURPLUS': 18, 'Shadow Price': 18); Writeln ('---': 3, '---------': 18, '-------------': 18, '------------': 18); for row: = 1 to ncon do begin if (ROW <= Nltcon) THEN Col: = NVAR ROW ELSE IF (Row> NLTCON NEQCON) THEN Col: = nvar row - Neqcon else col: = nvar NGTCON ROW; WRITE (Row: 3); Write (GetMatrix (Row, 0): 18: 8); if (Basisp [Col] <> 0) THEN Write (BASISP [Col], Tcols2): 18: 8) Else Write (0.0: 18: 8); Write (-minmax * getMatrix (TROWS2, COL): 18: 8); Writeln; end; WriteLn (' '); Writeln (' * Sensitivity Analysis - Right Hand Side Ranging * '); Writeln (' Row ': 3,'

Lower ': 18,' Current ': 18,' Upper ': 18,' Outlo ': 6,' Outup ': 6); Writeln (' --- ': 3,' ----- ': 18, '-------': 18, '-----': 18, '-----': 6, '-----': 6); for row1: = 1 to ncon Do Begin if (Row1 <= nltcon) THEN Col: = NVAR ROW1 ELSE IF (Row1> NVAR NEQCON) THEN Col: = NVAR ROW1 - NEQCON ELSE Col: = NVAR NGTCON ROW1; SmallPos: = MXVAL; Smallptr: = 0; largeneg: = -Mxval; largeptr: = 0; for row: = 1 To Ncon DO

Begin Value: = getMatrix (Row, Col); if (value <> zero) THEN BEGIN VALUE: = getMatrix (Row, Tcols2) / Value; if (Value> Zero) Then Begin SmallPos: = VALUE Smallptr: = basis [row]; end; if (value largeneg) THEN BEGIN LARGENEG: = Value; Largeptr: = basis [Row]; End; End; End; IF (Row1 <= nltcon Neqcon Write (Row1: 3); if (SmallPOS <> MXVAL) THEN WRITE ((GetMatrix (Row1, 0) -smallpos: 18: 8) Else Write ('no limit': 18); Write (GetMatrix (R OW1, 0)): 18: 8); if (Largeneg <> -Mxval) THEN WRITE ((GetMatrix (Row1, 0) -largeneg): 18: 8) Else Write ('no limit': 18); if ( Smallptr: 6) Else Write ('None': 6); if (Largeptr: 6) Else Write ('None': 6); Else Begin Write (Row1: 3); if (Largeneg <>

-mxval) THEN WRITE ((GetMatrix (Row1, 0) Largeneg): 18: 8) Else Write ('NO LIMIT': 18); Write ((GetMatrix (Row1, 0)): 18: 8); IF Smallpos <> mxval) THEN WRITE ((GetMatrix (Row1, 0) SmallPos: 18: 8) Else Write ('NO LIMIT': 18); if (LargePtr: 6) THEN WRITE (Largeptr: 6) Else Write ('None': 6); IF (SmallPtr: 6) Else Write ('None': 6); End; Writeln; End; WriteLn (''); Writeln ('* Sensitivity Analysis - Objective Coefficient Ranging * '); Writeln (' Var ': 3,' Lower ': 18,' Current ': 18,' Upper ': 18,' Inlo ': 6,' Inup ': 6); Writeln (' --- ': 3,' ----- ': 18,' ------- ': 18,' ----- ': 18,' ---- ': 6,' - --- ': 6); for col: = 1 to nvar do begin Smallpos: = mXVal; smallptr: = 0; largeneg: = -Mxval; largeptr: = 0; if (Basisp [col] = 0) Then IF (MinMax <0) Then Begin SmallPos: = -minmax * getMatrix (Trows2, COL); SmallPtr: = Col; Else Begin Largeneg: = -minmax * getMatrix (TROWS2, COL); Largeptr: = Col; Else for row: =

1 to tcols3 do if (Basisp [ROW] = 0) THEN Begin Value: = getMatrix (Basisp [Col], ROW); if (Value <> Zero) Then Begin Value: = MinMax * getMatrix (Trows2, Row) / Value ; If (value> zero) THEN BEGIN SMALLPOS: = value; smallptr: = row; end; if (value largeneg) Then Begin Largeneg: = value; largeptr: = row End; end; end; write (col: 3); if (Largeneg <> -Mxval) THEN WRITE ((MinMax * getMatrix (0, col) largeneg): 18: 8) Else Write ('no limit ": 18); WRITE ((MinMax * getMatrix (0, col)) : 18: 8); if (smallpos <> mxval) THEN WRITE ((MinMax * getMatrix (0, COL) SmallPos): 18: 8) Else Write ('NO LIMIT': 18); if (LargePtr <> 0 (LargePtr: 6) Else Write ('None': 6); IF (SmallPtr: 6) Else Write ('None': 6); WriteLn; end;

Procedure Print; Var Row, Col: Integer; Begin Writeln; for Row: = 1 To Trows2 Do Begin If (Row> 0) And (ROW <= nCON) THEN WRITE (Basis [Row]: 2, '') Else Write (''); For col: = 1 to Tcols2 do Write (GetMatrix (Row, Col): 9: 3, '); Writeln; End; Writeln; End; Begin Initmatrix; Writeln; Writeln (' *** linear Programming - Simplex Algorithm *** '); Writeln; Reader (Error); Problem; if (Error = 0) Then Simplex (Error); Error = 0) or (Error = 1) THEN ANSWER; if (Error < 0) THEN WRITELN ('- Inconstent Data - Not Run -'); if (Error = 2) Then Writeln ('- the solution is unbounded -'); if (error = 3) Then Writeln ('- - the problem is infeasible - '); end.

**************************************************

Photocopy - Sensitivity Analysis - Page 329-1 5 42 0 3 1.00 1.00 0.00 0.00 1.00 1.00-00-00-00.00 20.00 110.00 10.00 0.00 200.00 15.00 10.00 8.00 48.00 100.00 50.00 80.00 15.00 180.00

**********************************************************************

*** Linear Programming - Simplex Algorithm ***

Filename: PC329.LP Problem: Photocopy - Sensitivity Analysis - Page 329

Minimize: 50.00000000 * Var # 1 80.00000000 * Var # 2 15.000000 * Var # 3 180.00000000 * Var # 4

Subject to: constraint # 1 ... 1.00000000 * Var # 1 0.00000000 * Var # 2 0.00000000 * Var # 3 0.00000000 * Var # 4 <= 2.00000000 constraint # 2 ... 0.00000000 * Var # 1 1.00000000 * Var # 2 0.00000000 * Var # 3 0.00000000 * Var # 4 <= 1.50000000 Constraint # 3 ... 300.00000000 * Var # 1 1000.00000000 * Var # 2 10.00000000 * Var # 3 150000000000 * Var # 4> = 2500.00000000 Constraint # 4 ... 20.00000000 * var # 1 110.00000000 * Var # 2 10.00000000 * Var # 3 0.00000000 * Var # 4> = 200.00000000 Constraint # 5 ... 15.00000000 * Var # 1 10.00000000 * Var # 2 8.00000000 * VAR # 3 48.00000000 * Var # 4> = 100.00000000 * Your Variables: 1 THROUGH 4 * SLALUS: 5 THROUGH 6 * Surplus Variables: 7 THROUGH 9 * Artificial Variables: 10 THROUGH 12

* Value of Objective Function: 335.23437500

* VARIABLE Analysis * var value reduced cost ------------------ 1 0.00000000-2.29687500 2 1.50000000 0.00000000 3 6.90104167 0.00000000 4 0.62065972 0.00000000

* ConsTRAINT Analysis * RHS Value Slack / Surplus Shadow Price ---------------------- 1 2.00000000 2.00000000 0.00000000 2 1.50000000 0.00000000 -0.46875000 3 2500.00000000 0.00000000 -0.06250000 4 200.00000000 34.01041667 0.00000000 5 100.00000000 0.00000000 -1.79687500 * Sensitivity Analysis - Right Hand Side Ranging * Row Lower Current Upper OutLo OutUp --- ----- ----- - - ------------- 1 0.00000000 2.00000000 NO LIMIT 5 None 2 1.25469572 1.50000000 2.40506329 8 4 3 1606.25000000 2500000000 3316.25000000 4 8 4 NO LIMIT 200.00000000 234.01041667 None 8 5 73.8800000001 8 4

* Sensitivity Analysis - Objective Coefficient Ranging * Var Lower Current Upper Inlo Inup -------------------- ---- 1 45.70312500 50.00000000 NO LIMIT 1 NONE 2 NO LIMIT 80.00000000 80.46875000 None 6 3 1.20000000 15.00000000 15.16363636 9 6 4 179.31645570 180.00000000 202.00000000 6 1

[In the masterpiece of Aliali (Cheng Xuan) mentioned:]: Thank you.

-

http://fangqq.dhs.org/

※ Source: · BBS Shuimu Tsinghua Station SMTH.org · [From: 129.170.67.237]

-------------------------------------------------- ------------------------------[return to previous page]

转载请注明原文地址:https://www.9cbs.com/read-19110.html

New Post(0)