# Additional file 3 R code for Bias and MSE

# Supplementary Materials for 
# "Homogeneity score test of AC1 statistics and estimation of common AC1 in multiple or stratified inter-rater agreement studies" 
# by Chikara Honda and Tetsuji Ohyama.

#You do not need to change the current directory of your PC to run programs.

############## Table 4 Calculation of Bias an Mean square error #####################################

rm(list=ls())

AC1_sim <- function(mydata) {
  
  n1 <- mydata[1, ]
  n2 <- mydata[2, ]
  n3 <- mydata[3, ]
  n  <- colSums(mydata)

  ########H0########
  ### MLE under H0
  # initial value

  pi_0  <- (2 * n1 + n2) / (2 * n)
  p_min <- max(abs(pi_0 - 0.5)) # Choose a value farther than 0.5
  x     <- 0.5 - p_min
  ac1_L <- (1 - 2 * x * (2 - x)) / (1 - 2 * x * (1 - x))
  ac1_0 <- mean(1 - 2 * n * n2 / (n^2 + (n1 - n3)^2))  #The lower limit is taken when the average is taken below the lower limit
  ac1_0 <- ifelse(ac1_0 <= ac1_L, ac1_L + 0.01, ac1_0)
  
  # loglikelihood function under H0
  logL_0   <- function(x) { # x=(ac1,pi1,...,piK)
    ac1    <- x[1]
    pi_vec <- x[-1]
    P1_0   <- pi_vec * (2 - pi_vec) - 0.5 + ac1 / 2 * (1- 2 * pi_vec * (1 - pi_vec))
    P2_0   <- (1- 2 * pi_vec * (1-pi_vec)) * (1 - ac1)
    P3_0   <- 1 - P1_0 - P2_0
    l_0    <- sum(n1 * log(P1_0) + n2 * log(P2_0) + n3 * log(P3_0))
    return(l_0)
  }
  
  #MLE under H0
  opt_0  <- optim(c(ac1_0, pi_0), logL_0, control = list(fnscale = -1), hessian = TRUE)
  mle_0  <- opt_0$par
  AC1h0  <- mle_0[1] 
  Pih0   <- mle_0[-1]
  AC1s   <- c(AC1h0)
  return(AC1s)
}
 
#=========== Monte Carlo simulations of Bias an Mean square error =======================

ac1   <- c()  
pik   <- c()  # pik:pi of each stratum
nk    <- c()  # nk: number of each stratum
nsim  <- c()  # number of simulations 

test_bias_mse <- function(ac1, pik, nk, nsim) {
  K   <- length(nk)
  P1k <- pik * (2 - pik) - 0.5 + ac1 / 2 * (1- 2 * pik * (1 - pik))
  P2k <- (1- 2 * pik * (1-pik)) * (1 - ac1)
  P3k <- 1 - P1k - P2k
  
  # data generation
  simdata <- array(0, dim = c(3, nsim, K))
  for (k in 1 : K) {
    set.seed(116 + k)
    simdata[ , , k] <- rmultinom(nsim, size = nk[k], prob = c(P1k[k], P2k[k], P3k[k]))
    }

  # 0 cell adjust
  result <- c()
  for (i in 1 : nsim) {
    mydata <- simdata[ , i, ]
    for (k in 1 : K) {
      if (sum(mydata[ , k] == 0) > 0) {
        mydata[ , k] <- mydata[ , k] + 0.5
      } else {
        mydata[ , k] <- mydata[ , k]
      }
    }
    result <- rbind(result, AC1_sim(mydata))
  }
  diffi <- (result - ac1)
  biasAC1 <- sum(diffi[,1])/nsim
  mseAC1 <- sum(diffi[,1]^2)/nsim
  bias_mse <-c(biasAC1,mseAC1)
  return(bias_mse)
}



### simulation of Table 4

