1 REM TRANS  
5 CLEAR  1000  
10 CLS:PRINT  TAB(20);"TRANSPORTATION PROBLEM":PRINT   
20 PRINT "THE TRANSPORTATION PROBLEM EXAMINED HERE IS THE FOLLOWING:  
25 PRINT "   THERE ARE N SOURCES OF SUPPLY AND M DESTINATIONS FOR A  
30 PRINT "GOOD. EACH OF THE SUPPLY SOURCES CAN SUPPLY A GIVEN AMOUNT OF  
35 PRINT"THE GOOD AND EACH DESTINATION HAS A CERTAIN REQUIREMENT. WE  
40 PRINT "REQUIRE THAT THE TOTAL OF POSSIBLE SUPPLY EQUALS THE TOTAL  
45 PRINT "REQUIRED.TO DELIVER A UNIT OF THE ITEM FROM A GIVEN SOURCE TO  
50 PRINT "A GIVEN DESTINATION HAS A KNOWN COST,DEPENDING UPON THE SOURCE-  
55 PRINT "DESTINATION COMBINATION. THE PROBLEM ATTEMPTS TO DETERMINE  
60 PRINT "WHICH SHIPPING ASSIGNMENT MINIMIZES SHIPPING COST.  
90 PRINT :INPUT "PRESS ENTER TO CONTINUE";Z9$  
95 CLEAR  1000  
100 I=10:J=10:REM I=MXX SOURCES,J=MXXIMUM DESTINATIONS  
105 MXX=I:IF  J>MXX  THEN  J=MXX  
110 DIM  A(MXX),B(MXX),CC(MXX,MXX),X(MXX,MXX),N(MXX),U(MXX)  
115 DIM  HS(MXX,MXX)  
120 DIM  G(MXX),V(MXX),T(MXX),R(MXX),S(50),L(200)  
125 FOR  I=1 TO MXX:V(I)=1:NEXT   
130 CLS  
140 INPUT "ENTER NUMBER OF SOURCES     ";M  
150 INPUT "ENTER NUMBER OF DESTINATIONS";N  
160 PRINT   
170 FOR  I=1  TO  M  
180 PRINT "SOURCE";I  
190 FOR  J=1 TO N  
200 PRINT "    UNIT COST TO DESTINATION ";J;:INPUT  CC(I,J)  
205 HS(I,J)=CC(I,J):REM HOLD UNTIL END  
210 NEXT  J  
220 PRINT "CAPACITY OF SOURCE";I;:INPUT  A(I)  
225 A8=A8+A(I)  
230 NEXT  I  
240 PRINT   
250 FOR  I=1  TO  N  
260 PRINT "REQUIREMENTS OF DESTINATION";I;:INPUT  B(I)  
265 B8=B8+B(I)  
270 NEXT   
280 IF  A8<>B8  THEN  PRINT "TOTAL SUPPLY MUST EQUAL TOTAL DEMAND IN THIS PROGRAM":GOSUB  10100:GOTO  95  
300 CLS:INPUT "IS PRINTER COPY OF INPUT DESIRED(Y/N)";Z2$  
310 IF  Z2$<>"Y"  AND  Z2$<>"N"  THEN  GOSUB  10000:GOTO  300  
320 IF  Z2$="N"  THEN  GOTO  700  
330 REM PRINTER INPUT ROUTINE  
340 INPUT "PRESS ENTER WHEN PRINTER READY";Z9$  
350 LPRINT "NUMBER OF SOURCES =      ";M  
360 LPRINT "NUMBER OF DESTINATIONS =";N  
370 LPRINT " "  
380 FOR  I=1  TO  M  
390 LPRINT "SOURCE";I  
400 FOR  J=1 TO N  
410 LPRINT "    UNIT COST TO DESTINATION ";J;"EQUALS ";CC(I,J)  
420 NEXT  J  
430 LPRINT "CAPACITY OF SOURCE";I;"EQUALS ";A(I)  
440 NEXT  I  
450 LPRINT " "  
460 FOR  I=1  TO  N  
470 LPRINT "REQUIREMENTS OF DESTINATION";I;"EQUALS ";B(I)  
480 NEXT   
700 CLS:PRINT :PRINT :PRINT :PRINT  TAB(20);"COMPUTING"  
1000 FOR  I=1 TO M:N(I)=(I-1)*N:NEXT   
1005 C=0:G=0  
1010 FOR  I=1 TO M  
1015 H=99999  
1020 FOR  J=1 TO N  
1025 IF  CC(I,J)>=H  THEN  GOTO  1035  
1030 H=CC(I,J)  
1035 NEXT  J  
1040 FOR  J=1 TO N  
1045 CC(I,J)=CC(I,J)-H:C1=CC(I,J)  
1050 IF  C1<>0  THEN  GOTO  1070  
1055 V(J)=0  
1060 N(I)=N(I)+1:N1=N(I)  
1065 L(N1)=J  
1070 NEXT  J  
1075 C=H*A(I)+C  
1080 NEXT  I  
1085 FOR  J=1 TO N  
1090 IF  V(J)=0  THEN  GOTO  1155  
1095 H=99999  
1100 FOR  I=1 TO M  
1105 IF  CC(I,J)>=H  THEN  GOTO  1115  
1110 H=CC(I,J)  
1115 NEXT  I  
1120 FOR  I=1  TO  M  
1125 CC(I,J)=CC(I,J)-H:C1=CC(I,J)  
1130 IF  C1<>0  THEN  GOTO  1145  
1135 N(I)=N(I)+1:N1=N(I)  
1140 L(N1)=J  
1145 NEXT  I  
1150 C=H*B(J)+C  
1155 NEXT  J  
1160 FOR  I=1  TO  M  
1165 A1=A(I):N1=N(I)  
1170 FOR  U= (I-1)*N+1  TO  N1  
1175 IF  A1=0  THEN  GOTO  1220  
1180 J=L(U):B1=B(J)  
1185 IF  B1=0  THEN  GOTO  1215  
1190 H=A1  
1195 IF  A1<B1  THEN  GOTO  1205  
1200 H=B1  
1205 X(I,J)=H:A1=A1-H:B(J)=B1-H  
1210 GOSUB  1705  
1215 NEXT  U  
1220 A(I)=A1:G=G+A1  
1225 NEXT  I  
1230 IF  G=0  THEN  GOTO  3000  
1235 REM  
1240 FOR  I=1 TO MXX:R(I)=0:NEXT   
1245 K=0  
1250 FOR  I=1 TO M  
1255 IF  A(I)=0  THEN  GOTO  1270  
1260 K=K+1:U(K)=I:G(I)=99999  
1265 GOTO  1275  
1270 G(I)=0  
1275 NEXT  I  
1280 L=0  
1285 FOR  U=1 TO K  
1290 I=U(U):N1=N(I)  
1295 FOR  S=(I-1)*N+1  TO  N1  
1300 J=L(S)  
1305 IF  R(J)<>0  THEN  GOTO  1320  
1310 R(J)=I:L=L+1:V(L)=J  
1315 IF  B(J)>0  THEN  GOTO  1390  
1320 NEXT  S  
1325 NEXT  U  
1330 IF  L=0  THEN  GOTO  1490  
1335 K=0  
1340 FOR  V=1  TO  L  
1345 J=V(V):L1=T(J)  
1350 FOR  S=T(J-1)+1  TO  L1  
1355 I=S(S)  
1360 IF  G(I)<>0  THEN  GOTO  1370  
1365 G(I)=J:K=K+1:U(K)=I  
1370 NEXT  S  
1375 NEXT  V  
1380 IF  K=0  THEN  GOTO  1490  
1385 GOTO  1280  
1390 H=B(J):P=J  
1395 I=R(J):J=G(I)  
1400 IF  J<>99999  THEN  GOTO  1420  
1405 IF  A(I)>=H  THEN  1435  
1410 H=A(I)  
1415 GOTO  1435  
1420 IF  X(I,J)>=H  THEN  GOTO  1395  
1425 H=X(I,J)  
1430 GOTO  1395  
1435 J=P:B(J)=B(J)-H:A(I)=A(I)-H:G=G-H  
1440 REM  
1445 I=R(J):X1=X(I,J):X(I,J)=X1+H  
1450 IF  X1<>0  THEN  GOTO  1460  
1455 GOSUB  1705  
1460 J=G(I)  
1465 IF  J=99999  THEN  GOTO  1230  
1470 X(I,J) =X(I,J)-H:X1=X(I,J)  
1475 IF  X1<>0  THEN  GOTO  1440  
1480 GOSUB  1735  
1485 GOTO  1440  
1490 K=0:L=N+1  
1495 FOR  J=1 TO N  
1500 IF  R(J)<>0  THEN  GOTO  1515  
1505 K=K+1:V(K)=J  
1510 GOTO  1520  
1515 L=L-1:V(L)=J  
1520 NEXT  J  
1525 H=99999  
1530 FOR  I=1  TO  M  
1535 IF  G(I)=0  THEN  GOTO  1565  
1540 FOR  S=1 TO K  
1545 J=V(S)  
1550 IF  CC(I,J)>=H  THEN  GOTO  1560  
1555 H=CC(I,J)  
1560 NEXT  S  
1565 NEXT  I  
1570 FOR  I=1 TO M  
1575 F=0  
1580 IF  G(I)=0  THEN  GOTO  1590  
1585 F=1  
1590 N1=(I-1)*N  
1595 FOR  S=L  TO  N  
1600 J=V(S)  
1605 IF  F=0  THEN  GOTO  1620  
1610 C1=CC(I,J)  
1615 GOTO  1625  
1620 CC(I,J)=CC(I,J)+H:C1=CC(I,J)  
1625 IF  C1<>0  THEN  GOTO  1635  
1630 N1=N1+1:L(N1)=J  
1635 NEXT  S  
1640 FOR  S=1  TO  K  
1645 J=V(S)  
1650 IF  F=0  THEN  GOTO  1665  
1655 CC(I,J)=CC(I,J)-H:C1=CC(I,J)  
1660 GOTO  1670  
1665 C1=CC(I,J)  
1670 IF  C1<>0  THEN  GOTO  1680  
1675 N1=N1+1:L(N1)=J  
1680 NEXT  S  
1685 N(I)=N1  
1690 NEXT  I  
1695 C=H*G+C  
1700 GOTO  1235  
1705 REM  
1710 L1=T(J)  
1715 FOR  T=T(N)  TO  L1  STEP  -1:S(T+1)=S(T):NEXT   
1720 FOR  T=J TO N:T(T)=T(T)+1:NEXT   
1725 S(L1+1)=I  
1730 RETURN   
1735 REM  
1740 L1=T(J)  
1745 FOR  T=T(J-1)+1  TO  L1  
1750 IF  S(T)<>I  THEN  GOTO  1765  
1755 S=T  
1760 GOTO  1770  
1765 NEXT  T  
1770 FOR  T=J TO N:T(T)=T(T)-1:NEXT   
1775 L1=T(N)  
1780 FOR  T=S  TO  L1:S(T)=S(T+1):NEXT   
1785 RETURN   
3000 CLS:INPUT "IS PRINTER OUTPUT DESIRED(Y/N)";Z2$  
3005 IF  Z2$<>"Y"  AND  Z2$<>"N"  THEN  GOSUB  10000:GOTO  3000  
3010 CLS:PRINT "SHIPPING ASSIGNMENTS"  
3015 F$(1)=" FROM SOURCE ## TO DESTINATION ##  : #####.#   COST= ######.##"  
3020 FOR  I=1 TO  M:FOR  J=1  TO  N  
3025 IF  X(I,J)<>0  THEN  PRINT USING  F$(1);I,J,X(I,J),X(I,J)*HS(I,J)  
3030 NEXT  J:NEXT  I  
3035 PRINT "                       TOTAL COST            = ";C  
3040 IF  Z2$="N"  THEN  GOTO  3080  
3045 PRINT :INPUT "PRESS ENTER WHEN PRINTER READY";Z9$  
3050 LPRINT "SHIPPING ASSIGNMENTS"  
3055 FOR  I=1 TO  M:FOR  J=1  TO  N  
3060 IF  X(I,J)<>0  THEN  LPRINT  USING  F$(1);I,J,X(I,J),X(I,J)*HS(I,J)  
3065 NEXT  J:NEXT  I  
3070 LPRINT " "  
3075 LPRINT "                       TOTAL COST            = ";C  
3080 PRINT :INPUT "PRESS ENTER FOR MORE COMPUTATION";Z9$  
3082 IF Z9$ = "-1" THEN END
3085 GOTO  95  
10000 PRINT "INPUT ERROR! TRY AGAIN!":FOR JJ=1 TO 300:NEXT :RETURN   
10100 INPUT "PRESS ENTER TO CONTINUE";Z9$:RETURN   

