############################################################################# ## This file contains the programs that generate Tables 13, 14, 16 and 17 ## ############################################################################# ######################################################## ## Program "table13" generates Table 13. ## ## The program calcualtes the percentage of the time ## ## a fair test fails the four-fifths rule ## ######################################################## table13 = function(n, N, W,H,B,g, K) { ## n = total number of passes, N = total number of test-takers ## W, H, B are the number of white, Hispanic and black test-takers ## Assuming that the scores are N(0,1) ## g = the number of available positions, r=g+2 ## K = number of simulation runs r=g+2 ## top g+2 positions for potential promotion AIR=0 ## Pass rate AIRtop=0 ## Top g+2 rate ## cut-off score for passing tau=qnorm(1-n/N) for (i in 1:K) { scoreW=rnorm(W) scoreH=rnorm(H) scoreB=rnorm(B) score=c(scoreW,scoreH,scoreB) race=c(rep("W",W),rep("H", H),rep("B", B)) PW=sum(scoreW > tau)/W ## percentage of whites passed PH=sum(scoreH > tau)/H ## percentage of Hispanic passed PB=sum(scoreB > tau)/B ## percentage of Black passed p=c(PW, PH,PB) ## passing rates for Whites, Hispanic and Blacks ## % that the passing rate of a fair test violates the 4/5 rule ## pass = {score >= 70} if (min(p)/max(p) < 0.8) { AIR=AIR+1 } sortindex=sort(score,decreasing=T,index=T)\$ix ## index of sorted scores ### Find the top r=g+2 scorers topr=sortindex[1:r] scoretop=score[topr] racetop=race[topr] ## Get P(Top g+2), i.e. top g+2 rates topW=sum(as.numeric(racetop=="W"))/W topH=sum(as.numeric(racetop=="H"))/H topB=sum(as.numeric(racetop=="B"))/B top=c(topW,topH,topB) ## % that top g+2 rate of a FAIR test violates the 4/5 rule, ## topr = {in the top r=g+2 group} ## Note that the top g+2 position, 2-year period is also claculated here ## Just change the g input. if(min(top)/max(top) < 0.8) { AIRtop=AIRtop+1 } } ## end of i loop AIR=AIR/K AIRtop=AIRtop/K result=list(PassRate=AIR, "Top g+2 Rate"=AIRtop) return(result) } ################################################################### ## Program "table14" generates Table 14 ## ## The program simulates the % of times that a fair test passes ## ## the four-fifths rule, for given W, H, B and g positions ## ## Assume that scores follow normal distributions ## ################################################################### table14=function(B, H, W, g, N) { ## B= # of black test-takers ## H= # of Hispanic test-takers ## W = # of white test takers ## g = number of available positions ## N= number of simulations, N=10^4 r=g+2 ratio1=0 ## % of times that 4-5 rule fails, using test scores ratio2=0 ## % of times that 4-5 rule fails, random selection race=c(rep("Black", B), rep("Hispanic", H), rep("White", W)) for (i in 1:N) { scoreB=rnorm(B) scoreH=rnorm(H) scoreW=rnorm(W) score=c(scoreB, scoreH, scoreW) ## First simulation: using the test scores toprindex=sort(score,index.return=TRUE,decreasing=TRUE)\$ix[1:r] rateB=sum(race[toprindex]=="Black")/B rateH=sum(race[toprindex]=="Hispanic")/H rateW=sum(race[toprindex]=="White")/W if( min(rateB,rateH,rateW)/max(rateB,rateH,rateW) < 0.8) { ratio1=ratio1+1 } ## Second simulation: directly do the random selection topr=sample(race, size=r, replace=FALSE) rateB2=sum(topr=="Black")/B rateH2=sum(topr=="Hispanic")/H rateW2=sum(topr=="White")/W if( min(rateB2,rateH2,rateW2)/max(rateB2,rateH2,rateW2) < 0.8) { ratio2=ratio2+1 } } ## end of the i loop ratio1=ratio1/N ratio2=ratio2/N result=list("Test Score Selection" =ratio1, "Random Selection"=ratio2) return(result) } ############################################################## ## Program "table16" generates Tables 16 and 17. ## ## The program compares the consistency between the ## ## four-fifths rule and the FFH test for given B, H, W and ## ## top r=g+2, for all possible combinations of selections ## ############################################################## ## B= # of black test-takers ## H= # of Hispanic test-takers ## W = # of white test takers ## g= # of available positions, r = g+2 ## b, h, w are the number of blacks, Hispanics and whites in the top r positions table16=function(B,H,W,g) { r=g+2 count=0 ## # of posible tables cell1=0 ## # of times pvalue<0.05, fail 4/5 cell2=0 ## # of times pvalue >=0.05, fail 4/5 cell3=0 ## # of times pvalue < 0.05, pass 4/5 cell4=0 ## # of times pvalue >= 0.05, pass 4/5 for (b in 0:min(B,r)) { ## Note that r <= B, H, W for (h in 0:min(H,(r-b))) { count=count+1 w=r-b-h ratioB=b/B ratioH=h/H ratioW=w/W R=min(ratioB, ratioH,ratioW)/max(ratioB,ratioH,ratioW) ## Get the p-value for the FFH test x=matrix(c(b,h,r-b-h,B-b,H-h,W-w),nrow=2,byrow=T) p=fisher.test(x)\$p.value if (R < 0.8 & p < 0.05) {cell1=cell1+1} if(R < 0.8 & p >= 0.05) {cell2=cell2+1} if(R >= 0.8 & p < 0.05) {cell3=cell3+1} ## for Captain exam, to get the b and h values when both the ## four-fifths rule is satisfied and the FFH test's p-value >=0.05 #if(R >=0.8 & p >= 0.05) {cell4=cell4+1; out1=b; out2=h} if(R>=0.8 & p >=0.05) {cell4=cell4+1} } ## end of h loop } ## end of b loop result=list(cell1=cell1, cell2=cell2, cell3=cell3, cell4=cell4, "possible Tables"=count) return(result) }