C ----------------------------------------------------------------------- C C Author: Wm. M. Stewart C C Date: December 13, 1987 C C Purpose: Reads and solves linear programs with fuzzy sets (logic). C C Reference: Zimmermann, H. J. (1978) "Fuzzy Programming and Linear C Programming with Several Objective Functions", Fuzzy C Sets and Systems, North-Holland Publishing Company, C pp. 45-55 C C ----------------------------------------------------------------------- C C GPL 3 Licensed. C C (c) Copyright W. Stewart, December 13, 1987. C C This program is free software: you can redistribute it and/or modify C it under the terms of the GNU General Public License as published by C the Free Software Foundation, either version 3 of the License, or C (at your option) any later version. C C This program is distributed in the hope that it will be useful, C but WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You can find a copy of the full license at C www.gnu.org/licenses/gpl.txt. C C ----------------------------------------------------------------------- C C Major Variables C --------------- C C CONS - Matrix of constraints. C C CS - Matrix of objective functions. C C MAXOBJ - Array of maximum values of each objective function over the C solutions. C C MINOBJ - Array of minimum values of each objective function over the C solutions. C C NC - Number of objective functions. C C NCON - Number of constraints. C C NVAR - Number of variables. C C OBJ1 - Satisfaction measure for minimum operator. C C OBJ2 - Satisfaction measure for product operator. C C RHS - Array of right hand side of constraints. C C XLB - Lower bounds of variables. C C XSOL1 - Array of solution for minimum operator. C C XSOL2 - Array of solution for product operator. C C ----------------------------------------------------------------------- LOGICAL*1 DATE(18), TIME(6) INTEGER J, K, L, NCON, NC, NVAR REAL*8 CONS(20,20), CS(20,20), MAXOBJ(20), MINOBJ(20), & OBJ1, OBJ2, OBJSLN, & RHS(20), SUMOBJ, XLB(20), XSOL1(20), XSOL2(20) C Read in and solve LPs until sentinel card. READ (5,1020) NVAR, NC, NCON 1020 FORMAT (I4, I4, I4) 3010 IF (NVAR .LE. 0) GOTO 3011 C Read in the LP. DO 6 J=1, NC READ (5,1030) (CS(J,K), K=1,NVAR) 1030 FORMAT (20F8.3) 6 CONTINUE DO 10 J=1, NCON READ (5,1030) (CONS(J,K), K=1,NVAR), RHS(J) 10 CONTINUE WRITE (6, 1060) 1060 FORMAT ('1FUZZY LINEAR PROGRAMMING', /, & ' ------------------------') CALL GDATE ( DATE, TIME ) WRITE (6, 1002) DATE, TIME 1002 FORMAT('0Timestamp: ', 18A1, ' ', 2A1, ':', 2A1, ':', 2A1) C Set up lower bounds and print original LP. DO 55 J=1, 20 XLB(J) = 0 55 CONTINUE WRITE (6, 2010) 2010 FORMAT ('-Original Linear Program', /, & ' -----------------------') CALL PRNTLP ( NVAR, NC, NCON, XLB, CS, CONS, RHS, XLB, 2 ) C Solve the LP by minimum and product methods. CALL FZZYLP ( NVAR, NC, NCON, CS, CONS, RHS, XSOL1, & OBJ1, XSOL2, OBJ2, MINOBJ, MAXOBJ ) C Make satisfaction measures positive. OBJ1 = DABS(OBJ1) OBJ2 = DABS(OBJ2) WRITE (6, 1049) 1049 FORMAT ('-RANGE OF OBJECTIVE FUNCTION VALUES',/, & ' ----------------------------------') WRITE (6, 1059) 1059 FORMAT ('0Obj Function Optimum Value Highest Value', /, & ' ------------------------------------------------') DO 28 J=1, NC WRITE (6, 1069) J, MINOBJ(J), MAXOBJ(J) 1069 FORMAT (' ', 10X, I2, 7X, F10.2, 9X, F10.2) 28 CONTINUE WRITE (6, 1022) 1022 FORMAT ('1SOLUTION BY MINIMUM OPERATOR', /, & ' ----------------------------') WRITE (6, 1000) OBJ1, (XSOL1(J), J=1,NVAR) 1000 FORMAT ('0Satisfaction Measure = ', F6.4, / & ' Solution = ', 20F10.2) WRITE (6, 1032) 1032 FORMAT ('0Objective Function Values', /, & ' -------------------------') SUMOBJ = 0 DO 20 J=1, NC OBJSLN = 0 DO 30 K=1, NVAR OBJSLN = OBJSLN + (XSOL1(K)*CS(J,K)) 30 CONTINUE SUMOBJ = SUMOBJ + OBJSLN WRITE (6, 1040) J, OBJSLN 1040 FORMAT (' Objective Function ', I2, ' = ', F10.2) 20 CONTINUE WRITE (6, 1046) SUMOBJ 1046 FORMAT (' Sum of Objective Functions = ', F11.2) WRITE (6, 1021) 1021 FORMAT ('-SOLUTION BY PRODUCT OPERATOR', /, & ' ----------------------------') WRITE (6, 1000) OBJ2, (XSOL2(J), J=1,NVAR) WRITE (6, 1030) SUMOBJ = 0 DO 21 J=1, NC OBJSLN = 0 DO 31 K=1, NVAR OBJSLN = OBJSLN + (XSOL2(K)*CS(J,K)) 31 CONTINUE SUMOBJ = SUMOBJ + OBJSLN WRITE (6, 1040) J, OBJSLN 21 CONTINUE WRITE (6, 1046) SUMOBJ READ (5, 1020) NVAR, NC, NCON GOTO 3010 3011 CONTINUE RETURN END C ============================================================ C ============================================================ C ============================================================ SUBROUTINE PRNTLP ( NVAR, NC, NCON, C, CS, CONS, RHS, XLB, TYPE ) C ----------------------------------------------------------------------- C C Author: Wm. M. Stewart C C Date: December 16, 1987 C C Name: Print-LP C C Purpose: To print a formatted multiple or single objective C function LP. C C ----------------------------------------------------------------------- C C Arguments C --------- C C NVAR - Number of variables. C C NC - Number of objective functions. C C NCON - Number of constraints. C C C - Array of a single objective function. C C CS - Matrix of objective functions. C C CONS - Matrix of constraints. C C RHS - Array of right hand side of constraints. C C XLB - Lower bounds of variables. C C TYPE - A value of 1 indicates a single objective function LP , a C value of 2 indicates a multiple objective function LP. C C----------------------------------------------------------------------- INTEGER J, K, NCON, NC, NVAR, TYPE REAL*8 CONS(20,20), C(20), CS(20,20), RHS(20), XLB(20) WRITE (6, 1020) 1020 FORMAT (' Minimize') IF (TYPE .EQ. 1) THEN WRITE (6, 1025) (C(K), K=1, NVAR) 1025 FORMAT (' ', 20F10.2) ELSE DO 11 J=1, NC WRITE (6, 1025) (CS(J,K), K=1, NVAR) 11 CONTINUE ENDIF WRITE (6, 1035) 1035 FORMAT (' Subject to Constraints') DO 10 J=1, NCON WRITE (6, 1025) (CONS(J,K), K=1,NVAR), RHS(J) 10 CONTINUE WRITE (6,1050) 1050 FORMAT (' With Lower Bounds on Variables') WRITE (6, 1025) (XLB(J), J=1,NVAR) RETURN END C ============================================================ C ============================================================ C ============================================================ SUBROUTINE FZZYLP ( NVAR, NC, NCON, CS, CONS, RHS, XSOL1, & OBJ1, XSOL2, OBJ2, MINOBJ, MAXOBJ ) C ----------------------------------------------------------------------- C C Author: Wm. M. Stewart C C Address: School of Computer Science C University of New Brunswick C Fredericton, New, Brunswick C C Date: January 4, 1988 C C Name: Fuzzy-LP-Solver C C Purpose: To solve a LP by fuzzy set methods. C The LP is solved in two ways, by using the minimum C operator and the product operator. C C Reference: Zimmermann, H. J. (1978) "Fuzzy Programming and Linear C Programming with Several Objective Functions", Fuzzy C Sets and Systems, North-Holland Publishing Company, C pp. 45-55 C C ----------------------------------------------------------------------- C C Arguments C --------- C C NVAR - Number of variables. C C NC - Number of objective functions. C C NCON - Number of constraints. C C CS - Matrix of objective functions. C C CONS - Matrix of constraints. C C RHS - Array of right hand side of constraints. C C XSOL1 - Array of solution for minimum operator. C C OBJ1 - Satisfaction measure for minimum operator. C C XSOL2 - Array of solution for product operator. C C OBJ2 - Satisfaction measure for product operator. C C MAXOBJ - Array of maximum values of each objective function over the C solutions. C C MINOBJ - Array of minimum values of each objective function over the C solutions. C C ----------------------------------------------------------------------- C C Subprograms C ----------- C C DDLPRS - IMSL Linear Programming routine (EXTERNAL). C C DNCONF - IMSL Non-Linear Programming routine (EXTERNAL). C C FUZFCN - Function to implement product operator (EXTERNAL, but C contained in this package). C C NRMLLP - Solves the MOLP for each objective function in turn. C C ----------------------------------------------------------------------- C C Note C ---- C C Many arrays (objective functions, constraints,, bounds, etc.) C are dimensioned to 20 in this package. Systems of up to 19 variables, C where the number of objective functions + constraints is <= 20, C can be solved. These arrays are not passed to FZZYLP because the C common block shared between FZZYLP and FUZFCN cannot be variable C dimensioned. Increase all dimensions of 20 for larger problems. C C ----------------------------------------------------------------------- INTEGER IBTYPE, IPRINT, IRTYPE(20), J, K, LDA, MAXITN, ME, NCON, & NC, NCONT, NVAR, NVART REAL*8 BU(20), C(20), CONS(20,20), CONST(20,20), DSOL(20), & INTRVL, MAXOBJ(20), MINOBJ(20), OBJ1, OBJ2, & CS(20,20), RHS(20), XGUESS(20), & XLB(20), XUB(20), XSOL1(20), XSOL2(20), XSCALE(20) EXTERNAL FUZFCN, DNCONF, DDLPRS C Objective functions, constraints, and sizes of LP; C for use by FUZFCN. COMMON /FCNGL1/ CS2, CONS2, RHS2 REAL*8 CS2(20,20), CONS2(20,20), RHS2(20) COMMON /FCNGL2/ NVAR2, NC2, NCON2 INTEGER NVAR2, NC2, NCON2 C Solve the LP for each objective function separately. CALL NRMLLP( NC, NVAR, NCON, CS, CONS, RHS, MINOBJ, MAXOBJ ) C Establish the upper and lower bounds, and the objective C function for the fuzzy (minimum) LP. LDA = 20 DO 100 J=1, NVAR XLB(J) = 0 XUB(J) = -1.0D30 C(J) = 0 100 CONTINUE XLB(NVAR+1) = 0 XUB(NVAR+1) = -1.0D30 C(NVAR+1) = -1 C Load the constraints constructed from the objective C functions. DO 70 J=1, NC INTRVL = ABS(MAXOBJ(J)-MINOBJ(J)) DO 120 K=1, NVAR CONST(J,K) = CS(J,K)/INTRVL 120 CONTINUE CONST(J,NVAR+1) = 1 BU(J) = MAXOBJ(J)/INTRVL IRTYPE(J) = 1 70 CONTINUE C Add the constraints from the original LP problem. DO 130 J=1, NCON DO 140 K=1, NVAR CONST(J+NC,K) = CONS(J,K) 140 CONTINUE CONST(J+NC,NVAR+1) = 0 BU(J+NC) = RHS(J) IRTYPE(J+NC) = 1 130 CONTINUE C Solve the fuzzy (minimum) problem. NVART = NVAR + 1 NCONT = NCON + NC CALL DDLPRS ( NCONT, NVART, CONST, LDA, BU, BU, C, IRTYPE, & XLB, XUB, OBJ1, XSOL1, DSOL ) C Construct and solve the fuzzy (product) problem. NVAR2 = NVAR NC2 = NC NCON2 = NCON ME = 0 IBTYPE = 0 IPRINT = 0 MAXITN = 100 C Load the fuzzy objective functions for use by FUZFCN. DO 50 J=1, NC2 INTRVL = MAXOBJ(J) - MINOBJ(J) DO 60 K=1, NVAR2 CS2(J,K) = -CS(J,K)/INTRVL 60 CONTINUE CS2(J,NVAR+1) = MAXOBJ(J)/INTRVL 50 CONTINUE C Load the constraints for use by FUZFCN. DO 80 J=1, NCON2 RHS2(J) = -RHS(J) DO 90 K=1, NVAR2 CONS2(J,K) = -CONS(J,K) 90 CONTINUE 80 CONTINUE C Set upper and lower bounds and other DNCONF values. DO 85 J=1, NVAR2 XLB(J) = 0 XUB(J) = 1.0D30 XGUESS(J) = XSOL1(J) XSCALE(J) = 1 85 CONTINUE C Solve the fuzzy (product) problem. CALL DNCONF ( FUZFCN, NCON, ME, NVAR, XGUESS, IBTYPE, XLB, XUB, & XSCALE, IPRINT, MAXITN, XSOL2, OBJ2 ) RETURN END C ============================================================ C ============================================================ C ============================================================ SUBROUTINE NRMLLP ( NVAR, NC, NCON, CS, CONS, RHS, MINOBJ, MAXOBJ ) C ----------------------------------------------------------------------- C C Author: Wm. M. Stewart C C Date: January 7, 1988 C C Name: Normal-LP C C Purpose: To solve the LP for each objective function in turn, C returning the maximum and minimum values of each C objective function over the solutions. C C ----------------------------------------------------------------------- C C Arguments C --------- C C NVAR - Number of variables. C C NC - Number of objective functions. C C NCON - Number of constraints. C C CS - Matrix of objective functions. C C CONS - Matrix of constraints. C C RHS - Array of right hand side of constraints. C C MINOBJ - Array of minimum values of each objective function over the C solutions. C C MAXOBJ - Array of maximum values of each objective function over the C solutions. C C----------------------------------------------------------------------- C C Externals C --------- C C DDLPRS - IMSL Linear Programming routine. C C----------------------------------------------------------------------- INTEGER J, K, L, IRTYPE(20), LDA, NCON, NC, NVAR REAL*8 A, BU(20), CON(20,20), CONS(20,20), & MAXOBJ(20), MINOBJ(20), OBJSLN, & C(20), CS(20,20), RHS(20), SOLVAR(20,20), & XLB(20), XUB(20), XSOL(20), DSOL(20) C Set the upper and lower bounds of the variables. LDA = 20 DO 5 J=1, LDA XLB(J) = 0 XUB(J) = -1.0D30 5 CONTINUE C Solve the LP for each objective function in turn. DO 20 J=1, NC C Load the J'th objective function. DO 30 K=1, NVAR C(K) = CS(J,K) 30 CONTINUE C Load the constraints. DO 40 K=1, NCON DO 50 L=1, NVAR CON(K,L) = CONS(K,L) 50 CONTINUE BU(K) = RHS(K) IRTYPE(K) = 1 40 CONTINUE C Solve the LP. CALL DDLPRS ( NCON, NVAR, CON, LDA, BU, BU, C, IRTYPE, & XLB, XUB, OBJSLN, XSOL, DSOL ) C Save the solution, and the objective function value. DO 60 K=1, NVAR SOLVAR(J,K) = XSOL(K) 60 CONTINUE MINOBJ(J) = OBJSLN 20 CONTINUE C Calculate the maximum value for each objective function C across the solutions. DO 70 J=1, NC MAXOBJ(J) = MINOBJ(J) DO 80 K=1, NC IF (J .NE. K) THEN SUM = 0 DO 90 L=1, NVAR SUM = SUM + (CS(J,L)*SOLVAR(K,L)) 90 CONTINUE IF (SUM .GT. MAXOBJ(J)) MAXOBJ(J) = SUM ENDIF 80 CONTINUE 70 CONTINUE RETURN END C ============================================================ C ============================================================ C ============================================================ SUBROUTINE FUZFCN ( M, ME, N, X, ACTIVE, F, G ) C ----------------------------------------------------------------------- C C Author: Wm. M. Stewart C C Date: January 9, 1988 C C Name: Fuzzy-Function C C Purpose: To calculate the product of the fuzzy objective functions C CS (in COMMON) evaluated at X. Is called by DNCONF (IMSL). C C ----------------------------------------------------------------------- C C Arguments C --------- C C Described also in IMSL documentation for NCONF/DNCONF. C C M - Number of constraints. C C ME - Number of equality constraints. C C N - Number of variables. C C X - Point at which FUZFCN is evaluated. C C ACTIVE - Array of logicals indicating active constraints. C C F - Value of FUZFCN at X. C C G - Values of ACTIVE constraints at X. C C----------------------------------------------------------------------- INTEGER M, ME, N, J, K, L REAL*8 X(*), F, G(*), TOTAL LOGICAL ACTIVE(*) C Objective functions, constraints, and sizes of LP. COMMON /FCNGL1/ CS2, CONS2, RHS2 REAL*8 CS2(20,20), CONS2(20,20), RHS2(20) COMMON /FCNGL2/ NVAR2, NC2, NCON2 INTEGER NVAR2, NC2, NCON2 C Evaluate the fuzzy (product) function, i.e. the product of C the fuzzy objective functions evaluated at X. F = -1 DO 10 J=1, NC2 TOTAL = 0 DO 20 K=1, NVAR2 TOTAL = TOTAL + X(K)*CS2(J,K) 20 CONTINUE TOTAL = TOTAL + CS2(J,N+1) F = F * TOTAL 10 CONTINUE C Evaluate each ACTIVE constraint at X. DO 30 J=1, NCON2 IF (ACTIVE(J)) THEN TOTAL = 0 DO 40 K=1, NVAR2 TOTAL = TOTAL + X(K)*CONS2(J,K) 40 CONTINUE TOTAL = TOTAL - RHS2(J) G(J) = TOTAL ENDIF 30 CONTINUE RETURN END //GO.SYSIN DD * 2 2 4 1 -2 -2 -1 -1 3 21 1 3 27 4 3 45 3 1 30 3 3 4 -800 -700 -1100 -200 -260 -190 -1 -1 -1.25 1 1 1.25 1000 1 1.25 1 1000 1 0 0 800 0 1 1 600 7 3 4 -800 -700 -1100 0 0 0 0 -200 -260 -190 0 0 0 0 -1 -1 -1.25 0 0 0 0 1 1 1.25 1 0 0 0 1000 1 1.25 1 0 1 0 1 1000 1 0 0 0 0 1 0 800 0 1 1 0 0 0 1 600 -1 -1 -1