#sim_coverage(ac1, pik, nk, nsim)                 	#	Bias       MSE
test_bias_mse(0.1, c(0.5, 0.5), c(20, 20), 10000) 	#	0.02615185 0.02545897
test_bias_mse(0.3, c(0.5, 0.5), c(20, 20), 10000) 	#	0.02332011 0.02287945
test_bias_mse(0.5, c(0.5, 0.5), c(20, 20), 10000) 	#	0.01653796 0.01828834
test_bias_mse(0.7, c(0.5, 0.5), c(20, 20), 10000) 	#	0.009176351 0.011673593
test_bias_mse(0.9, c(0.5, 0.5), c(20, 20), 10000) 	#	-0.011450612  0.003202926
test_bias_mse(0.1, c(0.35, 0.35), c(20, 20), 10000) #	0.009216269 0.028971822
test_bias_mse(0.3, c(0.35, 0.35), c(20, 20), 10000) #	0.007116155 0.024950821
test_bias_mse(0.5, c(0.35, 0.35), c(20, 20), 10000) #	0.006942286 0.019192281
test_bias_mse(0.7, c(0.35, 0.35), c(20, 20), 10000) #	0.004390896 0.012024498
test_bias_mse(0.9, c(0.35, 0.35), c(20, 20), 10000) #	-0.011075893  0.003291967
test_bias_mse(0.7, c(0.2, 0.2), c(20, 20), 10000) 	#	-0.007286192  0.011935499
test_bias_mse(0.9, c(0.2, 0.2), c(20, 20), 10000) 	#	-0.009820602  0.003228955

test_bias_mse(0.1, c(0.5, 0.5), c(80, 80), 10000) 	#	0.006976768 0.006249432
test_bias_mse(0.3, c(0.5, 0.5), c(80, 80), 10000) 	#	0.006184028 0.005700535
test_bias_mse(0.5, c(0.5, 0.5), c(80, 80), 10000) 	#	0.005457619 0.004709850
test_bias_mse(0.7, c(0.5, 0.5), c(80, 80), 10000) 	#	0.003401485 0.003124680
test_bias_mse(0.9, c(0.5, 0.5), c(80, 80), 10000) 	#	0.001502887 0.001140993
test_bias_mse(0.1, c(0.35, 0.35), c(80, 80), 10000)	#	0.003520660 0.007452765
test_bias_mse(0.3, c(0.35, 0.35), c(80, 80), 10000)	#	0.001658038 0.006406444
test_bias_mse(0.5, c(0.35, 0.35), c(80, 80), 10000)	#	0.001408355 0.004973305
test_bias_mse(0.7, c(0.35, 0.35), c(80, 80), 10000)	#	0.0009939071 0.0031916234
test_bias_mse(0.9, c(0.35, 0.35), c(80, 80), 10000) #	0.0002069183 0.0011048038
test_bias_mse(0.7, c(0.2, 0.2), c(80, 80), 10000) 	#	-0.001229233  0.003006185
test_bias_mse(0.9, c(0.2, 0.2), c(80, 80), 10000) 	#	-0.000505645  0.000953535

test_bias_mse(0.1, c(0.5, 0.35), c(20, 20), 10000) 	#	0.01918905 0.02689491
test_bias_mse(0.3, c(0.5, 0.35), c(20, 20), 10000) 	#	0.01827945 0.02398721
test_bias_mse(0.5, c(0.5, 0.35), c(20, 20), 10000) 	#	0.01276066 0.01867856
test_bias_mse(0.7, c(0.5, 0.35), c(20, 20), 10000) 	#	0.007275454 0.011798202
test_bias_mse(0.9, c(0.5, 0.35), c(20, 20), 10000) 	#	-0.010943495  0.003236689
test_bias_mse(0.1, c(0.65, 0.35), c(20, 20), 10000) #	0.01034624 0.02843609
test_bias_mse(0.3, c(0.65, 0.35), c(20, 20), 10000) #	0.01146876 0.02491980
test_bias_mse(0.5, c(0.65, 0.35), c(20, 20), 10000) #	0.008284136 0.019162186
test_bias_mse(0.7, c(0.65, 0.35), c(20, 20), 10000) #	0.003980063 0.011818041
test_bias_mse(0.9, c(0.65, 0.35), c(20, 20), 10000) #	-0.011166629  0.003276043
test_bias_mse(0.7, c(0.5, 0.2), c(20, 20), 10000) 	#	0.001164104 0.011686840
test_bias_mse(0.9, c(0.5, 0.2), c(20, 20), 10000) 	#	-0.010371683  0.003248047

