1  REM ****  HP BASIC PROGRAM LIBRARY  ******************************
2  REM
3  REM       GTASPD: SUBJECTIVE PROBABILITY DISTRIBUTION
4  REM
5  REM       36549 REV A
6  REM
7  REM ****  CONTRIBUTED PROGRAM  ***********************************
395  PRINT LIN(4)
400  PRINT "TECHNIQUE FOR ASSESSMENT OF SUBJECTIVE ";
405  PRINT "PROBABILITY DISTRIBUTIONS"
410  GOTO 1040
495  PRINT LIN(4)
500  PRINT "THIS PROGRAM WILL ASSIST YOU IN DETERMINING A SUBJECTIVE"
505  PRINT "PROBABILITY DISTRIBUTION WHICH WILL REPRESENT YOUR STATE"
510  PRINT "OF KNOWLEDGE ABOUT SOME RANDOM VARIABLE.  YOU PROVIDE THREE"
515  PRINT "VALUES:  A)  THE MINIMUM POSSIBLE VALUE,"
520  PRINT "         B)  THE MAXIMUM POSSIBLE VALUE, AND"
525  PRINT "         C)  THE MOST LIKELY VALUE (THE MODE)."
530  PRINT "THE PROGRAM FITS A TRUNCATED, MODIFIED WIEBULL DISTRIBUTION"
535  PRINT "(SEE $GWBULL) TO THE THREE VALUES AND PRINTS AN INITIAL"
540  PRINT "HISTOGRAM SHOWING THE RELATIVE LIKELIHOOD THAT THE TRUE"
545  PRINT "VALUE IS CONTAINED IN AN INTERVAL.  YOU ARE ASKED TO MODIFY"
550  PRINT "THE HISTOGRAM SO THAT IT WILL MORE ACCURATELY REPLECT YOUR"
555  PRINT "OWN FEELINGS;  THEN A NEW HISTOGRAM IS PRINTED.  THIS CYCLE"
560  PRINT "IS REPEATED UNTIL YOU ARE SATISFIED WITH THE RELATIVE LIKE-"
565  PRINT "LIHOOD IN EACH INTERVAL.  FINALLY THE HISTOGRAM IS NORMAL-"
570  PRINT "IZED TO DETERMINE THE PROBABILITY MASS PER INTERVAL, AND A"
575  PRINT "CUMULATIVE DISTRIBUTION FUNCTION (PIECEWISE LINEAR APPROXI-"
580  PRINT "MATION) IS PRINTED."
590  REM
600  REM.....FOR FURTHER INFORMATION, CONTACT MIKE MIDDLETON.
700  PRINT LIN(4)
710  PRINT "SCALE THE RANDOM VARIABLE SO THAT"
720  PRINT "     A)  MIN >= 1, MAX < 10000,"
730  PRINT "     B)  (MAX - MIN) > 1, AND"
740  PRINT "     C)  MIN < MODE < MAX."
750  GOTO 1160
800  REM
805  REM
810  REM.....EXPLANATION OF VARIABLES, IN APPROXIMATE ORDER OF USE
815  REM
820  REM     A1,A2,D1,  INPUT RESPONSES, 0 OR 1
825  REM     Z(1),  MIN VALUE OF THE R.V.
830  REM     Z(2),  MAX VALUE
835  REM     M0,M9,  MODE
840  REM     M3,  ACTUAL RANGE (MAX MINUS MIN)
845  REM     M4,  NORMALIZED RANGE (10<M4<=100)
850  REM     M5,  NORMALIZED INTERVAL WIDTH (1,2,4,5, OR 10)
855  REM     M6,  ACTUAL INTERVAL WIDTH
860  REM     L(I),  LOW VALUE OF INTERVAL I
865  REM     H(I),  HIGH VALUE (END-POINT) OF INTERVAL I
870  REM     M8,  TOTAL NUMBER OF INTERVALS
875  REM     N0,P(1),P(2),F0,L0,S0, AND OTHER VARIABLES USED IN
880  REM            LINES 9010 TO 9800, SEE LIBRARY PROGRAM $GWBULL
885  REM     C(I),  CUMULATIVE WIEBULL PROBABILITY
890  REM     X(I),  WIEBULL PROBABILITY MASS PER INTERVAL AND
895  REM            NUMBER OF ASTERISKS PER INTERVAL
900  REM     N3,  MAX PROBABILITY MASS PER INTERVAL OVER ALL INTERVALS
905  REM     N5,  COUNTER FO NUMBER OF TIMES HISTOGRAM IS PRINTED
910  REM     I,  INPUT RESPONSE, INTERVAL TO BE MODIFIED
915  REM     A,  INPUT RESPONSE, NUMBER OF *'S TO BE CHANGED
925  REM     N7,  TOTAL *'S IN FINAL HISTOGRAM
930  REM     D(I),  PROBABILITY MASS IN INTERVAL I
935  REM     F(I), TRANSFORMED CUMULATIVE PROBABILITY, SCALED 0 TO 50
940  REM
1040  DIM C[13],D[13],H[13],L[13],X[13]
1050  DIM F[13]
1060  PRINT LIN(4);"FOR ALL YES-NO RESPONSES, USE '1' FOR YES, ";
1070  PRINT "'0' FOR NO."
1080  PRINT LIN(4);"DO YOU WANT AN EXPLANATION OF THE PROGRAM";
1090  INPUT A1
1100  IF A1=0 THEN 1120
1110  GOTO 495
1120  PRINT LIN(4);"DO YOU WANT AN EXPLANATION OF THE DATA INPUT";
1130  INPUT A2
1140  IF A2=0 THEN 1160
1150  GOTO 700
1160  PRINT LIN(4);"MINIMUM POSSIBLE VALUE";
1170  INPUT Z[1]
1180  PRINT LIN(4);"MAXIMUM POSSIBLE VALUE";
1190  INPUT Z[2]
1200  PRINT LIN(4);"MOST LIKELY VALUE (MUST BE BETWEEN THE MIN ";
1210  PRINT "AND MAX VALUES) ";
1220  INPUT M0
1230  LET M9=M0
1240  IF Z[1] >= M0 OR M0 >= Z[2] THEN 8190
1250  IF Z[1]<1 OR Z[2] >= 10000 THEN 8190
1260  LET M3=Z[2]-Z[1]
1270  IF M3 <= 1 THEN 8190
1280  IF M3>10 THEN 1330
1290  LET M4=10*M3
1300  GOSUB 8240
1310  LET M6=M5/10
1320  GOTO 1460
1330  IF M3>100 THEN 1380
1340  LET M4=M3
1350  GOSUB 8240
1360  LET M6=M5
1370  GOTO 1460
1380  IF M3>1000 THEN 1430
1390  LET M4=M3/10
1400  GOSUB 8240
1410  LET M6=10*M5
1420  GOTO 1460
1430  LET M4=M3/100
1440  GOSUB 8240
1450  LET M6=100*M5
1460  LET L[1]=H[1]=L[2]=M6*INT(Z[1]/M6)
1470  LET H[2]=L[2]+M6-.01
1480  FOR I=3 TO 13
1490  LET L[I]=L[I-1]+M6
1500  LET H[I]=L[I]+M6-.01
1510  IF H[I] >= Z[2] THEN 1540
1520  NEXT I
1540  LET M8=I+1
1550  LET L[M8]=H[M8]=L[I]+M6
1560  N0=2
1570  P[1]=.1
1580  P[2]=.9
1590  GOSUB 9020
1600  IF F0<0 THEN 1650
1610  FOR I=2 TO M8
1620  C[I]=1-EXP(-(L0/(L0+1))*(ABS((L[I]-S0)/(M9-S0)))^(L0+1))
1630  NEXT I
1640  GOTO 1680
1650  FOR I=2 TO M8
1660  C[I]=EXP(-(L0/(L0+1))*(ABS((L[I]-S0)/(M9-S0)))^(L0+1))
1670  NEXT I
1680  LET X[1]=C[2]
1690  LET N3=X[2]=C[3]-C[2]
1700  FOR I=3 TO M8-1
1710  LET X[I]=C[I+1]-C[I]
1720  IF X[I]<N3 THEN 1740
1730  LET N3=X[I]
1740  NEXT I
1750  LET X[M8]=1-C[M8]
1760  IF X[1]<X[2] THEN 1780
1770  LET X[1]=X[2]
1780  IF X[M8]<X[M8-1] THEN 1800
1790  LET X[M8]=X[M8-1]
1800  FOR I=1 TO M8
1810  LET X[I]=INT((30/N3)*X[I])
1820  NEXT I
1830  N5=0
1840  PRINT LIN(4)
1850  N5=N5+1
1860  PRINT TAB(33);"RELATIVE LIKELIHOOD / INTERVAL"
1870  PRINT TAB(28);"0";TAB(37);"10";TAB(47);"20";TAB(57);"30";
1880  PRINT TAB(67);"40"
1890  FOR T1=1 TO 5
1900  PRINT TAB(18+T1*10);"!";
1910  NEXT T1
1920  PRINT 
1930  GOSUB 8500
1980  PRINT TAB(28);"!"
1990  PRINT  USING 2000;L[1]
2000  IMAGE #,X,"1",8X,"BELOW",X,4D.2D,4X,"-!"
2010  FOR J=1 TO X[1]
2020  PRINT "*";
2030  NEXT J
2040  PRINT "";LIN(1);TAB(28);"!"
2050  FOR I=2 TO M8-1
2060  PRINT  USING 2070;I,L[I],H[I]
2070  IMAGE #,2D,2X,5D.2D,X,"TO",5D.2D,4X,"-!"
2080  FOR J=1 TO X[I]
2090  PRINT "*";
2100  NEXT J
2110  PRINT "";LIN(1);TAB(28);"!"
2120  NEXT I
2130  PRINT  USING 2140;M8,L[M8]
2140  IMAGE #,2D,2X,5D.2D,X,"AND ABOVE",5X,"-!"
2150  FOR J=1 TO X[M8]
2160  PRINT "*";
2170  NEXT J
2172  PRINT "";LIN(1);TAB(28);"!"
2176  GOSUB 8500
2180  PRINT LIN(4)
2190  IF N5>1 THEN 2250
2200  PRINT "INTERPRET THE HISTOGRAM AS FOLLOWS:  IF, FOR EXAMPLE,"
2210  PRINT "THERE ARE 12 *'S IN INTERVAL 5 AND 4 *'S IN INTERVAL 9,"
2220  PRINT "THEN IT IS THREE TIMES AS LIKELY THAT THE TRUE VALUE IS"
2230  PRINT "IN INTERVAL 5 THAN IN INTERVAL 9.  MAKE SIMILAR PAIRWISE"
2240  PRINT "COMPARISONS WITH THE OTHER INTERVALS."
2250  PRINT LIN(2);"DO YOU WANT TO MODIFY THE HISTOGRAM";
2260  INPUT D1
2270  IF D1=0 THEN 2470
2280  PRINT LIN(4)
2290  IF N5>1 THEN 2355
2300  PRINT "FOLLOWING EACH '?' TYPE THE NUMBER OF THE INTERVAL YOU "
2310  PRINT "WANT TO MODIFY, COMMA, AND THE NUMBER OF *'S YOU WANT"
2320  PRINT "DELETED (-) OR ADDED.  FOR EXAMPLE, '7,-3' MEANS DELETE"
2330  PRINT "3 *'S FROM INTERVAL 7.  '4,9' MEANS ADD 9 *'S TO INTERVAL"
2340  PRINT "4.  TYPE '0,0' WHEN YOU HAVE COMPLETED THE DESIRED MODI-"
2345  PRINT "FICATIONS;  THEN A REVISED HISTOGRAM WILL BE PRINTED."
2350  GOTO 2365
2355  PRINT "AS BEFORE, TYPE INTERVAL NUMBER, COMMA,"
2360  PRINT "AND NUMBER OF *'S TO BE CHANGED."
2365  PRINT 
2370  FOR J=1 TO 50
2375  INPUT I,A
2380  IF I=0 THEN 1840
2390  IF I<0 OR I>M8 THEN 2430
2400  LET X[I]=X[I]+A
2410  IF X[I] >= 0 THEN 2430
2420  LET X[I]=0
2430  IF X[I] <= 42 THEN 2450
2440  LET X[I]=42
2450  NEXT J
2460  GOTO 1840
2470  N7=0
2480  FOR I=1 TO M8
2490  LET N7=N7+X[I]
2500  NEXT I
2510  FOR I=1 TO M8
2520  LET D[I]=X[I]/N7
2530  NEXT I
2540  PRINT LIN(4)
2550  PRINT TAB(28);"PROBABILITY"
2560  PRINT TAB(31);"MASS"
2570  PRINT  USING 2580;L[1],D[1]
2580  IMAGE X,"1",8X,"BELOW",X,4D.2D,7X,D.3D
2590  FOR I=2 TO M8-1
2600  PRINT  USING 2610;I,L[I],H[I],D[I]
2610  IMAGE 2D,2X,5D.2D,X,"TO",5D.2D,7X,D.3D
2620  NEXT I
2630  PRINT  USING 2640;M8,L[M8],D[M8]
2640  IMAGE 2D,2X,5D.2D,X,"AND ABOVE",8X,D.3D
2650  PRINT LIN(4)
2660  LET F[1]=0
2670  FOR I=2 TO M8
2680  LET D[I-1]=50*D[I-1]
2690  LET F[I]=F[I-1]+D[I-1]
2700  NEXT I
2710  PRINT TAB(27);"CUMULATIVE PROBABILITY"
2720  PRINT 
2730  PRINT TAB(12);"0";TAB(16);".1";TAB(21);".2";TAB(26);".3";TAB(31);
2740  PRINT ".4";TAB(36);".5";TAB(41);".6";TAB(46);".7";TAB(51);".8";
2750  PRINT TAB(56);".9";TAB(61);"1.0"
2760  GOSUB 8360
2770  PRINT TAB(11);"!"
2780  FOR I=2 TO M8
2790  PRINT  USING 2800;L[I]
2800  IMAGE #,5D.2D,2X,"-!"
2810  PRINT TAB(12+F[I]);"*"
2820  IF I=M8 THEN 2850
2830  PRINT TAB(11);"!";TAB((24+F[I]+F[I+1])/2);"*"
2840  NEXT I
2850  PRINT TAB(11);"!"
2860  GOSUB 8360
2865  PRINT LIN(4)
2870  STOP 
8190  PRINT LIN(4)
8200  PRINT "THE THREE VALUES DO NOT MEET PROGRAM REQUIREMENTS."
8210  PRINT LIN(1);"PLEASE RUN AGAIN AND REQUEST AN EXPLANATION ";
8220  PRINT "OF THE DATA INPUT."
8230  STOP 
8240  REM.....DETERMINE M5, NORMALIZED WIDTH OF THE INTERVALS
8250  IF M4 >= 20 THEN 8280
8260  LET M5=2
8270  RETURN 
8280  IF M4 >= 30 THEN 8310
8290  LET M5=4
8300  RETURN 
8310  IF M4 >= 50 THEN 8340
8320  LET M5=5
8330  RETURN 
8340  LET M5=10
8350  RETURN 
8360  PRINT TAB(11);"-";
8370  FOR T3=1 TO 10
8380  PRINT "+----";
8390  NEXT T3
8400  PRINT "+"
8410  RETURN 
8490  STOP 
8500  PRINT TAB(28);
8510  FOR T2=1 TO 4
8520  PRINT "+---------";
8530  NEXT T2
8540  PRINT "+"
8550  RETURN 
9000  STOP 
9010  REM.....WEIBULL SUBROUTINE
9020  S1=S2=.01*ABS(Z[N0]-Z[1])
9030  N1=C1=0
9040  R0=-1.E+10
9060  IF ABS(M0-Z[1])>ABS(M0-Z[N0]) THEN 9100
9070  S0=Z[1]-S1
9080  F0=1
9090  GOTO 9150
9100  S0=Z[N0]+S1
9110  F0=-1
9120  FOR I=1 TO N0
9130  P[I]=1-P[I]
9140  NEXT I
9150  FOR I=1 TO N0
9160  Q[I]=P[I]*(1-P[I])
9170  C1=C1+(P[I]^2)/Q[I]
9180  NEXT I
9200  M1=M0-S0
9210  FOR I=1 TO N0
9220  V[I]=ABS((Z[I]-S0)/M1)
9230  NEXT I
9240  N1=N1+1
9250  GOSUB 9430
9290  IF R1<R0 THEN 9370
9300  R0=R1
9310  L4=L0
9320  S0=S0-S1*F0
9330  S1=S1+S2
9340  S2=S1-S2
9350  IF N1<11 THEN 9200
9370  S0=S0+S2*F0
9380  L0=L4
9390  M0=(M0-S0)*F0
9400  F0=F0/M0
9410  RETURN 
9430  L2=.2
9440  R1=-1.E+10
9450  L0=R2=N2=0
9460  L1=.1
9470  GOTO 9510
9480  L1=.2
9490  R1=C2
9510  L3=L1+1
9520  C3=0
9530  FOR I=1 TO N0
9540  C2=EXP(L3*LOG(V[I]))*(L1/L3)
9550  C3=C3+((P[I]-1+EXP(-C2))^2)/Q[I]
9560  NEXT I
9570  N2=N2+1
9610  C2=1-C3/C1
9620  IF L1=.1 THEN 9480
9630  IF C2<R1 THEN 9730
9640  R1=C2
9650  IF R2>0 THEN 9700
9660  L0=L2
9670  L1=L1+L2
9680  L2=L1-L2
9690  GOTO 9720
9700  L0=L1
9710  L1=L1+L2
9720  IF N2<25 THEN 9510
9730  IF R2>0 THEN 9810
9740  IF L2=L0 THEN 9760
9750  L2=L2-L0
9760  L2=L0=R2=L2/4
9770  L1=L0+L2/2
9780  R1=-1.E+10
9790  L0=L1
9800  GOTO 9510
9810  RETURN 
9999  END 
