Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0113/cmod91.bas
There are 2 other files named cmod91.bas in the archive. Click here to see a list.
00020REM ***************************************************************
00030REM CMOD91 CMOD91 CMOD91 CMOD91 CMOD91 CMOD91
00040REM ***************************************************************
00050REM
00060REM RESTRICTED SELECTION --- ASSESSING UTILITY STRUCTURE
00070REM
00080REM ***************************************************************
00090REM ***************************************************************
00100 FILES RFILE1,RFILE2,RFILE3
00140RESTORE#1
00141 INPUT# 1,I1,I2,I3
00150SCRATCH#1
00151 PRINT # 1,91,I2,I3
00160 DIM P(11),L(12),U(8)
00170 DIM Y(3,1),S(3,3),T(3,3),X(3,1)
00180S9=0
00190X0=0
00200X2=0
00210Y0=0
00220Y2=0
00230S2=0
00240U1=0
00250PRINT L$
00260PRINT " RESTRICTED SELECTION FROM TWO GROUPS"
00270PRINT " USING"
00280PRINT " THRESHOLD UTILITY STRUCTURES"
00290PRINT
00300PRINT "THE SELECTION MODEL ASSUMES THAT THE APPLICANT POOL IS COMPOSED"
00310PRINT "OF APPLICANTS FROM TWO DISTINCT GROUPS. ASSOCIATED WITH EACH"
00320PRINT "GROUP IS A THRESHOLD UTILITY STRUCTURE. THE STRUCTURES MAY BE"
00330PRINT "THE SAME OR THEY MAY BE DIFFERENT."
00340PRINT
00350PRINT "THE OBJECTIVE IS TO FIND THE SELECTION PROCEDURE THAT MAXIMIZES"
00360PRINT "EXPECTED UTILITY GIVEN THAT A SPECIFIED PROPORTION OF THE TOTAL"
00370PRINT "MUST BE ACCEPTED."
00380PRINT
00390PRINT "THE PURPOSE OF THIS MODULE IS TO ASSESS THE UTILITY STRUCTURES."
00400PRINT "ALTHOUGH THE MODEL IS FOR RESTRICTED SELECTION THE FIRST PART"
00410PRINT "OF THE ASSESSMENT INVOLVES QUESTIONS ABOUT QUOTA-FREE SELECTION."
00420PRINT "THIS IS DONE TO FIND OUT IF YOUR QUOTA FORCES YOU TO ACCEPT"
00430PRINT "APPLICANTS YOU MIGHT PREFER TO REJECT IN A QUOTA-FREE SITUATION."
00440PRINT
00450GOSUB 3290
00460PRINT L$
00470PRINT "SUPPOSE YOU WERE IN A QUOTA-FREE SELECTION SITUATION."
00480PRINT
00490PRINT "CONSIDER ONLY GROUP 1 APPLICANTS."
00500PRINT
00510PRINT "YOU WILL BE GIVEN THE PROBABILITY THAT AN APPLICANT WOULD"
00520PRINT "BE SUCCESSFUL IF HE WERE SELECTED AND YOU ARE TO DECIDE IF "
00530PRINT "YOU WOULD PREFER TO ACCEPT OR REJECT THE APPLICANT."
00540PRINT
00550PRINT "IF YOU WOULD PREFER TO ACCEPT THE APPLICANT, TYPE '1'."
00560PRINT "IF YOU WOULD PREFER TO REJECT THE APPLICANT, TYPE '2'."
00570PRINT "IF YOU HAVE NO PREFERENCE, TYPE '3'."
00580PRINT
00590PRINT "ACCEPT=1 REJECT=2 NO PREFERENCE=3"
00600PRINT
00610PRINT "PROBABILITY OF SUCCESS YOUR PREFERENCE"
00620P4=.05
00630P6=.95
00640P5=RND(0)*.3+.55
00650GOTO 690
00660P5=.5*(P4+P6)
00670IF P4+.01 >= P6 THEN 800
00680REM
00690PRINT" ";P5;" ";
00700GOSUB 9000
00710IF O1=3 THEN 800
00720IF O1=1 THEN 780
00730IF O1=2 THEN 760
00740PRINT "REENTER. MUST BE NUMBER OF OPTION.";
00750GOTO 700
00760P4=P5
00770GOTO 660
00780P6=P5
00790GOTO 660
00800IF U1=0 THEN 3210
00810PRINT
00820R2=P5
00830PRINT USING 2670,1,R1
00840PRINT USING 2670,2,R2
00850PRINT
00860R1=1-R1
00870R2=1-R2
00880S2=S2+R1*R2
00890Y0=Y0+R2
00900U2=1/(1-P5)
00910Y2=Y2+R2*R2
00920GOSUB 3290
00930X0=X0+R1
00940X2=X2+R1*R1
00950R1=1-R1
00960R2=1-R2
00970PRINT L$
00980PRINT "SUPPOSE YOU ONLY HAVE ONE OPENING LEFT."
00990PRINT
01000PRINT "FOR EACH PAIR OF APPLICANTS INDICATE WHICH APPLICANT YOU"
01010PRINT "WOULD PREFER TO ACCEPT (THE OTHER IS THEREBY REJECTED)."
01020PRINT
01030PRINT "IF YOU HAVE A PREFERENCE TYPE THE NUMBER OF THE GROUP."
01040PRINT "IF YOU HAVE NO PREFERENCE TYPE '3'."
01050PRINT
01060C5=.1+RND(0)*.4
01070PRINT "GROUP 1 APPLICANT GROUP 2 APPLICANT"
01080PRINT " PROB SUCCESS PROB SUCCESS ACCEPT"
01090K2=0
01100K1=1
01110P4=0
01120P6=1
01130P5=P4+RND(0)*(P6-P4)
01140GOTO 1210
01150P5=.5*P4+.5*P6
01160IF ABS(P6-P4)<.01 THEN 1320
01210IF C5<.995 THEN 1270
01220IF P5<.995 THEN 1250
01230PRINT" ";C5;" ";P5;" ";
01240GOTO 1310
01250PRINT" ";C5;" ";P5;" ";
01260GOTO 1310
01270IF P5<.995 THEN 1300
01280PRINT" ";C5;" ";P5;" ";
01290GOTO 1310
01300PRINT" ";C5;" ";P5;" ";
01310GOSUB 9000
01320IF O1=3 THEN 1410
01330IF O1=2 THEN 1390
01340IF O1=1 THEN 1370
01350PRINT "REENTER. MUST BE NUMBER OF OPTION.";
01360GOTO 1310
01370P4=P5
01380GOTO 1150
01390P6=P5
01400GOTO 1150
01410X0=X0-C5+1
01420Y0=Y0-P5+1
01430X2=X2+(1-C5)*(1-C5)
01440Y2=Y2+(1-P5)*(1-P5)
01450S2=S2+(1-P5)*(1-C5)
01460IF K2=1 THEN 1510
01470K2=1
01480P4=P5
01490C5=INT(5+RND(0)*4)/10
01500GOTO 1120
01510PRINT L$
01520S0=(S2-Y0*X0/3)/(X2-X0*X0/3)
01530C0=Y0/3-S0/3*X0
01540PRINT "THE UTILITY STRUCTURES FITTED TO YOUR STATED PREFERENCES IMPLY"
01550PRINT "YOU WOULD BE INDIFFERENT ABOUT WHICH OF THE APPLICANTS IN EACH"
01560PRINT "OF THESE PAIRS TO SELECT. NOTE THAT THE QUOTA-FREE CRITICAL"
01570PRINT "PROBABILITES MUST FORM AN INDIFFERENCE PAIR."
01580PRINT
01590GOSUB 1610
01600GOTO 1870
01610PRINT " GROUP1 APPLICANT GROUP 2 APPLICANT"
01620PRINT " PROB SUCCESS PROB SUCCESS"
01630K3=1
01640FOR I=.05 TO .95 STEP .1
01650:##. ##.## ##.##
01660:##. ##.## ##.##
01670L2=C0+S0*(1-I)
01680L2=1-L2
01690IF L2>.99 THEN 1780
01700IF L2<.01 THEN 1780
01710IF I<1 THEN 1740
01720PRINT USING 1660,K3,I,L2
01730GOTO 1750
01740PRINT USING 1650,K3,I,L2
01750P(K3)=I
01760L(K3)=I
01770K3=K3+1
01780NEXT I
01790K3=K3-1
01800GOTO 1860
01810PRINT "QUOTA-FREE"
01820: ##.## (SPECIFIED) ##.## (IMPLIED)
01830PRINT USING 1820,R1,1-C0-S0*(1-R1)
01840: ##.## (IMPLIED) ##.## (SPECIFIED)
01850PRINT USING 1840,1-((1-R2)-C0)/S0,R2
01860RETURN
01870PRINT
01880PRINT "IF THE FIT IS SATISFACTORY TYPE '1', ELSE '0'.";
01890GOSUB 9000
01900IF O1=0 THEN 2870
01910IF ABS(R2-1+C0+S0-S0*R1)<.00001 THEN 2130
01920PRINT L$
01930PRINT "THE QUOTA-FREE CRITICAL PROBABILITIES MUST BE INDIFFERENCE"
01940PRINT "PROBABILITIES."
01950PRINT
01955PRINT "HERE ARE THE CRITICAL PROBABILITIES DETERMINED IN THE FIRST"
01956PRINT "PART OF THE ASSESSMENT PROCEDURE. THEY ARE NOT CONSISTENT"
01957PRINT "WITH THE OTHER INDIFFERENCE PROBABILITIES."
01958PRINT
01960PRINT USING 2670,1,R1
01970PRINT USING 2670,2,R2
01980PRINT
01990PRINT "PLEASE SPECIFY THE CRITICAL PROBABILITLITY FOR GROUP 1";
02000GOSUB 9000
02010IF O1 >= 1 THEN 2800
02020IF O1 <= 0 THEN 2800
02030R2=C0+S0*(1-O1)
02040R2=1-R2
02050IF R2 >= 1 THEN 2820
02060IF R2 <= 0 THEN 2820
02070R1=O1
02080PRINT
02090:THE GROUP 2 QUOTA-FREE CRITICAL PROBABILITY IS ##.##
02100PRINT USING 2090,R2
02110PRINT
02120GOSUB 3290
02130R1=1-R1
02140Y(1,1)=1
02150PRINT L$
02160MAT T=ZER
02170T(1,1)=1-C0
02180T(1,2)=-C0
02190T(1,3)=0
02200T(2,3)=R1
02210T(3,1)=S0
02220T(3,2)=S0
02230T(3,3)=-1
02240Y(2,1)=1-R1
02250Y(3,1)=1
02260MAT S=INV(T)
02270MAT X=S*Y
02280R2=1-R2
02282MAT U=CON
02283MAT U=(2)*U
02290U(1)=1
02300U(3)=1
02310U(2)=0
02320U(4)=U(3)-X(3,1)
02330U(5)=1
02340U0=U(I)
02350U(6)=U(5)-X(1,1)
02360U(7)=1
02370U(8)=U(7)-X(2,1)
02380M0=U(1)
02390U0=U(1)
02400FOR I=2 TO 8
02410IF U(I)>M0 THEN 2430
02420M0=U(I)
02430IF U(I)<U0 THEN 2450
02440U0=U(I)
02450NEXT I
02460FOR I=1 TO 8
02470U(I)=(U(I)-M0)/(U0-M0)
02480NEXT I
02490PRINT "HERE ARE THE FITTED UTILITY STRUCTURES."
02500PRINT
02510PRINT " GROUP 1 GROUP 2"
02520:A = ACCEPTED AND SUCCESSFUL ##.## ##.##
02530PRINT USING 2520,U(1),U(5)
02540:B = REJECTED, WOULD HAVE SUCCEEDED ##.## ##.##
02550PRINT USING 2540,U(2),U(6)
02560:C = REJECTED, WOULD HAVE FAILED ##.## ##.##
02570PRINT USING 2560,U(3),U(7)
02580:D = ACCEPTED BUT FAILS ##.## ##.##
02590PRINT USING 2580,U(4),U(8)
02600PRINT
02610GOTO 2710
02620PRINT "THE FOLLOWING UTILITIES WERE ARBITRARILY ASSIGNED:"
02630PRINT " A (GROUP 1) = A (GROUP 2) = 1"
02640PRINT " D (GROUP 1) = D (GROUP 2) =-1"
02650PRINT " B (GROUP 1) = 0"
02660PRINT
02670:GROUP ## QUOTA-FREE CRITICAL PROBABILITY =##.##
02680PRINT USING 2670,1,1-R1
02690PRINT USING 2670,2,1-R2
02700PRINT
02710PRINT "IF YOU WANT TO FIND THE CUT SCORES TYPE '1', ELSE '0'.";
02720GOSUB 9000
02730IF O1=0 THEN 2780
02740SCRATCH#3
02741 PRINT # 3,1
02750 FOR I=1 TO 8
02752 PRINT#3,U(I)
02753 NEXT I
02770CHAIN "CMOD92"
02780CHAIN "RSTRT"
02800PRINT "REENTER. MUST BE BETWEEN 0 AND 1."
02810GOTO 2000
02820PRINT "REENTER. IMPLIED CRITICAL PROBABILITY FOR GROUP 2 IS OUTSIDE"
02830PRINT "0 TO 1 INTERVAL."
02840GOTO 2000
02870PRINT L$
02880GOSUB 1610
02890IF S9=1 THEN 2940
02900S9=1
02910PRINT "NOTE THAT THE PROBABILITES OF SUCCESS FOR THE TWO GROUPS ARE"
02920PRINT "LINEARLY RELATED. TWO PAIRS ARE SUFFICIENT FOR DETERMINING"
02930PRINT "THE INDIFFERENCE PROBABILITIES."
02940PRINT
02950PRINT "SPECIFY ANY TWO PAIRS BY INPUTTING THE NUMBER OF THE PAIR"
02960PRINT "AND THE PROBABILITY OF SUCCESS FOR THE GROUP 2 APPLICANT."
02970PRINT
02980FOR I=1 TO 2
02990PRINT "INPUT PAIR NUMBER AND PROBABILITY ";
03000GOSUB 9050
03010O1=INT(O1)
03020IF O1 >= 1 THEN 3050
03030PRINT "REENTER. MUST BE NUMBER OF PAIR."
03040GOTO 3000
03050IF O1>K3 THEN 3030
03060IF O2 <= 1 THEN 3090
03070PRINT "REENTER. PROBABILITY MUST BE BETWEEN .00 AND 1.00 INCLUSIVE."
03080GOTO 3000
03090IF O2<0 THEN 3070
03100IF I=2 THEN 3140
03110Y0=1-O2
03120X0=1-P(O1)
03130GOTO 3160
03140Y0=Y0-(1-O2)
03150X0=X0-(1-P(O1))
03160NEXT I
03170S0=Y0/X0
03180C0=1-O2-S0*(1-P(O1))
03190PRINT L$
03200GOTO 1590
03210PRINT L$
03220R1=P5
03230U1=1/(1-P5)
03240PRINT L$
03250PRINT "PLEASE REPEAT THE ASSESSMENT TASK ASSUMING THE APPLICANTS"
03260PRINT "ARE FROM GROUP 2."
03270G7=2
03280GOTO 580
03290PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
03300GOSUB 9000
03310RETURN
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09005INPUT O1
09015IF O1=-9999 THEN 9025
09020RETURN
09025CHAIN "RSTRT"
09035REM*************END ROUTINE
09050REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED. 2 INPUTS
09055INPUT O1,O2
09065IF O1=-9999 THEN 9080
09070IF O2=-9999 THEN 9080
09075RETURN
09080CHAIN "RSTRT"
09090REM*************END ROUTINE
09999 END