1  REM ****  HP BASIC PROGRAM LIBRARY  ******************************
2  REM
3  REM       GLPSA1: LINEAR PROGRAMMING - TWO PHASE SIMPLEX METHOD
4  REM
5  REM       36517 REV A
6  REM
7  REM ****  CONTRIBUTED PROGRAM  ***********************************
8  REM LPSA1 - LP PROGRAM WHICH PERMITS SENSITIVITY AND PARAMETRIC
9  REM  ANALYSES.  SEE SEPARATE WRITEUP FOR INSTRUCTIONS
10  REM J. MOORE, SEPT., 1969
15  P4=0
100  DIM A[30,70],B[30],D[40],F[30],A$[8],B$[8]
102  PRINT 
104  PRINT 
110  PRINT "TYPE: '1' FOR MAXIMIZATION, OR '-1' FOR MINIMIZATION.  ";
120  INPUT Z
130  Z=-Z
140  PRINT "TYPE: THE NUMBER OF CONSTRAINTS, NUMBER OF VARIABLES.  ";
150  INPUT M,N
160  PRINT "TYPE: NUMBER OF LESS THAN,EQUAL,GREATER THAN CONSTRAINTS.  ";
170  INPUT L,E,G
180  IF M=L+E+G THEN 210
190  PRINT "DATA ON CONSTRAINTS INCONSISTENT. TRY AGAIN."
200  GOTO 140
205  REM THIS IS INITIALIZATION ROUTINE
210  C=N+M+G
220  C1=C+1
225  C2=N+L+G
230  M1=M+1
240  M2=M+2
241  RESTORE 
245  PRINT 
250  MAT A=ZER[M2,C1]
255  MAT B=ZER[M]
260  FOR I=1 TO M
270  FOR J=1 TO N
280  READ A[I,J]
290  IF I <= L THEN 310
300  A[M1,J]=A[M1,J]-A[I,J]
310  NEXT J
320  IF I>L THEN 360
330  B[I]=N+I
340  A[I,N+I]=1
350  GOTO 420
360  B[I]=N+G+I
370  A[I,N+G+I]=1
380  IF I>L+E THEN 400
390  GOTO 420
400  A[I,N+I-E]=-1
410  A[M1,N+I-E]=1
420  NEXT I
430  FOR I=1 TO M
440  READ A[I,C1]
450  NEXT I
460  FOR J=1 TO N
470  READ A[M2,J]
480  A[M2,J]=Z*A[M2,J]
490  NEXT J
500  PRINT 
510  P1=1
520  PRINT "YOUR VARIABLES"P1"THROUGH"N
530  IF L=0 THEN 550
540  PRINT "SLACK VARIABLES"N+1"THROUGH"N+L
550  IF G=0 THEN 570
560  PRINT "SURPLUS VARIABLES"N+L+1" THROUGH"C2
570  IF L=M THEN 670
580  PRINT "ARTIFICIAL VARIABLES"C2+1"THROUGH"C
585  M3=M1
590  GOSUB 1000
600  PRINT 
610  FOR I1=1 TO M
620  IF B[I1] <= C2 THEN 662
630  IF A[I1,C1] <= .00001 THEN 655
640  PRINT "THE PROBLEM HAS NO FEASIBLE SOLUTION."
650  STOP 
655  FOR J1=1 TO C2
656  IF ABS(A[I1,J1]) <= .00001 THEN 661
657  R=I1
658  S=J1
659  GOSUB 1180
660  GOTO 662
661  NEXT J1
662  NEXT I1
670  P1=2
680  PRINT 
685  M3=M2
690  GOSUB 1000
691  GOSUB 700
692  IF P4=3 THEN 698
693  GOSUB 2000
694  PRINT 
695  GOSUB 3000
696  PRINT 
697  PRINT 
698  GOSUB 4000
699  STOP 
700  PRINT 
710  PRINT "ANSWERS:"
720  PRINT "PRIMAL VARIABLES:"
730  PRINT "VARIABLE","VALUE"
740  FOR J=1 TO C2
750  FOR I=1 TO M
760  IF B[I] <> J THEN 790
770  PRINT J,A[I,C1]
780  GOTO 800
790  NEXT I
800  NEXT J
810  PRINT "DUAL VARIABLES:"
820  PRINT "VARIABLE","VALUE"
825  IF L=0 THEN 860
830  FOR I=1 TO L
840  PRINT I,-Z*A[M2,N+I]
850  NEXT I
860  FOR I=L+1 TO M
870  PRINT I,-Z*A[M2,N+I+G]
880  NEXT I
890  PRINT "VALUE OF OBJECTIVE FUNCTION  ";-Z*A[M2,C1]
900  PRINT 
905  PRINT 
910  RETURN 
1000  REM THIS IS OPTIMIZING ROUTINE
1005  REM FIRST PRICE OUT THE COLUMNS
1010  P=-.00001
1020  FOR J=1 TO C2
1030  IF A[M3,J] >= P THEN 1060
1040  S=J
1050  P=A[M3,J]
1060  NEXT J
1070  IF P=-.00001 THEN 1370
1072  GOSUB 1075
1074  GOTO 1150
1075  REM NOW WE FIND WHICH VARIABLE LEAVES BASIS
1080  Q=1.E+38
1090  FOR I=1 TO M
1100  IF A[I,S] <= .00001 THEN 1140
1110  IF A[I,C1]/A[I,S] >= Q THEN 1140
1120  R=I
1130  Q=A[I,C1]/A[I,S]
1140  NEXT I
1145  RETURN 
1150  IF Q=1.E+38 THEN 1160
1152  GOSUB 1180
1154  GOTO 1010
1160  PRINT "THE SOLUTION IS UNBOUNDED."
1170  STOP 
1180  REM NOW PERFORM THE PIVOTING
1185  P=A[R,S]
1190  FOR I=1 TO M2
1200  IF I=R THEN 1270
1210  FOR J=1 TO C1
1220  IF J=S THEN 1260
1230  A[I,J]=A[I,J]-A[I,S]*A[R,J]/P
1240  IF ABS(A[I,J]) >= .00001 THEN 1260
1250  A[I,J]=0
1260  NEXT J
1270  NEXT I
1280  FOR J=1 TO C1
1290  A[R,J]=A[R,J]/P
1300  NEXT J
1310  FOR I=1 TO M2
1320  A[I,S]=0
1330  NEXT I
1340  A[R,S]=1
1350  B[R]=S
1360  RETURN 
1370  RETURN 
1380  STOP 
2000  REM SUBROUTINE FOR SENSITIVITY ANALYSIS ON RHS
2005  PRINT "YOU CAN NOW DO SENSITIVITY ANALYSIS ON THE RIGHT HAND SIDE."
2010  PRINT 
2012  PRINT 
2015  PRINT "HOW MANY CAPACITIES DO YOU WISH TO CHANGE";
2020  INPUT R
2025  IF R=0 THEN 2400
2030  PRINT "WHICH CAPACITIES DO YOU WISH TO CHANGE";
2035  MAT  INPUT D[R]
2040  FOR I=1 TO R
2060  IF D[I] <= M THEN 2090
2070  PRINT "CONSTRAINT "D[I]" DOES NOT EXIST.TRY AGAIN."
2080  GOTO 2010
2090  NEXT I
2100  R1=-1.E+38
2110  R2=1.E+38
2130  FOR I=1 TO M
2140  D1=0
2150  FOR J=1 TO R
2160  IF D[J]>L THEN 2190
2170  D1=D1+A[I,D[J]+N]
2180  GOTO 2200
2190  D1=D1+A[I,D[J]+G+N]
2200  NEXT J
2205  IF ABS(D1) <= .00001 THEN 2300
2210  IF D1>0 THEN 2270
2220  D1=-A[I,C1]/D1
2230  IF D1 >= R2 THEN 2300
2240  R2=D1
2250  S2=B[I]
2260  GOTO 2300
2270  D1=-A[I,C1]/D1
2280  IF D1 <= R1 THEN 2300
2290  R1=D1
2295  S1=B[I]
2300  NEXT I
2310  IF R1=-1.E+38 THEN 2340
2320  PRINT "THE BOUND ON THE DECREASE IS "-R1;
2325  PRINT "  AT WHICH POINT VARIABLE "S1"  GOES TO ZERO."
2330  GOTO 2350
2340  PRINT "THERE IS NO BOUND ON THE DECREASE."
2350  IF R2=1.E+38 THEN 2380
2360  PRINT "THE BOUND ON THE INCREASE IS "R2;
2365  PRINT "  AT WHICH POINT VARIABLE "S2"  GOES TO ZERO."
2370  GOTO 2010
2380  PRINT "THERE IS NO BOUND ON THE INCREASE."
2390  GOTO 2010
2400  RETURN 
2410  STOP 
3000  REM SUBROUTINE FOR SENSITIVITY ANALYSIS ON OBJ FCN COEFFICIENTS
3005  PRINT "YOU MAY NOW DO SENSITIVITY ANALYSIS ON THE COST FACTORS."
3010  PRINT 
3015  PRINT 
3020  PRINT "HOW MANY COSTS DO YOU WISH TO CHANGE";
3030  INPUT R
3035  IF R=0 THEN 3500
3040  PRINT "WHICH COSTS DO YOU WISH TO CHANGE";
3045  MAT  INPUT D[R]
3050  FOR J=1 TO R
3070  IF D[J] <= N THEN 3100
3080  PRINT "VARIABLE "D[J]"  IS NOT ONE OF YOUR VARIABLES. TRY AGAIN."
3090  GOTO 3010
3100  NEXT J
3110  R1=-1.E+38
3120  R2=1.E+38
3130  FOR J=1 TO C2
3140  FOR I=1 TO M
3150  IF B[I]=J THEN 3360
3160  NEXT I
3170  D1=0
3180  FOR I=1 TO R
3190  IF D[I] <> J THEN 3210
3200  D1=D1-1
3210  NEXT I
3220  FOR I=1 TO R
3230  FOR K=1 TO M
3240  IF B[K] <> D[I] THEN 3270
3250  D1=D1+A[K,J]
3260  GOTO 3280
3270  NEXT K
3280  NEXT I
3285  IF D1=0 THEN 3360
3300  IF D1*R1 <= A[M2,J] THEN 3330
3310  R1=A[M2,J]/D1
3320  S1=J
3330  IF D1*R2 <= A[M2,J] THEN 3360
3340  R2=A[M2,J]/D1
3350  S2=J
3360  NEXT J
3362  IF Z=1 THEN 3368
3364  A$="INCREASE"
3365  B$="DECREASE"
3366  GOTO 3370
3368  A$="DECREASE"
3369  B$="INCREASE"
3370  IF R1=-1.E+38 THEN 3420
3380  PRINT "THE BOUND ON THE "A$" IS "-R1" ."
3395  S=S1
3397  PRINT " AT THIS POINT VARIABLE "S"CAN ENTER THE BASIS.";
3400  GOSUB 1075
3405  GOSUB 3600
3410  GOTO 3430
3420  PRINT "THE "A$" IS NOT BOUDNED."
3430  IF R2=1.E+38 THEN 3480
3440  PRINT "THE BOUND ON THE "B$" IS "R2" ."
3455  S=S2
3456  PRINT " AT THIS POINT VARIABLE "S"CAN ENTER THE BASIS.";
3460  GOSUB 1075
3465  GOSUB 3600
3470  GOTO 3490
3480  PRINT "THE "B$" IS NOT BOUNDED."
3490  GOTO 3010
3500  RETURN 
3510  STOP 
3600  IF Q=1.E+38 THEN 3630
3610  PRINT "VARIABLE "B[R]"  WILL LEAVE THE BASIS."
3620  GOTO 3640
3630  PRINT "VARIABLE"S"IS UNBLOCKED.THE PROBLEM IS UNBOUNDED."
3640  RETURN 
3650  STOP 
4000  REM SUBROUTINE FOR SENSITIVITY ANALYSIS ON RHS
4010  PRINT "YOU CAN NOW DO PARAMETRIC ANALYSIS ON THE RIGHT HAND SIDE."
4020  PRINT 
4030  PRINT 
4040  PRINT "HOW MANY CAPACITIES DO YOU WISH TO CHANGE";
4050  INPUT T
4060  IF T=0 THEN 4720
4070  PRINT "WHICH CAPACITIES DO YOU WISH TO CHANGE";
4075  MAT  INPUT D[T]
4080  FOR I=1 TO T
4100  IF ABS(D[I]) <= M THEN 4130
4110  PRINT "CONSTRAINT "ABS(D[I])" DOES NOT EXIST.TRY AGAIN."
4120  GOTO 4020
4130  NEXT I
4140  R1=1.E+38
4150  FOR I=1 TO M2
4160  F[I]=0
4170  FOR J=1 TO T
4180  E=ABS(D[J])/D[J]
4190  IF E*D[J]>L THEN 4220
4200  F[I]=F[I]+E*A[I,E*D[J]+N]
4210  GOTO 4230
4220  F[I]=F[I]+E*A[I,E*D[J]+G+N]
4230  NEXT J
4235  IF I>M THEN 4290
4240  IF F[I] >= -.00001 THEN 4290
4250  D1=-A[I,C1]/F[I]
4260  IF D1 >= R1 THEN 4290
4270  R1=D1
4280  R=I
4290  NEXT I
4300  IF R1<1.E+38 THEN 4330
4310  PRINT "THERE IS NO FURTHER BOUND ON THE CHANGE."
4320  GOTO 4560
4330  PRINT "THE NEXT BOUND ON THE CHANGE IS "R1". VARIABLE "B[R];
4340  PRINT " WILL GO TO ZERO.";
4350  FOR I=1 TO M2
4360  A[I,C1]=A[I,C1]+F[I]*R1
4370  NEXT I
4375  A[R,C1]=0
4380  R1=-1.E+38
4390  FOR J=1 TO C2
4400  FOR I=1 TO M
4410  IF B[I]=J THEN 4470
4420  NEXT I
4430  IF A[R,J] >= -.00001 THEN 4470
4440  IF A[M3,J]/A[R,J] <= R1 THEN 4470
4450  R1=A[M3,J]/A[R,J]
4460  S=J
4470  NEXT J
4480  IF R1>-1.E+38 THEN 4510
4490  PRINT "BEYOND THIS POINT THE PROBLEM IS NOT FEASIBLE."
4500  GOTO 4560
4510  PRINT "VARIABLE "S" WILL ENTER THE BASIS."
4520  GOSUB 1180
4530  PRINT "THE NEW OPTIMAL SOLUTION IS:"
4540  GOSUB 700
4550  GOTO 4140
4560  PRINT 
4570  PRINT "TYPE: A '1' TO REVERSE THE PREVIOUS PARAMETRIC ANALYSIS,";
4580  PRINT "A'2' TO START ANOTHER PARAMETRIC ANALYSIS AT THIS POINT,"
4590  PRINT "     OR A '3' TO DO ANOTHER PARAMETRIC ANALYSIS ON THE ";
4600  PRINT "ORIGINAL CAPACITIES. TYPE A '0' TO QUIT."
4610  INPUT P4
4620  IF P4=0 THEN 4720
4630  IF P4=2 THEN 4020
4640  IF P4=3 THEN 241
4650  IF P4=1 THEN 4680
4660  PRINT P4" IS NOT A LEGAL CODE. TRY AGAIN."
4670  GOTO 4560
4680  FOR I=1 TO T
4690  D[I]=-D[I]
4700  NEXT I
4710  GOTO 4140
4720  RETURN 
4730  STOP 
9999  END 
