1  REM ***  HP BASIC PROGRAM LIBRARY ********************************
2  REM
3  REM      TRANSP:  TRANSPORTATION PROBLEM
4  REM
5  REM      36230  REV A
6  REM
7  REM ***  CONTRIBUTED PROGRAM *************************************
8  REM
9  REM
10  REM ***A PRIMAL-DUAL ALGORITHM FOR THE TRANSPORTATION PROBLEM***
11  REM       INITIALIZATION AND DATA INPUT
12  DIM B[20],C[20,20],K[20],L[20],P[20,20],R[20],S[20]
13  DIM U[20],V[20],X[20],Y[20],Z[20,20]
15  PRINT "        THE TRANSPORTATION PROBLEM"
16  PRINT 
20  READ M,N
30  MAT  READ X[M],Y[N],C[M,N]
31  LET A3=A4=0
32  FOR I=1 TO M
33  LET A3=A3+X[I]
34  NEXT I
35  FOR J=1 TO N
36  LET A4=A4+Y[J]
37  NEXT J
38  IF A3 <> A4 THEN 1320
40  MAT B=ZER
50  MAT P=ZER[M,N]
60  MAT U=ZER[M]
70  MAT V=ZER[N]
80  MAT Z=ZER[M,N]
82  PRINT "TYPE:  +1 FOR COST MINIMIZATION"
84  PRINT "  OR   -1 FOR PROFIT MAXIMIZATION.  WHICH";
86  INPUT A3
88  IF ABS(A3) <> 1 THEN 82
89  MAT C=(A3)*C
99  REM     STEP 2A
100  FOR I=1 TO M
105  LET T=1.E+30
110  FOR J=1 TO N
120  LET T=(T MIN C[I,J])
130  NEXT J
140  U[I]=-T
150  FOR J=1 TO N
160  IF C[I,J]>T THEN 180
170  LET Z[I,J]=.5
180  NEXT J
190  NEXT I
199  REM     STEPS 2B & 2C
200  FOR J=1 TO N
210  LET T=1.E+30
220  FOR I=1 TO M
230  IF Z[I,J]>0 THEN 320
240  LET B[I]=C[I,J]+U[I]
250  LET T=(T MIN B[I])
260  NEXT I
270  LET V[J]=-T
280  FOR I=1 TO M
290  IF B[I]>T THEN 310
300  LET Z[I,J]=.5
310  NEXT I
320  NEXT J
349  REM     STEP 3... DETERMINATION OF INITIAL ALLOCATIONS
350  FOR I=1 TO M
360  FOR J=1 TO N
370  IF Z[I,J]=0 THEN 420
380  LET T=(X[I] MIN Y[J])
390  LET Z[I,J]=Z[I,J]+T
400  LET X[I]=X[I]-T
410  LET Y[J]=Y[J]-T
420  NEXT J
430  NEXT I
435  FOR J=1 TO N
440  IF Y[J] <> 0 THEN 449
445  NEXT J
446  GOTO 925
449  REM STEP 4A ..... LABELLING SURPLUS ROWS
460  MAT R=ZER[M]
470  MAT S=ZER[M]
480  MAT K=ZER[N]
490  MAT L=ZER[N]
500  FOR I=1 TO M
510  IF X[I]=0 THEN 540
520  LET R[I]=X[I]
530  LET S[I]=0
540  NEXT I
549  REM     STEP 4B... LABELLING COLUMNS IN LABELED ROWS
550  FOR I=1 TO M
560  IF R[I]=0 THEN 640
570  FOR J=1 TO N
580  IF Z[I,J]=0 THEN 630
590  IF K[J] <> 0 THEN 630
600  LET K[J]=R[I]
610  LET L[J]=I
619  REM      THIS IS THE BREAKTHROUGH TEST POINT
620  IF Y[J] <> 0 THEN 799
630  NEXT J
640  NEXT I
649  REM     STEP 4C... LABELLING ROWS FROM LABELLED COLUMNS
650  LET N1=0
660  FOR J=1 TO N
670  IF K[J]=0 THEN 750
680  FOR I=1 TO M
690  IF R[I] <> 0 THEN 740
700  IF Z[I,J] <= .5 THEN 740
710  LET R[I]=(K[J] MIN (Z[I,J]-.5))
720  LET S[I]=J
730  LET N1=1
740  NEXT I
750  NEXT J
760  IF N1=1 THEN 549
769  REM      THIS IS THE NON-BREAKTHROUGH TEST POINT
770  GOTO 999
799  REM     STEP 5... BREAKTHROUGH
800  LET F=(Y[J] MIN K[J])
801  REM F = FLOW
802  REM Z(A1,A2) = BOX OF INTEREST (FLOW-IN OR -OUT)
810  LET A2=J
820  LET Y[J]=Y[J]-F
830  LET A1=L[A2]
840  LET Z[A1,A2]=Z[A1,A2]+F
850  IF S[A1]=0 THEN 890
860  LET A2=S[A1]
870  LET Z[A1,A2]=Z[A1,A2]-F
880  GOTO 830
890  LET X[A1]=X[A1]-F
900  FOR J=1 TO N
910  IF Y[J] <> 0 THEN 449
920  NEXT J
925  PRINT 
930  PRINT "OPTIMAL SOLUTION"
932  PRINT 
934  LET Q=0
935  FOR I=1 TO M
940  FOR J=1 TO N
945  LET Z[I,J]=INT(Z[I,J])
946  LET Q=Q+Z[I,J]*C[I,J]
950  NEXT J
955  NEXT I
960  MAT  PRINT Z;
962  PRINT 
963  PRINT "     OBJECTIVE FUNCTION = "Q*A3
965  GOTO 9999
999  REM     STEP 6 ... NON-BREAKTHROUGH
1000  MAT P=CON[M,N]
1010  MAT P=(99999.)*P
1020  LET Q=99999.
1030  FOR I=1 TO M
1040  IF R[I]=0 THEN 1100
1050  FOR J=1 TO N
1060  IF K[J] <> 0 THEN 1090
1070  LET P[I,J]=C[I,J]+U[I]+V[J]
1080  LET Q=(Q MIN P[I,J])
1090  NEXT J
1100  NEXT I
1110  FOR I=1 TO M
1120  FOR J=1 TO N
1130  IF P[I,J]>Q THEN 1150
1140  Z[I,J]=.5
1150  NEXT J
1160  NEXT I
1169  REM     STEP 6B
1170  FOR J=1 TO N
1180  IF K[J]=0 THEN 1240
1190  LET V[J]=V[J]+Q
1200  FOR I=1 TO M
1210  IF R[I]>0 THEN 1230
1220  LET Z[I,J]=0
1230  NEXT I
1240  NEXT J
1250  FOR I=1 TO M
1260  IF R[I]=0 THEN 1280
1270  U[I]=U[I]-Q
1280  NEXT I
1290  GOTO 449
1299  REM      ERROR HANDLING SECTION
1320  PRINT "YOUR SOURCES DO NOT EQUAL YOUR DESTINATIONS."
1330  PRINT "CHECK YOUR DATA FOR ERRORS, CORRECT THEM, AND 'RUN' AGAIN."
1340  GOTO 9999
9000  DATA 3,3,1,2,3,3,2,1
9001  DATA 1,2,3,6,4,2,1,4,7
9999  END 
