require(car)

#create the balance design that comes closest to the unbalanced design
#total number of observations is equal when unbalanced observations mod 4 = 0
calcbalanced <- function(unbalancedcells=list(c00=2,c10=4,c01=4,c11=2)){
  ub=unlist(unbalancedcells)
  nobs=ub[1]+ub[2]+ub[3]+ub[4]
  ncell=round(nobs/4+0.1)
  balanced=list(c00=ncell,c10=ncell,c01=ncell,c11=ncell)
  return(balanced)
}


#linmod=eff
simulate_unbalanced2x2 <- function (unbalancedcells=list(c00=20,c01=40,c10=40,c11=20),
                                       linmod=list(intercept=53.50,effectA=17.5,effectB=45.75,effectAB=4.25,error=10),
                                       sim=1000, coding="contrast"){
  ## evaluate choices
  coding <- match.arg(coding)
  out=matrix(NA,sim,10)
  dimnames(out) <- list(rownames(out, do.NULL = FALSE, prefix = ""),
                        colnames(out, do.NULL = FALSE, prefix = ""))
  balancedcells=calcbalanced(unbalancedcells)
  Ab=c(rep(-1,balancedcells$c00),rep(-1,balancedcells$c01),
       rep(1,balancedcells$c10),rep(1,balancedcells$c11))
  Bb=c(rep(-1,balancedcells$c00),rep(1,balancedcells$c01),
       rep(-1,balancedcells$c10),rep(1,balancedcells$c11))
  Au=c(rep(-1,unbalancedcells$c00),rep(-1,unbalancedcells$c01),
       rep(1,unbalancedcells$c10),rep(1,unbalancedcells$c11))
  Bu=c(rep(-1,unbalancedcells$c00),rep(1,unbalancedcells$c01),
       rep(-1,unbalancedcells$c10),rep(1,unbalancedcells$c11))

  for (i in (1:sim)){
    #create a sample of sufficient size to provide for both the balanced and the unbalanced subsample
    Y00=linmod$intercept+.5*linmod$effectA*-1+.5*linmod$effectB*-1+.5*linmod$effectAB*1+
      rnorm(max(unbalancedcells$c00,balancedcells$c00),sd=linmod$error)
    Y01=linmod$intercept+.5*linmod$effectA*-1+.5*linmod$effectB*1+.5*linmod$effectAB*-1+
      rnorm(max(unbalancedcells$c01,balancedcells$c01),sd=linmod$error)
    Y10=linmod$intercept+.5*linmod$effectA*1+.5*linmod$effectB*-1+.5*linmod$effectAB*-1+
      rnorm(max(unbalancedcells$c10,balancedcells$c10),sd=linmod$error)
    Y11=linmod$intercept+.5*linmod$effectA*1+.5*linmod$effectB*1+.5*linmod$effectAB*1+
      rnorm(max(unbalancedcells$c11,balancedcells$c11),sd=linmod$error)
    
  
    #balanced, selected from this sample
    Y00b=sample(Y00,balancedcells$c00)           
    Y01b=sample(Y01,balancedcells$c01)  
    Y10b=sample(Y10,balancedcells$c10)  
    Y11b=sample(Y11,balancedcells$c11)            
    Yb=c(Y00b,Y01b,Y10b,Y11b)
    #cbind(Ab,Bb,Yb)  # check generated data
    #tapply( Yb, list(Ab, Bb), mean ) # check cell means, comparable to available sample
    #unbalanced, selected from the same sample
    Y00u=sample(Y00,unbalancedcells$c00)           
    Y01u=sample(Y01,unbalancedcells$c01)  
    Y10u=sample(Y10,unbalancedcells$c10)  
    Y11u=sample(Y11,unbalancedcells$c11)            
    Yu=c(Y00u,Y01u,Y10u,Y11u)
    #cbind(Au,Bu,Yu)                   # check generated data
    #tapply( Yu, list(Su, Tu), mean ) # check cell means
    # check linmod # summary(lm(Yb~Ab*Bb)) 
    # check model # model.matrix(Yb~Ab*Bb)
    
    out[i,1] = cor(Au, Bu)
    ab.r = anova(lm(Yb~Ab*Bb)) 
    au2.r = Anova(lm(Yu~Au*Bu), type=2)
    au3.r = Anova(lm(Yu~Au*Bu), type=3)
 
    out[i,2:4]=ab.r$"Pr(>F)"[1:3] < .05  #rejection of H0 for effect of A, B and AB, given alpha = .05
    out[i,5:7]=au2.r$"Pr(>F)"[1:3] < .05 #rejection of H0 for A, B and AB (SS type II), given alpha = .05
    out[i,8:10]=au3.r$"Pr(>F)"[2:4] < .05 #rejection of H0 for B(SS type I) and A(SS type II), given alpha = .05, using SS type 1
  }
  colnames(out) <- c("rAB","effAb1", "effBb1", "effABb1","effAu2", "effBu2", "effABu2", "effAu3", "effBu3", "effABu3")
  invisible(out)
}

#system.time(simulate_unbalanced2x2()) #test