#############################################################################
## 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)
}