home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / basic / cpmprt51.bas < prev    next >
Encoding:
BASIC Source File  |  1984-08-06  |  10.6 KB  |  291 lines
  1. 10 ' CPM-PERT Program from Interface Age, Feb 1981
  2. 20 ' Written by Richard Parry
  3. 30 ' Adapted to Microsoft BASIC by Charles H Strom
  4. 40 ' Dressed up & Adapted to Freedom 100 and Decision I 10 Apr 84 [Toad hall]
  5. 50 ' Added COUT and LIST location from CP/M and BIOS jump table to alleviate
  6. 60 ' problems with reserved locations in Page 0, problems with RST 1 and 3
  7. 70 ' (my CP/M didn't have them), having to run any special programs, etc.
  8. 80 ' Also changed location in MBASIC of CONOUT routine (different in V5.1).
  9. 90 ' David Kirschbaum, Toad Hall
  10. 100 ' 7573 Jennings Lane, Fayetteville NC 28303  (919)868-3471/396-6862
  11. 110 ' ARPANet ABN.ISCAMS@USC-ISID
  12. 120 '
  13. 130 '== Locate COUT (conout) and LIST in CP/M BIOS Jump Table ==
  14. 140 '
  15. 150 ' Location of warm boot in BIOS jump table can be found at bytes 0001
  16. 160 ' (Least Significant Byte, LSB), and 0002 (Most Significant Byte, MSB).
  17. 170 '
  18. 180 COUT1%=PEEK(1) : COUT2%=PEEK(2)    'get LSB and MSB of warm boot jump
  19. 190 COUT1%=COUT1%+9    'bump up 9 bytes from warm boot to COUT
  20. 200   IF COUT1%<256 THEN 220        'no need to increase MSB
  21. 210 COUT2%=COUT2%+256 : COUT1%=COUT1%-256    'inx MSB, dx LSB
  22. 220 LST2%=COUT2% : LST1%=COUT1%+3    'bump up 3 bytes from COUT to LIST
  23. 230   IF LST1%<256 THEN 280        'no need to increase MSB
  24. 240 LST2%=LST2%+256 : LST1%=LST1%-256    'inx MSB, dx LSB
  25. 250 '
  26. 260 '== Initialize Normal Distribution Constants
  27. 270 '
  28. 280 RN=15: RS=SQR(3/RN)
  29. 290 CONOUT%= &H41B8    'Loc in MBASIC 5.1 of call to CONOUT
  30. 300 '             old value for MBASIC 5.21 was &H41E4
  31. 310 CLR$=CHR$(27)+"*"    ' Home cursor and clear screen for Freedom 100 terminal
  32. 320 '
  33. 330 ' == Input Data ==
  34. 340 ' 
  35. 350 PRINT CLR$;
  36. 360 PRINT "CPM or PERT Simulation?  (C/P):  ";
  37. 370 Q$=INKEY$:IF LEN(Q$)<1 THEN 370 ELSE PRINT Q$
  38. 380   IF Q$<>"C" AND Q$<>"P" THEN PRINT "ERROR!  Try again.":GOTO 360
  39. 390 PRINT "Do you want a HARD-COPY record?  (Y/N):  ";
  40. 400 HC$=INKEY$:IF LEN(HC$)<1 THEN 400 ELSE PRINT HC$
  41. 410   IF HC$<>"Y" AND HC$<>"N" THEN PRINT "ERROR!  Try again.":GOTO 390
  42. 420   IF HC$<>"Y" THEN 450
  43. 430 PRINT "Note - SETUP.ASM must be loaded before MBASIC"
  44. 440 PRINT "or printer will not function!"
  45. 450 PRINT:INPUT "Number of Activities:  ",N
  46. 460 DIM ML(N), MO(N), MP(N), CP(N), ME(N), SD(N), IC(20)
  47. 470 DIM S(N), F(N), D(N), E(N), L(N), F1(N)
  48. 480 FOR I=1 TO N
  49. 490   PRINT CLR$: PRINT "Activity:  ",I: PRINT
  50. 500   GOSUB 2190                'Go to Input Data routine
  51. 510 NEXT I
  52. 520 PRINT CLR$;
  53. 530 PRINT "Would you like to examine or edit the Input Data?  (Y/N):  ";
  54. 540 Q1$=INKEY$:IF LEN(Q1$)<1 THEN 540 ELSE PRINT Q1$
  55. 550   IF Q1$<>"Y" AND Q1$<>"N" THEN PRINT "ERROR!  Try again.":GOTO 530
  56. 560   IF Q1$="N" THEN 860
  57. 570 GOSUB 2350        'Sort Input Data
  58. 580 '
  59. 590 '== Display Input Data ==
  60. 600 '
  61. 610 IF HC$<>"Y" THEN 640
  62. 620 IF HC$<>"Y" THEN 640
  63. 630   POKE CONOUT%,LST1%:POKE CONOUT%+1,LST2%
  64. 640 PRINT CLR$:IF Q$<>"C" THEN 690
  65. 650 PRINT "ACTIVITY #    FROM       TO     DURATION"
  66. 660 FOR I = 1 TO N
  67. 670   PRINT TAB(5); I; TAB(15); S(I); TAB(25); F(I); TAB(35); D(I)
  68. 680 NEXT I:GOTO 740
  69. 690 PRINT "ACTIVITY #    FROM       TO        ML       MO        MP"
  70. 700 FOR I = 1 TO N
  71. 710   PRINT TAB(5); I; TAB(15); S(I); TAB(25); F(I);
  72. 720   PRINT TAB(35); ML(I); TAB(45); MO(I); TAB(55); MP(I)
  73. 730 NEXT I:PRINT
  74. 740 POKE CONOUT%,COUT1%:POKE CONOUT%+1,COUT2%
  75. 750 PRINT "Would you like to edit an Activity?  (Y/N):  ";
  76. 760 Q1$=INKEY$:IF LEN(Q1$)<1 THEN 760 ELSE PRINT Q1$
  77. 770   IF Q1$<>"Y" AND Q1$<>"N" THEN PRINT "ERROR!  Try again.":GOTO 750
  78. 780   IF Q1$="N" THEN 860
  79. 790 '
  80. 800 '== Edit Mode ==
  81. 810 '
  82. 820 PRINT:INPUT "What activity needs alteration?  (0 to end):  ",I
  83. 830   IF I=0 THEN 520
  84. 840 GOSUB 2190                'Go to Input Data Routine
  85. 850 GOTO 820
  86. 860 GOSUB 2350            'Go to Sort Routine
  87. 870   IF Q$<>"C" THEN 1210
  88. 880 '
  89. 890 ' Critical Path Analysis requested.  Perform Critical Path
  90. 900 ' Analysis once and display results.
  91. 910 '
  92. 920 GOSUB 2600
  93. 930 C2=0
  94. 940 IF HC$<>"Y" THEN 960
  95. 950   POKE CONOUT%,LST1%:POKE CONOUT%+1,LST2%
  96. 960 PRINT CLR$;"CP Analysis is:"
  97. 970 PRINT: PRINT: PRINT "FROM","TO","EST","LFT","FLOAT": PRINT
  98. 980 FOR I = 1 TO N:PRINT S(I),F(I),E(S(I)),L(F(I)),F1(I):NEXT I
  99. 990 PRINT "The Critical Path Length is: ";PL
  100. 1000 PRINT: PRINT "The Critical Path is:":PRINT "FROM","TO": PRINT
  101. 1010 FOR I = 1 TO N
  102. 1020     IF F1(I) = 0 THEN 1040
  103. 1030 NEXT I
  104. 1040 PRINT S(I),F(I): C2=C2+1: IF I>N THEN 1080
  105. 1050 FOR M= 1 TO N
  106. 1060     IF S(M)=F(I) AND F1(M) = 0 THEN I=M: GOTO 1040
  107. 1070 NEXT M
  108. 1080   IF C1<>C2 THEN PRINT: PRINT "There is more than one Critical Path."
  109. 1090 PRINT:POKE CONOUT%,COUT1%:POKE CONOUT%+1,COUT2%
  110. 1100 PRINT "Would you like to edit an Activity or stop program?  (E/S):  ";
  111. 1110 Q1$=INKEY$:IF LEN(Q1$)<1 THEN 1110 ELSE PRINT Q1$
  112. 1120   IF Q1$="E" THEN PRINT:GOTO 640
  113. 1130   IF Q1$<>"S" THEN PRINT "ERROR!  Try again.":GOTO 1100
  114. 1140 END
  115. 1150 '
  116. 1160 '== PERT Simulation requested.  Perform Critical Path Analysis the
  117. 1170 '   number of times specified.  Store path lengths and increment
  118. 1180 '  Activities which appear on Critical Path.  Construct Histogram
  119. 1190 '  and display results.
  120. 1200 '
  121. 1210 FOR I = 1 TO N
  122. 1220   ME(I) = (MO(I)+4*ML(I)+MP(I))/6    'Compute Mean of each activity.
  123. 1230   SD(I) = (MP(I)-MO(I))/6    'Compute Standard Deviation of each activity.
  124. 1240 NEXT I
  125. 1250 '== Compute Most Optimistic Path Length ==
  126. 1260 DU=0: FOR I=1 TO N: CP(I)=0: E(I)=0: L(I)=0: NEXT I
  127. 1270 FOR I = 1 TO N: D(I)=MO(I): NEXT I
  128. 1280 GOSUB 2600
  129. 1290 BC=PL
  130. 1300 '== Compute Most Pessimistic Path Length ==
  131. 1310 DU=0: FOR I=1 TO N: CP(I)=0: E(I)=0: L(I)=0: NEXT I
  132. 1320 FOR I = 1 TO N: D(I)=MP(I): NEXT I
  133. 1330 GOSUB 2600
  134. 1340 WC=PL
  135. 1350 '== Initialize Key Variables ==
  136. 1360 DU=0: FOR I = 1 TO N: CP(I)=0: E(I)=0: L(I)=0: NEXT I
  137. 1370 LS=0: HS=0: FOR I=1 TO 20: IC(I)=0: NEXT I
  138. 1380 '== Initialize Random Number Generator ==
  139. 1390 RANDOMIZE
  140. 1400 '== Propose # of Transactions as 20 * # of Activities ==
  141. 1410 PRINT "Number of transactions should be >= "; 20*N
  142. 1420 INPUT "Number of transactions:  ",NS
  143. 1430 PRINT: PRINT "++SIMULATION IN PROGRESS++"
  144. 1440 '
  145. 1450 '== Construct Histogram ==
  146. 1460 '-- Set Appropriate Interval (i.e., Integer >=1) --
  147. 1470 LL=INT(BC)
  148. 1480   IF WC-BC<=20 THEN IN=1
  149. 1490 IN=INT((WC-BC)/20)+1
  150. 1500 '
  151. 1510 '-- Perform Simulation --
  152. 1520 TC=100
  153. 1530 FOR K=1 TO NS
  154. 1540     IF K=TC THEN PRINT "++ Simulation in Progress ++";TC: TC=TC+100
  155. 1550   FOR J=1 TO N
  156. 1560     S=0: E(J)=0: L(J)=0
  157. 1570       IF ML(J)=0 THEN D(J)=0: GOTO 1600
  158. 1580     FOR I=1 TO RN: S=S+2*RND-1: NEXT I
  159. 1590     D(J)=ME(J)+SD(J)*S*RS
  160. 1600   NEXT J
  161. 1610   GOSUB 2600
  162. 1620 '-- Find Interval for This Path Length --
  163. 1630   I3=(PL-LL)/IN+2
  164. 1640     IF I3<1 THEN LS=LS+1: GOTO 1680
  165. 1650     IF I3>20 THEN HS=HS+1: GOTO 1680
  166. 1660   I3=INT(I3)
  167. 1670   IC(I3)=IC(I3)+1
  168. 1680 NEXT K
  169. 1690 '
  170. 1700 '-- Print Frequency Distribution Table --
  171. 1710 IF HC$<>"Y" THEN 1730
  172. 1720   POKE CONOUT%,LST1%:POKE CONOUT%+1,LST2%
  173. 1730 PRINT CLR$;"++FREQUENCY DISTRIBUTION TABLE++": PRINT
  174. 1740 PRINT "Most OPTIMISTIC  path length: "; BC
  175. 1750 PRINT "Most PESSIMISTIC path length: "; WC
  176. 1760 PRINT "Number of transactions LOWER  than histogram range: ";LS
  177. 1770 PRINT "Number of transactions HIGHER than histogram range: ";HS: PRINT
  178. 1780 PRINT "     INTERVAL      FREQ.      PCT."
  179. 1790 I1=LL-IN: I2=LL
  180. 1800 FOR M=1 TO 20
  181. 1810   PRINT"=>";I1;"<";I2;TAB(20);IC(M);TAB(30);INT(.5+100*IC(M)/NS)
  182. 1820   I1=I1+IN: I2=I2+IN
  183. 1830 NEXT M
  184. 1840 '
  185. 1850 '== Print Histogram ==
  186. 1860 '-- Compute Histogram Scale Factor --
  187. 1870 SC=0: LO=18: J=0: LL=INT(BC)
  188. 1880 FOR M=1 TO 20
  189. 1890     IF IC(M)>SC THEN SC=IC(M)
  190. 1900 NEXT M
  191. 1910 SC=50/SC: X$="PATH LENGTH"
  192. 1920 PRINT: PRINT: PRINT TAB(24); "++ HISTOGRAM ++": PRINT
  193. 1930 PRINT TAB(18);"RELATIVE FREQUENCY OF PATH LENGTHS"
  194. 1940 PRINT TAB(LO); "+------------------------------------------------+"
  195. 1950 FOR M=1 TO 20
  196. 1960   HM=IC(M)*SC
  197. 1970   FOR K=1 TO 3
  198. 1980     J=J+1: PRINT MID$(X$,J,1);TAB(2);
  199. 1990       IF K=2 THEN PRINT ">=";LL-IN;"<";LL;: LL=LL+IN
  200. 2000     PRINT TAB(LO);
  201. 2010       IF IC(M)=0 THEN PRINT: GOTO 2030
  202. 2020     FOR I=1 TO HM: PRINT "*";: NEXT I: PRINT
  203. 2030   NEXT K
  204. 2040 NEXT M
  205. 2050 '
  206. 2060 '-- Print Activity Analysis --
  207. 2070 PRINT: PRINT
  208. 2080 PRINT TAB(10); "+++ CP ACTIVITY ANALYSIS TABLE +++": PRINT
  209. 2090 PRINT "ACTIVITY #    FROM      TO     CP FREQ.    PCT."
  210. 2100 FOR I=1 TO N
  211. 2110   PRINT TAB(5);I;TAB(15);S(I);TAB(25);F(I);
  212. 2120   PRINT TAB(35);CP(I);TAB(45);INT(.5+100*CP(I)/NS)
  213. 2130 NEXT I
  214. 2140 PRINT: PRINT "DUPLICATE critical paths occurred";DU;"times."
  215. 2150 GOTO 1090        'Quit??
  216. 2160 '
  217. 2170 '== Input Data Routine ==
  218. 2180 '
  219. 2190 INPUT "FROM:  ",S(I)
  220. 2200 INPUT "  TO:  ",F(I)
  221. 2210   IF F(I)>N THEN PRINT "++End Node # NOT <= # of Activities++":GOTO 2200
  222. 2220   IF S(I)>F(I) THEN PRINT "++Start Node MUST be < End Node++":GOTO 2190
  223. 2230   IF LEFT$(Q$,1)="C" THEN INPUT "Duration:  ",D(I): GOTO 2310
  224. 2240 INPUT "     Most Likely:  ",ML(I)
  225. 2250 '-- Check for Dummy Activity --
  226. 2260   IF ML(I)=0 THEN MO(I)=0: MP(I)=0: GOTO 2310
  227. 2270 INPUT " Most Optimistic:  ", MO(I)
  228. 2280   IF MO(I)>ML(I) THEN PRINT "++MO MUST be <= ML++": GOTO 2270
  229. 2290 INPUT "Most Pessimistic:  ", MP(I)
  230. 2300   IF MP(I)<ML(I) THEN PRINT "++MP MUST be >= ML++": GOTO 2290
  231. 2310 RETURN
  232. 2320 '
  233. 2330 '== Sort Data Using Start Node as Key ==
  234. 2340 '
  235. 2350 PRINT: PRINT "Sorting in Progress": PRINT
  236. 2360 SW=0
  237. 2370 FOR I=1 TO N-1
  238. 2380   J=I+1
  239. 2390     IF S(I)<=S(J) THEN 2470
  240. 2400   EX=S(I): S(I)=S(J): S(J)=EX
  241. 2410   EX=F(I): F(I)=F(J): F(J)=EX
  242. 2420   EX=D(I): D(I)=D(J): D(J)=EX
  243. 2430   EX=ML(I): ML(I)=ML(J): ML(J)=EX
  244. 2440   EX=MO(I): MO(I)=MO(J): MO(J)=EX
  245. 2450   EX=MP(I): MP(I)=MP(J): MP(J)=EX
  246. 2460   SW=1
  247. 2470 NEXT I
  248. 2480   IF SW=1 THEN 2360
  249. 2490 RETURN
  250. 2500 '
  251. 2510 '== The following subroutine is used by both the CPM Analysis
  252. 2520 '   and the PERT Simulation Analysis.  While the CPM Analysis
  253. 2530 '   calls the routine only once, the Simulation calls the
  254. 2540 '   routine the number of times requested by the user.
  255. 2550 '   The Earliest, Latest, and Float Times are computed, and
  256. 2560 '   from this data the Critical Path Length and Critical Path
  257. 2570 '   are calculated.  Duplicate Critical Paths are only counted once.
  258. 2580 '
  259. 2590 '== Compute Earliest Starting Time ==
  260. 2600 C1=0: C2=0: PL=0
  261. 2610 FOR I=1 TO N
  262. 2620   M1=E(S(I))+D(I)
  263. 2630     IF E(F(I))<=M1 THEN E(F(I))=M1
  264. 2640 NEXT I
  265. 2650 '== Compute Latest Finishing Time ==
  266. 2660 L(F(N))=E(F(N))
  267. 2670 FOR I=N TO 1 STEP -1
  268. 2680   L1=S(I): M2=L(F(I))-D(I)
  269. 2690     IF L(L1)>=M2 OR L(L1)=0 THEN L(L1)=M2
  270. 2700 NEXT I
  271. 2710 '== Compute Float Time ==
  272. 2720 FOR I=1 TO N
  273. 2730   F1(I)=L(F(I))-E(S(I))-D(I)
  274. 2740     IF F1(I)<.0001 THEN F1(I)=0: C1=C1+1
  275. 2750 NEXT I
  276. 2760 '== Compute Critical Path Length ==
  277. 2770 FOR I=1 TO N
  278. 2780     IF L(F(I))>PL THEN PL=L(F(I))
  279. 2790 NEXT I
  280. 2800 '== Compute Critical Path ==
  281. 2810 FOR I=1 TO N
  282. 2820     IF F1(I)=0 THEN 2840
  283. 2830 NEXT I
  284. 2840 C2=C2+1: CP(I)=CP(I)+1
  285. 2850   IF I>N THEN 2890
  286. 2860 FOR M=1 TO N
  287. 2870     IF S(M)=F(I) AND F1(M)=0 THEN I=M: GOTO 2840
  288. 2880 NEXT M
  289. 2890   IF C1<>C2 THEN DU=DU+1
  290. 2900 RETURN
  291.