test_bias_mse(0.1, c(0.5, 0.35), c(80, 80), 10000) 	#	0.006141716 0.006827596
test_bias_mse(0.3, c(0.5, 0.35), c(80, 80), 10000) 	#	0.004956212 0.005969843
test_bias_mse(0.5, c(0.5, 0.35), c(80, 80), 10000) 	#	0.003549090 0.004877693
test_bias_mse(0.7, c(0.5, 0.35), c(80, 80), 10000) 	#	0.002579257 0.003158763
test_bias_mse(0.9, c(0.5, 0.35), c(80, 80), 10000) 	#	0.001047584 0.001109066
test_bias_mse(0.1, c(0.65, 0.35), c(80, 80), 10000) #	0.002747452 0.007697831
test_bias_mse(0.3, c(0.65, 0.35), c(80, 80), 10000) #	0.0009277333 0.0064512378
test_bias_mse(0.5, c(0.65, 0.35), c(80, 80), 10000) #	0.002062774 0.004953395
test_bias_mse(0.7, c(0.65, 0.35), c(80, 80), 10000) #	0.001492395 0.003145325
test_bias_mse(0.9, c(0.65, 0.35), c(80, 80), 10000) #	0.0004799105 0.0011114418
test_bias_mse(0.7, c(0.5, 0.2), c(80, 80), 10000) 	#	0.001410464 0.003042354
test_bias_mse(0.9, c(0.5, 0.2), c(80, 80), 10000) 	#	0.0006106856 0.0010301761


## n=50 (not printed simulations)

#test_bias_mse(0.1, c(0.5, 0.5), c(50, 50), 10000) 	  #	0.01104671 0.01002344
#test_bias_mse(0.3, c(0.5, 0.5), c(50, 50), 10000) 	  #	0.009900684 0.009159702
#test_bias_mse(0.5, c(0.5, 0.5), c(50, 50), 10000) 	  #	0.006619459 0.007480151
#test_bias_mse(0.7, c(0.5, 0.5), c(50, 50), 10000) 	  #	0.004398639 0.005020686
#test_bias_mse(0.9, c(0.5, 0.5), c(50, 50), 10000) 	  #	-5.446858e-05  1.717828e-03
#test_bias_mse(0.1, c(0.35, 0.35), c(50, 50), 10000) 	#	0.003719602 0.012045234
#test_bias_mse(0.3, c(0.35, 0.35), c(50, 50), 10000) 	#	0.002432394 0.010293476
#test_bias_mse(0.5, c(0.35, 0.35), c(50, 50), 10000) 	#	0.002613018 0.007912146
#test_bias_mse(0.7, c(0.35, 0.35), c(50, 50), 10000) 	#	0.001950007 0.005047104
#test_bias_mse(0.9, c(0.35, 0.35), c(50, 50), 10000) 	#	-0.000580775  0.001672229
#test_bias_mse(0.7, c(0.2, 0.2), c(50, 50), 10000) 	  #	-0.001794134  0.004819979
#test_bias_mse(0.9, c(0.2, 0.2), c(50, 50), 10000) 	  #	-0.0009831799  0.0015005808

#test_bias_mse(0.1, c(0.5, 0.35), c(50, 50), 10000) 	  #	0.008465638 0.010875348
#test_bias_mse(0.3, c(0.5, 0.35), c(50, 50), 10000) 	  #	0.008137088 0.009716963
#test_bias_mse(0.5, c(0.5, 0.35), c(50, 50), 10000) 	  #	0.005164886 0.007677286
#test_bias_mse(0.7, c(0.5, 0.35), c(50, 50), 10000) 	  #	0.003520856 0.005038766
#test_bias_mse(0.9, c(0.5, 0.35), c(50, 50), 10000) 	  #	-0.000229518  0.001701716
#test_bias_mse(0.1, c(0.65, 0.35), c(50, 50), 10000) 	#	0.004409092 0.011848882
#test_bias_mse(0.3, c(0.65, 0.35), c(50, 50), 10000) 	#	0.005390172 0.010222162
#test_bias_mse(0.5, c(0.65, 0.35), c(50, 50), 10000) 	#	0.003278624 0.007883378
#test_bias_mse(0.7, c(0.65, 0.35), c(50, 50), 10000) 	#	0.001432190 0.004990426
#test_bias_mse(0.9, c(0.65, 0.35), c(50, 50), 10000) 	#	-0.0007604603  0.0016605434
#test_bias_mse(0.7, c(0.5, 0.2), c(50, 50), 10000) 	  #  0.001644446 0.004888081
#test_bias_mse(0.9, c(0.5, 0.2), c(50, 50), 10000) 	  # -0.0004268514  0.0016042249