'************************************************************* '* THE TRANSPORT MODEL * '* -------------------- * '* * '* LIST OF MAIN VARIABLES: * '* * '* ISOU : NUMBER OF SOURCES * '* IDES : NUMBER OF DESTINATIONS * '* XM(ISOU,IDES) : RESOURCES DISTRIBUTION * '* C(ISOU,IDES) : UNITARY TRANSPORT COSTS * '* R(ISOU,IDES) : PATH SEARCH * '* P(4,ISOU+IDES): TABLE OF FOUND PATHS * '* DAO(ISOU) : AVAILABLE SOURCE QUANTITIES * '* RAD(IDES) : REQUIRED DESTINATION QUANTITIES * '* IX, IY : AUXILIARY VARIABLES AT TRANSPORT PATH * '* CC : PATH COST * '* XINFCC : MINIMUM OF PATH COSTS * '* NR : NUMBER OF KNOWN MARKS * '* IF1 : FLAG FOR MARKS STILL TO ELIMINATE * '* ID : DISPLACEMENT LENGTH * '* TT : TRANSPORT TOTAL QUANTITY * '* LT : TOTAL PATH LENGTH * '* CT : TOTAL TRANSPORT COST * '* IOPTIMAL : FLAG=1, IF OPTIMALITY IS FOUND * '* QT : TRANSPORT QUANTUTY FOR ONE PATH * '* --------------------------------------------------------- * '* PROBLEM DESCRIPTION * '* A papermaker owns three factories respectively producing * '* monthly 5000, 10000 and 6000 tons. He has to deliver the * '* following quantities respectively to four customers in * '* different cities: 2000 T (Paris), 11000 T (Lyon), 4000 T * '* (Marseille) and 4000 T (Grenoble) at the lowest total * '* transportation cost. The transport costs grid is the * '* following: * '* PARIS LYON MARSEILLE GRENOBLE * '* FACTORY 1 200 700 800 very high * '* FACTORY 2 400 400 500 500 * '* FACTORY 3 400 500 600 600 * '* --------------------------------------------------------- * '* SAMPLE RUN: * '* * '* TRANSPORT MODEL * '* * '* NUMBER OF SOURCES ? 3 * '* * '* NUMBER OF DESTINATIONS ? 4 * '* * '* INPUT THE AVAILABLE SOURCE QUANTITIES: * '* SOURCE #1 ? 5000 * '* SOURCE #2 ? 10000 * '* SOURCE #3 ? 6000 * '* * '* INPUT THE REQUIRED DESTINATION QUANTITIES: * '* DESTINATION #1 ? 2000 * '* DESTINATION #2 ? 11000 * '* DESTINATION #3 ? 4000 * '* DESTINATION #4 ? 4000 * '* * '* INPUT TRANSPORT COSTS MATRIX: * '* FROM SOURCE #1 TO DESTINATION #1 ? 200 * '* FROM SOURCE #1 TO DESTINATION #2 ? 700 * '* FROM SOURCE #1 TO DESTINATION #3 ? 800 * '* FROM SOURCE #1 TO DESTINATION #4 ? 9999 * '* FROM SOURCE #2 TO DESTINATION #1 ? 400 * '* FROM SOURCE #2 TO DESTINATION #2 ? 400 * '* FROM SOURCE #2 TO DESTINATION #3 ? 500 * '* FROM SOURCE #2 TO DESTINATION #4 ? 500 * '* FROM SOURCE #3 TO DESTINATION #1 ? 400 * '* FROM SOURCE #3 TO DESTINATION #2 ? 500 * '* FROM SOURCE #3 TO DESTINATION #3 ? 600 * '* FROM SOURCE #3 TO DESTINATION #4 ? 600 * '* * '* TRANSPORT MODEL * '* * '* TRANSPORTS: * '* FROM SOURCE #1 TO DESTINATION #1: 2000 * '* FROM SOURCE #1 TO DESTINATION #2: 3000 * '* FROM SOURCE #2 TO DESTINATION #2: 8000 * '* FROM SOURCE #2 TO DESTINATION #3: 2000 * '* FROM SOURCE #3 TO DESTINATION #3: 2000 * '* FROM SOURCE #3 TO DESTINATION #4: 4000 * '* * '* TOTAL TRANSPORT COST: 1.03E+07 * '* * '* --------------------------------------------------------- * '* REFERENCE: * '* Modèles pratiques de décision Tome 2, By Jean-Pierre * '* Blanger, PSI Editions, France, 1982. * '************************************************************* 'PROGRAM TRANSPORT DEFINT I-N CLS GOSUB 2000 'INITIALIZE GOSUB 3000 'STEPPING STONE END 2000 'INITIALIZE PRINT PRINT " TRANSPORT MODEL" PRINT INPUT " NUMBER OF SOURCES ? ", ISOU PRINT INPUT " NUMBER OF DESTINATIONS ? ", IDES PRINT DIM DAO(ISOU), RAD(IDES), C(ISOU, IDES), P(4, IDES + ISOU + 5) DIM XM(ISOU, IDES), R(ISOU, IDES) PRINT " INPUT THE AVAILABLE SOURCE QUANTITIES:" FOR I = 1 TO ISOU PRINT " SOURCE #"; I; : INPUT " "; DAO(I) NEXT I PRINT PRINT " INPUT THE REQUIRED DESTINATION QUANTITIES:" FOR I = 1 TO IDES PRINT " DESTINATION #"; I; : INPUT " "; RAD(I) NEXT I PRINT PRINT " INPUT TRANSPORT COSTS MATRIX:" FOR I=1 TO ISOU FOR J=1 TO IDES PRINT " FROM SOURCE #"; I; " TO DESTINATION #"; J; " ? "; INPUT "", C(I,J) NEXT J NEXT I PRINT PRINT " TRANSPORT MODEL" PRINT RETURN 3000 'STEPPING STONE ALGORITHM GOSUB 4000 'N-W CORNER GOSUB 5000 'OPTIMAL GOSUB 8000 'TOTAL COST RETURN 4000 'N-W CORNER I=1:J=1 4020 IF DAO(I)<=RAD(J) THEN GOTO 4050 XM(I,J)=XM(I,J)+RAD(J):DAO(I)=DAO(I)-RAD(J) RAD(J)=0:J=J+1 GOTO 4060 'ELSE 4050 XM(I,J)=XM(I,J)+DAO(I):RAD(J)=RAD(J)-DAO(I) DAO(I)=0:I=I+1 4060 IF I<=ISOU AND J<=IDES THEN GOTO 4020 RETURN 5000 'OPTIMAL 5010 XINFCC=0 FOR I=1 TO ISOU FOR J=1 TO IDES IF XM(I,J)<>0 THEN GOTO 5070 GOSUB 6000 'SEEK PATH GOSUB 7000 'INCREASE 5070 NEXT J NEXT I IF XINFCC>=0 THEN IOPTIMAL=1 GOTO 5150 END IF FOR I=1 TO LT IX=P(3,I):IY=P(4,I) IF I/2=INT(I/2) THEN XM(IX,IY)=XM(IX,IY)-TT GOTO 5140 END IF XM(IX,IY)=XM(IX,IY)+TT 5140 NEXT I 5150 IF IOPTIMAL=0 THEN GOTO 5010 RETURN 6000 'SEEK PATH FOR I1=1 TO ISOU FOR I2=1 TO IDES R(I1,I2)=XM(I1,I2) NEXT I2 NEXT I1 FOR I1=1 TO ISOU: R(I1,0)=0: NEXT I1 FOR I2=1 TO IDES: R(0,I2)=0: NEXT I2 R(I,J)=1 6070 FOR I2=1 TO IDES IF R(0,I2)=1 THEN GOTO 6160 NR=0 FOR I1=1 TO ISOU IF R(I1,I2)<>0 THEN NR=NR+1 NEXT I1 IF NR<>1 THEN GOTO 6160 FOR I1=1 TO ISOU: R(I1,I2)=0: NEXT I1 R(0,I2)=1: IF1=1 6160 NEXT I2 FOR I1=1 TO ISOU IF R(I1,0)=1 THEN GOTO 6260 NR=0 FOR I2=1 TO IDES IF R(I1,I2)<>0 THEN NR=NR+1 NEXT I2 IF NR<>1 THEN GOTO 6260 FOR I2=1 TO IDES: R(I1,I2)=0: NEXT I2 R(I1,0)=1: IF1=1 6260 NEXT I1 IF IF1=1 THEN IF1=0: GOTO 6070 RETURN 7000 'INCREASE P(1,1)=I:P(2,1)=J:IX=I:IY=J:ID=1:CC=0:QT=999999 7020 ID=ID+1:IF1=0 FOR I1=1 TO ISOU IF R(I1,IY)=0 OR I1=IX THEN GOTO 7070 P(1,ID)=I1: P(2,ID)=IY: IX=I1: CC=CC-C(IX,IY) IF1=1: I1=ISOU IF XM(IX,IY)0 THEN QT=XM(IX,IY) 7070 NEXT I1 IF IF1=0 THEN GOTO 7170 ID=ID+1: IF1=0 FOR I2=1 TO IDES IF R(IX,I2)=0 OR I2=IY THEN GOTO 7130 P(1,ID)=IX: P(2,ID)=I2: IY=I2: CC=CC+C(IX,IY) IF1=1: I2=IDES 7130 NEXT I2 IF IF1=0 THEN GOTO 7170 IF IX<>I OR IY<>J THEN GOTO 7020 GOTO 7180 7170 PRINT " DEGENERATE SOLUTION !" STOP 7180 IF CC>0 OR CC>XINFCC THEN GOTO 7230 TT=QT:XINFCC=CC: ID=ID-1: LT=ID FOR I1=1 TO ID P(3,I1)=P(1,I1): P(4,I1)=P(2,I1) NEXT I1 7230 RETURN 8000 'TOTAL COST CT=0 PRINT PRINT " TRANSPORTS:" FOR I=1 TO ISOU FOR J=1 TO IDES CT=CT+XM(I,J)*C(I,J) IF XM(I,J)=0 THEN GOTO 8080 PRINT " FROM SOURCE #";I;" TO DESTINATION #";J;": ";XM(I,J) 8080 NEXT J NEXT I PRINT PRINT " TOTAL TRANSPORT COST: "; CT PRINT RETURN 'end of file transpor.bas