##Contents
#1. ciMANA
#2. ciMANA2
#3. ciMANA3
#4. ciJack
#5. ciJack2
#6. ciJack3

##1. Bootstrap models: simple CI
#bias is raw observed variance components: c(add,nonadd,mater,tot)
#accel is the jackknife object
ciMANA<- function(comp,level=95,rnd_r=3,rnd_p=1,bias=NULL,accel=NULL,trait=NULL) {
  cia<- (100-level)/100/2
#find columns
  mater<- grep("maternal", colnames(comp))
  add<- grep("additive", colnames(comp))
  nonadd<- grep("nonadd", colnames(comp))
#convert to percentage
  comp$p_mat<- 100*comp[,mater]/comp$Total
  comp$p_add<- 100*comp[,add]/comp$Total
  comp$p_na<- 100*comp[,nonadd]/comp$Total
#bias correction
if (!is.null(bias)) {
  z0_mat <- qnorm(mean(comp[,mater] < bias[3]))
  z0_add <- qnorm(mean(comp[,add] < bias[1]))
  z0_na <- qnorm(mean(comp[,nonadd] < bias[2])) }
#acceleration correction
if (is.null(accel)) { a_mat<- 0; a_add<- 0; a_na<- 0 }
if (!is.null(accel)) {
#find columns
  mater2<- grep("maternal", colnames(accel))
  add2<- grep("additive", colnames(accel))
  nonadd2<- grep("nonadd", colnames(accel))
#acceleration correction
  a_mat <- sum((bias[3]-accel[,mater2])^3)/(6*sum((bias[3]-accel[,mater2])^2)^(3/2))
  a_add <- sum((bias[1]-accel[,add2])^3)/(6*sum((bias[1]-accel[,add2])^2)^(3/2))
  a_na <- sum((bias[2]-accel[,nonadd2])^3)/(6*sum((bias[2]-accel[,nonadd2])^2)^(3/2))
} #end acceleration
#CI (un-adjusted), also in case of replacement
  ci<- data.frame(component=c("additive","nonadd","maternal"),
    lower=c(quantile(comp[,add],cia),quantile(comp[,nonadd],cia),quantile(comp[,mater],cia)),
    median= c(quantile(comp[,add],0.5),quantile(comp[,nonadd],0.5),quantile(comp[,mater],0.5)),
    upper= c(quantile(comp[,add],1-cia),quantile(comp[,nonadd],1-cia),quantile(comp[,mater],1-cia)))
  ci<- cbind(ci$component,round(ci[,2:4],rnd_r));colnames(ci)[1]<- "component"
  rownames(ci)<- 1:3
#
  ci_p<- data.frame(component=c("additive","nonadd","maternal"),
    lower=c(quantile(comp$p_add,cia),quantile(comp$p_na,cia),quantile(comp$p_mat,cia)),
    median= c(quantile(comp$p_add,0.5),quantile(comp$p_na,0.5),quantile(comp$p_mat,0.5)),
    upper= c(quantile(comp$p_add,1-cia),quantile(comp$p_na,1-cia),quantile(comp$p_mat,1-cia)))
  ci_p<- cbind(ci_p$component,round(ci_p[,2:4],rnd_p));colnames(ci_p)[1]<- "component"
  rownames(ci_p)<- 1:3
#
if (!is.null(bias)) { #CI (adjusted)
#adjusted quantiles and median
ql_mat <- pnorm(z0_mat+(z0_mat+qnorm(cia))/(1-a_mat*(z0_mat+qnorm(cia))))
ql_add <- pnorm(z0_add+(z0_add+qnorm(cia))/(1-a_add*(z0_add+qnorm(cia))))
ql_na <- pnorm(z0_na+(z0_na+qnorm(cia))/(1-a_na*(z0_na+qnorm(cia))))
md_mat <- pnorm(z0_mat+(z0_mat+qnorm(0.50))/(1-a_mat*(z0_mat+qnorm(0.50))))
md_add <- pnorm(z0_add+(z0_add+qnorm(0.50))/(1-a_add*(z0_add+qnorm(0.50))))
md_na <- pnorm(z0_na+(z0_na+qnorm(0.50))/(1-a_na*(z0_na+qnorm(0.50))))
qu_mat <- pnorm(z0_mat+(z0_mat+qnorm(1-cia))/(1-a_mat*(z0_mat+qnorm(1-cia))))
qu_add <- pnorm(z0_add+(z0_add+qnorm(1-cia))/(1-a_add*(z0_add+qnorm(1-cia))))
qu_na <- pnorm(z0_na+(z0_na+qnorm(1-cia))/(1-a_na*(z0_na+qnorm(1-cia))))
#
  ci2<- data.frame(component=c("additive","nonadd","maternal"),
    lower=c(quantile(comp[,add],ql_add),quantile(comp[,nonadd],ql_na),quantile(comp[,mater],ql_mat)),
    median= c(quantile(comp[,add],md_add),quantile(comp[,nonadd],md_na),quantile(comp[,mater],md_mat)),
    upper= c(quantile(comp[,add],qu_add),quantile(comp[,nonadd],qu_na),quantile(comp[,mater],qu_mat)))
  ci2<- cbind(ci2$component,round(ci2[,2:4],rnd_r));colnames(ci2)[1]<- "component"
  rownames(ci2)<- 1:3
#
  ci2_p<- data.frame(component=c("additive","nonadd","maternal"),
    lower=c(quantile(comp$p_add,ql_add),quantile(comp$p_na,ql_na),quantile(comp$p_mat,ql_mat)),
    median= c(quantile(comp$p_add,md_add),quantile(comp$p_na,md_na),quantile(comp$p_mat,md_mat)),
    upper= c(quantile(comp$p_add,qu_add),quantile(comp$p_na,qu_na),quantile(comp$p_mat,qu_mat)))
  ci2_p<- cbind(ci2_p$component,round(ci2_p[,2:4],rnd_p));colnames(ci2_p)[1]<- "component"
  rownames(ci2_p)<- 1:3
#
if (z0_add == Inf | z0_add == -Inf | z0_na == Inf | z0_na == -Inf | z0_mat == Inf | z0_mat == -Inf)
  { ci2$change<- NA; ci2_p$change<- NA  }
if (z0_add == Inf | z0_add == -Inf) { ci2[1,]<- ci[1,];ci2$change[1] <- "bias fail"
  ci2_p[1,]<- ci_p[1,];ci2_p$change[1] <- "bias fail" }
if (z0_na == Inf | z0_na == -Inf) { ci2[2,]<- ci[2,];ci2$change[2] <- "bias fail"
  ci2_p[2,]<- ci_p[2,];ci2_p$change[2] <- "bias fail" }
if (z0_mat == Inf | z0_mat == -Inf) { ci2[3,]<- ci[3,];ci2$change[3] <- "bias fail"
  ci2_p[3,]<- ci_p[3,];ci2_p$change[3] <- "bias fail" }
} #end ci adjusted
#finish
  if (is.null(trait) == T && is.null(bias)) { ci_obj<- list(raw=ci,percentage=ci_p); return(ci_obj) }
  if (is.null(trait) == T && !is.null(bias)) { ci_obj<- list(raw=ci2,percentage=ci2_p); return(ci_obj) }
  if (is.null(trait) == F && is.null(bias)) { ci$trait<- as.factor(trait); ci_p$trait<- as.factor(trait)
    ci_obj<- list(raw=ci,percentage=ci_p); return(ci_obj) }
  if (is.null(trait) == F && !is.null(bias)) { ci2$trait<- as.factor(trait); ci2_p$trait<- as.factor(trait)
    ci_obj<- list(raw=ci2,percentage=ci2_p); return(ci_obj) }
} #end function

#**************************************************************************************

##2. Bootstrap models: advanced CI
#bias is raw observed variance components: c(add,nonadd,mater,tot)
#accel is the jackknife object
ciMANA2<- function(comp,level=95,rnd_r=3,rnd_p=1,position=NULL,block=NULL,bias=NULL,accel=NULL,trait=NULL) {
  cia<- (100-level)/100/2
#find columns: comp
  mater<- grep("maternal", colnames(comp))
  add<- grep("additive", colnames(comp))
  nonadd<- grep("nonadd", colnames(comp))
  if (!is.null(position)) { pos<- grep(paste(position), colnames(comp)) }
  if (!is.null(block)) { bloc<- grep(paste(block), colnames(comp)) }
#convert to percentage: comp
  comp$p_mat<- 100*comp[,mater]/comp$Total
  comp$p_add<- 100*comp[,add]/comp$Total
  comp$p_na<- 100*comp[,nonadd]/comp$Total
  if (!is.null(position)) { comp$p_pos<- 100*comp[,pos]/comp$Total }
  if (!is.null(block)) { comp$p_bloc<- 100*comp[,bloc]/comp$Total }
#bias correction: comp and bias
if (!is.null(bias)) {
  z0_mat <- qnorm(mean(comp[,mater] < bias[3]))
  z0_add <- qnorm(mean(comp[,add] < bias[1]))
  z0_na <- qnorm(mean(comp[,nonadd] < bias[2]))
  if (!is.null(position)) { z0_pos <- qnorm(mean(comp[,pos] < bias[4])) }
  if (!is.null(block)) { z0_bloc <- qnorm(mean(comp[,bloc] < bias[5])) }  } #end
#acceleration correction: accel
if (is.null(accel)) { a_mat<- 0; a_add<- 0; a_na<- 0; a_pos<- 0; a_bloc<-0 }
if (!is.null(accel)) {
#find columns: accel
  mater2<- grep("maternal", colnames(accel))
  add2<- grep("additive", colnames(accel))
  nonadd2<- grep("nonadd", colnames(accel))
  if (!is.null(position)) { pos2<- grep(paste(position), colnames(accel)) }
  if (!is.null(block)) { bloc2<- grep(paste(block), colnames(accel)) }
#acceleration correction
  a_mat <- sum((bias[3]-accel[,mater2])^3)/(6*sum((bias[3]-accel[,mater2])^2)^(3/2))
  a_add <- sum((bias[1]-accel[,add2])^3)/(6*sum((bias[1]-accel[,add2])^2)^(3/2))
  a_na <- sum((bias[2]-accel[,nonadd2])^3)/(6*sum((bias[2]-accel[,nonadd2])^2)^(3/2))
  if (!is.null(position)) { a_pos <- sum((bias[4]-accel[,pos2])^3)/(6*sum((bias[4]-accel[,pos2])^2)^(3/2)) }
  if (!is.null(block)) { a_bloc <- sum((bias[5]-accel[,bloc2])^3)/(6*sum((bias[5]-accel[,bloc2])^2)^(3/2)) }
} #end acceleration
#CI (un-adjusted), also in case of replacement
  ci<- data.frame(component=c("additive","nonadd","maternal"),
    lower=c(quantile(comp[,add],cia),quantile(comp[,nonadd],cia),quantile(comp[,mater],cia)),
    median= c(quantile(comp[,add],0.5),quantile(comp[,nonadd],0.5),quantile(comp[,mater],0.5)),
    upper= c(quantile(comp[,add],1-cia),quantile(comp[,nonadd],1-cia),quantile(comp[,mater],1-cia)))
  rownames(ci)<- 1:3; ci$component<- as.character(ci$component)
#
  ci_p<- data.frame(component=c("additive","nonadd","maternal"),
    lower=c(quantile(comp$p_add,cia),quantile(comp$p_na,cia),quantile(comp$p_mat,cia)),
    median= c(quantile(comp$p_add,0.5),quantile(comp$p_na,0.5),quantile(comp$p_mat,0.5)),
    upper= c(quantile(comp$p_add,1-cia),quantile(comp$p_na,1-cia),quantile(comp$p_mat,1-cia)))
  rownames(ci_p)<- 1:3; ci_p$component<- as.character(ci_p$component)
#Conditions
 if (!is.null(position) && is.null(block)) {
  ci<- rbind(ci,c(paste(position),quantile(comp[,pos],cia),quantile(comp[,pos],0.5),quantile(comp[,pos],1-cia)))
  ci_p<- rbind(ci_p,c(paste(position),quantile(comp$p_pos,cia),quantile(comp$p_pos,0.5),quantile(comp$p_pos,1-cia))) }
 if (is.null(position) && !is.null(block)) {
  ci<- rbind(ci,c(paste(block),quantile(comp[,bloc],cia),quantile(comp[,bloc],0.5),quantile(comp[,bloc],1-cia)))
  ci_p<- rbind(ci_p,c(paste(block),quantile(comp$p_bloc,cia),quantile(comp$p_bloc,0.5),quantile(comp$p_bloc,1-cia))) }
 if (!is.null(position) && !is.null(block)) {
  ci<- rbind(ci,c(paste(position),quantile(comp[,pos],cia),quantile(comp[,pos],0.5),quantile(comp[,pos],1-cia)))
  ci<- rbind(ci,c(paste(block),quantile(comp[,bloc],cia),quantile(comp[,bloc],0.5),quantile(comp[,bloc],1-cia)))
  ci_p<- rbind(ci_p,c(paste(position),quantile(comp$p_pos,cia),quantile(comp$p_pos,0.5),quantile(comp$p_pos,1-cia)))
  ci_p<- rbind(ci_p,c(paste(block),quantile(comp$p_bloc,cia),quantile(comp$p_bloc,0.5),quantile(comp$p_bloc,1-cia))) }
#rounding, numeric issue
ci[,2:4]<- round(as.numeric(as.matrix(ci[,2:4])),rnd_r)
ci_p[,2:4]<- round(as.numeric(as.matrix(ci_p[,2:4])),rnd_p)
#CI (adjusted)
if (!is.null(bias)) {
#adjusted quantiles and median
ql_mat <- pnorm(z0_mat+(z0_mat+qnorm(cia))/(1-a_mat*(z0_mat+qnorm(cia))))
ql_add <- pnorm(z0_add+(z0_add+qnorm(cia))/(1-a_add*(z0_add+qnorm(cia))))
ql_na <- pnorm(z0_na+(z0_na+qnorm(cia))/(1-a_na*(z0_na+qnorm(cia))))
md_mat <- pnorm(z0_mat+(z0_mat+qnorm(0.50))/(1-a_mat*(z0_mat+qnorm(0.50))))
md_add <- pnorm(z0_add+(z0_add+qnorm(0.50))/(1-a_add*(z0_add+qnorm(0.50))))
md_na <- pnorm(z0_na+(z0_na+qnorm(0.50))/(1-a_na*(z0_na+qnorm(0.50))))
qu_mat <- pnorm(z0_mat+(z0_mat+qnorm(1-cia))/(1-a_mat*(z0_mat+qnorm(1-cia))))
qu_add <- pnorm(z0_add+(z0_add+qnorm(1-cia))/(1-a_add*(z0_add+qnorm(1-cia))))
qu_na <- pnorm(z0_na+(z0_na+qnorm(1-cia))/(1-a_na*(z0_na+qnorm(1-cia))))
#no position and no block
  ci2<- data.frame(component=c("additive","nonadd","maternal"),
    lower=c(quantile(comp[,add],ql_add),quantile(comp[,nonadd],ql_na),quantile(comp[,mater],ql_mat)),
    median= c(quantile(comp[,add],md_add),quantile(comp[,nonadd],md_na),quantile(comp[,mater],md_mat)),
    upper= c(quantile(comp[,add],qu_add),quantile(comp[,nonadd],qu_na),quantile(comp[,mater],qu_mat)))
  rownames(ci2)<- 1:3; ci2$component<- as.character(ci2$component)
#
  ci2_p<- data.frame(component=c("additive","nonadd","maternal"),
    lower=c(quantile(comp$p_add,ql_add),quantile(comp$p_na,ql_na),quantile(comp$p_mat,ql_mat)),
    median= c(quantile(comp$p_add,md_add),quantile(comp$p_na,md_na),quantile(comp$p_mat,md_mat)),
    upper= c(quantile(comp$p_add,qu_add),quantile(comp$p_na,qu_na),quantile(comp$p_mat,qu_mat)))
  rownames(ci2_p)<- 1:3; ci2_p$component<- as.character(ci2_p$component)
#conditions
 if (!is.null(position) && is.null(block)) {
  ql_pos <- pnorm(z0_pos+(z0_pos+qnorm(cia))/(1-a_pos*(z0_pos+qnorm(cia))))
  md_pos <- pnorm(z0_pos+(z0_pos+qnorm(0.50))/(1-a_pos*(z0_pos+qnorm(0.50))))
  qu_pos <- pnorm(z0_pos+(z0_pos+qnorm(1-cia))/(1-a_pos*(z0_pos+qnorm(1-cia))))
  ci2<- rbind(ci2,c(paste(position),quantile(comp[,pos],ql_pos),quantile(comp[,pos],md_pos),quantile(comp[,pos],qu_pos)))
  ci2_p<- rbind(ci2_p,c(paste(position),quantile(comp$p_pos,ql_pos),quantile(comp$p_pos,md_pos),quantile(comp$p_pos,qu_pos))) }
 if (is.null(position) && !is.null(block)) {
  ql_bloc <- pnorm(z0_bloc+(z0_bloc+qnorm(cia))/(1-a_bloc*(z0_bloc+qnorm(cia))))
  md_bloc <- pnorm(z0_bloc+(z0_bloc+qnorm(0.50))/(1-a_bloc*(z0_bloc+qnorm(0.50))))
  qu_bloc <- pnorm(z0_bloc+(z0_bloc+qnorm(1-cia))/(1-a_bloc*(z0_bloc+qnorm(1-cia))))
  ci2<- rbind(ci2,c(paste(block),quantile(comp[,bloc],ql_pos),quantile(comp[,bloc],md_pos),quantile(comp[,bloc],qu_pos)))
  ci2_p<- rbind(ci2_p,c(paste(block),quantile(comp$p_bloc,ql_bloc),quantile(comp$p_bloc,md_bloc),quantile(comp$p_bloc,qu_bloc))) }
 if (!is.null(position) && !is.null(block)) {
  ql_pos <- pnorm(z0_pos+(z0_pos+qnorm(cia))/(1-a_pos*(z0_pos+qnorm(cia))))
  md_pos <- pnorm(z0_pos+(z0_pos+qnorm(0.50))/(1-a_pos*(z0_pos+qnorm(0.50))))
  qu_pos <- pnorm(z0_pos+(z0_pos+qnorm(1-cia))/(1-a_pos*(z0_pos+qnorm(1-cia))))
  ql_bloc <- pnorm(z0_bloc+(z0_bloc+qnorm(cia))/(1-a_bloc*(z0_bloc+qnorm(cia))))
  md_bloc <- pnorm(z0_bloc+(z0_bloc+qnorm(0.50))/(1-a_bloc*(z0_bloc+qnorm(0.50))))
  qu_bloc <- pnorm(z0_bloc+(z0_bloc+qnorm(1-cia))/(1-a_bloc*(z0_bloc+qnorm(1-cia))))
  ci2<- rbind(ci2,c(paste(position),quantile(comp[,pos],ql_pos),quantile(comp[,pos],md_pos),quantile(comp[,pos],qu_pos)))
  ci2_p<- rbind(ci2_p,c(paste(position),quantile(comp$p_pos,ql_pos),quantile(comp$p_pos,md_pos),quantile(comp$p_pos,qu_pos)))
  ci2<- rbind(ci2,c(paste(block),quantile(comp[,bloc],ql_pos),quantile(comp[,bloc],md_pos),quantile(comp[,bloc],qu_pos)))
  ci2_p<- rbind(ci2_p,c(paste(block),quantile(comp$p_bloc,ql_bloc),quantile(comp$p_bloc,md_bloc),quantile(comp$p_bloc,qu_bloc))) }
#if replacement needed
if (z0_add == Inf | z0_add == -Inf | z0_na == Inf | z0_na == -Inf | z0_mat == Inf | z0_mat == -Inf)
  { ci2$change<- NA; ci2_p$change<- NA  }
if (!is.null(position) && is.null(block)) {
  if (z0_pos == Inf | z0_pos == -Inf)
  { ci2$change<- NA; ci2_p$change<- NA } }
if (is.null(position) && !is.null(block)) {
  if (z0_bloc == Inf | z0_bloc == -Inf)
  { ci2$change<- NA; ci2_p$change<- NA } }
if (!is.null(position) && !is.null(block)) {
  if (z0_pos == Inf | z0_pos == -Inf | z0_bloc == Inf | z0_bloc == -Inf)
  { ci2$change<- NA; ci2_p$change<- NA } }
#
if (z0_add == Inf | z0_add == -Inf) { ci2[1,]<- ci[1,]; ci2$change[1] <- "bias fail"
  ci2_p[1,]<- ci_p[1,]; ci2_p$change[1] <- "bias fail" }
if (z0_na == Inf | z0_na == -Inf) { ci2[2,]<- ci[2,];ci2$change[2] <- "bias fail"
  ci2_p[2,]<- ci_p[2,]; ci2_p$change[2] <- "bias fail" }
if (z0_mat == Inf | z0_mat == -Inf) { ci2[3,]<- ci[3,];ci2$change[3]<- "bias fail"
  ci2_p[3,]<- ci_p[3,]; ci2_p$change[3] <- "bias fail" }
if (!is.null(position) && is.null(block)) {
  if (z0_pos == Inf | z0_pos == -Inf) { ci2[4,]<- ci[4,];ci2$change[4] <- "bias fail"
   ci2_p[4,]<- ci_p[4,]; ci2_p$change[4] <- "bias fail" } }
if (is.null(position) && !is.null(block)) {
  if (z0_bloc == Inf | z0_bloc == -Inf) { ci2[4,]<- ci[4,];ci2$change[4] <- "bias fail"
   ci2_p[4,]<- ci_p[4,]; ci2_p$change[4] <- "bias fail" } }
if (!is.null(position) && !is.null(block)) {
  if (z0_pos == Inf | z0_pos == -Inf) { ci2[4,]<- ci[4,];ci2$change[4] <- "bias fail"
   ci2_p[4,]<- ci_p[4,]; ci2_p$change[4] <- "bias fail" }
  if (z0_bloc == Inf | z0_bloc == -Inf) { ci2[5,]<- ci[5,];ci2$change[5] <- "bias fail"
   ci2_p[5,]<- ci_p[5,]; ci2_p$change[5] <- "bias fail"  } }
#rounding, numeric issue
ci2[,2:4]<- round(as.numeric(as.matrix(ci2[,2:4])),rnd_r)
ci2_p[,2:4]<- round(as.numeric(as.matrix(ci2_p[,2:4])),rnd_p)
} #end ci adjusted

#finish
  if (is.null(trait) == T && is.null(bias)) { ci_obj<- list(raw=ci,percentage=ci_p); return(ci_obj) }
  if (is.null(trait) == T && !is.null(bias)) { ci_obj<- list(raw=ci2,percentage=ci2_p); return(ci_obj) }
  if (is.null(trait) == F && is.null(bias)) { ci$trait<- as.factor(trait); ci_p$trait<- as.factor(trait)
    ci_obj<- list(raw=ci,percentage=ci_p); return(ci_obj) }
  if (is.null(trait) == F && !is.null(bias)) { ci2$trait<- as.factor(trait); ci2_p$trait<- as.factor(trait)
    ci_obj<- list(raw=ci2,percentage=ci2_p); return(ci_obj) }
} #end function

#**************************************************************************************

##3. Bootstrap models: expert CI
#bias is raw observed variance components: c(add,nonadd,mater,tot)
#accel is the jackknife object
ciMANA3<- function(comp,level=95,rnd_r=3,rnd_p=1,bias=NULL,accel=NULL,remain=NULL,trait=NULL) {
  cia<- (100-level)/100/2
#find columns: comp
  mater<- grep("maternal", colnames(comp))
  add<- grep("additive", colnames(comp))
  nonadd<- grep("nonadd", colnames(comp))
if (!is.null(remain)) {
  play<- matrix(0,ncol=1,nrow=length(remain))  #remaining columns
   for (i in 1:length(remain)) { play[i,]<- grep(paste(remain[i]), colnames(comp)) } }
#convert to percentage: comp
  perc<- matrix(0,ncol=length(remain)+3,nrow=nrow(comp))
  perc[,1]<- 100*comp[,add]/comp$Total
  perc[,2]<- 100*comp[,nonadd]/comp$Total
  perc[,3]<- 100*comp[,mater]/comp$Total
if (!is.null(remain)) {
  for (i in 1:length(remain)) { perc[,(i+3)]<- 100*comp[,play[i,]]/comp$Total } }
#bias correction: comp and bias
if (!is.null(bias)) {
  z0_mat <- qnorm(mean(comp[,mater] < bias[3]))
  z0_add <- qnorm(mean(comp[,add] < bias[1]))
  z0_na <- qnorm(mean(comp[,nonadd] < bias[2]))
if (!is.null(remain)) {
  z0_play<- matrix(0,ncol=1,nrow=length(remain))  #remaining z0
   for (i in 1:length(remain)) { z0_play[i,]<- qnorm(mean(comp[,play[i,]] < bias[3+i])) } }
} #end bias play

#acceleration correction: accel
if (is.null(accel)) { a_mat<- 0; a_add<- 0; a_na<- 0
  if (!is.null(remain)) { a_play<- matrix(0,ncol=1,nrow=length(remain)) } }  #remaining a, all zero
if (!is.null(accel)) {
#find columns: accel
  mater2<- grep("maternal", colnames(accel))
  add2<- grep("additive", colnames(accel))
  nonadd2<- grep("nonadd", colnames(accel))
if (!is.null(remain)) {
  play2<- matrix(0,ncol=1,nrow=length(remain))  #remaining columns
   for (i in 1:length(remain)) { play2[i,]<- grep(paste(remain[i]), colnames(accel)) } }
if (!is.null(remain)) {
  for (i in 1:length(remain)) { accel[,play2[i,]]<- 100*accel[,play2[i,]]/accel$Total } }
#acceleration correction
  a_mat <- sum((bias[3]-accel[,mater2])^3)/(6*sum((bias[3]-accel[,mater2])^2)^(3/2))
  a_add <- sum((bias[1]-accel[,add2])^3)/(6*sum((bias[1]-accel[,add2])^2)^(3/2))
  a_na <- sum((bias[2]-accel[,nonadd2])^3)/(6*sum((bias[2]-accel[,nonadd2])^2)^(3/2))
if (!is.null(remain)) { a_play<- matrix(0,ncol=1,nrow=length(remain))
for (i in 1:length(remain)) {
  a_play[i,]<- sum((bias[3+i]-accel[,play[i,]])^3)/(6*sum((bias[3+i]-accel[,play[i,]])^2)^(3/2)) }
  } #end remain
} #end acceleration

#CI: un-adjusted, also in case of replacement
if (is.null(remain)) { ci<- matrix(0,ncol=4,nrow=3); ci_p<- matrix(0,ncol=4,nrow=3) }
if (!is.null(remain)) { ci<- matrix(0,ncol=4,nrow=3+length(remain)); ci_p<- matrix(0,ncol=4,nrow=3+length(remain)) }
  col_names1<- c("component","lower","median","upper") #know column names
  ci[,1][1:3]<- c("additive","nonadd","maternal") #known labels
  ci_p[,1][1:3]<- c("additive","nonadd","maternal")
#intervals
  ci[,2][1:3]<- c(quantile(comp[,add],cia),quantile(comp[,nonadd],cia),quantile(comp[,mater],cia)) #known lower
  ci[,3][1:3]<- c(quantile(comp[,add],0.5),quantile(comp[,nonadd],0.5),quantile(comp[,mater],0.5))  #known median
  ci[,4][1:3]<- c(quantile(comp[,add],1-cia),quantile(comp[,nonadd],1-cia),quantile(comp[,mater],1-cia)) #known upper
if (!is.null(remain)) { for (i in 1:length(remain)) {
  ci[,1][(3+i)]<- paste(remain[i])
  ci[(3+i),][2:4]<- c(quantile(comp[,play[i,]],cia),quantile(comp[,play[i,]],0.5),quantile(comp[,play[i,]],1-cia)) }  }
#
  ci_p[,2][1:3]<- c(quantile(perc[,1],cia),quantile(perc[,2],cia),quantile(perc[,3],cia)) #known lower
  ci_p[,3][1:3]<- c(quantile(perc[,1],0.5),quantile(perc[,2],0.5),quantile(perc[,3],0.5))  #known median
  ci_p[,4][1:3]<- c(quantile(perc[,1],1-cia),quantile(perc[,2],1-cia),quantile(perc[,3],1-cia)) #known upper
if (!is.null(remain)) { for (i in 1:length(remain)) {
  ci_p[,1][(3+i)]<- paste(remain[i])
  ci_p[(3+i),][2:4]<- c(quantile(perc[,(3+i)],cia),quantile(perc[,(3+i)],0.5),quantile(perc[,(3+i)],1-cia)) }  }

#CI (adjusted) start
if (!is.null(bias)) {
#adjusted quantiles and median
ql_mat <- pnorm(z0_mat+(z0_mat+qnorm(cia))/(1-a_mat*(z0_mat+qnorm(cia))))
ql_add <- pnorm(z0_add+(z0_add+qnorm(cia))/(1-a_add*(z0_add+qnorm(cia))))
ql_na <- pnorm(z0_na+(z0_na+qnorm(cia))/(1-a_na*(z0_na+qnorm(cia))))
md_mat <- pnorm(z0_mat+(z0_mat+qnorm(0.50))/(1-a_mat*(z0_mat+qnorm(0.50))))
md_add <- pnorm(z0_add+(z0_add+qnorm(0.50))/(1-a_add*(z0_add+qnorm(0.50))))
md_na <- pnorm(z0_na+(z0_na+qnorm(0.50))/(1-a_na*(z0_na+qnorm(0.50))))
qu_mat <- pnorm(z0_mat+(z0_mat+qnorm(1-cia))/(1-a_mat*(z0_mat+qnorm(1-cia))))
qu_add <- pnorm(z0_add+(z0_add+qnorm(1-cia))/(1-a_add*(z0_add+qnorm(1-cia))))
qu_na <- pnorm(z0_na+(z0_na+qnorm(1-cia))/(1-a_na*(z0_na+qnorm(1-cia))))
if (!is.null(remain)) {
  ql_play<- matrix(0,ncol=1,nrow=length(remain))
  md_play<- matrix(0,ncol=1,nrow=length(remain))
  qu_play<- matrix(0,ncol=1,nrow=length(remain))
for (i in 1:length(remain)) {
  ql_play[i,]<- pnorm(z0_play[i,]+(z0_play[i,]+qnorm(cia))/(1-a_play[i,]*(z0_play[i,]+qnorm(cia))))
  md_play[i,]<- pnorm(z0_play[i,]+(z0_play[i,]+qnorm(0.5))/(1-a_play[i,]*(z0_play[i,]+qnorm(0.5))))
  qu_play[i,]<- pnorm(z0_play[i,]+(z0_play[i,]+qnorm(1-cia))/(1-a_play[i,]*(z0_play[i,]+qnorm(1-cia))))
  }  #end remain loop
} #end bias constants

#adjusted confidence interval frame
if (is.null(remain)) { ci2<- matrix(0,ncol=4,nrow=3); ci2_p<- matrix(0,ncol=4,nrow=3)  }
if (!is.null(remain)) { ci2<- matrix(0,ncol=4,nrow=3+length(remain)); ci2_p<- matrix(0,ncol=4,nrow=3+length(remain)) }
  col_names<- c("component","lower","median","upper") #known column names
  ci2[,1][1:3]<- c("additive","nonadd","maternal") #known labels
  ci2_p[,1][1:3]<- c("additive","nonadd","maternal")
#intervals
  ci2[,2][1:3]<- c(quantile(comp[,add],ql_add),quantile(comp[,nonadd],ql_na),quantile(comp[,mater],ql_mat)) #known lower
  ci2[,3][1:3]<- c(quantile(comp[,add],md_add),quantile(comp[,nonadd],md_na),quantile(comp[,mater],md_mat)) #known median
  ci2[,4][1:3]<- c(quantile(comp[,add],qu_add),quantile(comp[,nonadd],qu_na),quantile(comp[,mater],qu_mat)) #known upper
if (!is.null(remain)) { for (i in 1:length(remain)) {
  ci2[,1][(3+i)]<- paste(remain[i])
  ci2[(3+i),][2:4]<- c(quantile(comp[,play[i,]],ql_play[i,]),quantile(comp[,play[i,]],md_play[i,]),quantile(comp[,play[i,]],qu_play[i,]))
  } #end loop
} #end remain
#
  ci2_p[,2][1:3]<- c(quantile(perc[,1],ql_add),quantile(perc[,2],ql_na),quantile(perc[,3],ql_mat)) #known lower
  ci2_p[,3][1:3]<- c(quantile(perc[,1],md_add),quantile(perc[,2],md_na),quantile(perc[,3],md_mat)) #known median
  ci2_p[,4][1:3]<- c(quantile(perc[,1],qu_add),quantile(perc[,2],qu_na),quantile(perc[,3],qu_mat)) #known upper
if (!is.null(remain)) { for (i in 1:length(remain)) {
  ci2_p[,1][(3+i)]<- paste(remain[i])
  ci2_p[(3+i),][2:4]<- c(quantile(perc[,(3+i)],ql_play[i,]),quantile(perc[,(3+i)],md_play[i,]),quantile(perc[,(3+i)],qu_play[i,]))
  } #end loop
} #end remain

#if replacement needed
if (z0_add == Inf | z0_add == -Inf | z0_na == Inf | z0_na == -Inf | z0_mat == Inf | z0_mat == -Inf)
  { if (is.null(remain)) { ci2.1<- matrix(NA,ncol=5,nrow=3);ci2.1p<- matrix(NA,ncol=5,nrow=3) }
    if (!is.null(remain)) { ci2.1<- matrix(NA,ncol=5,nrow=3+length(remain)); ci2.1p<- matrix(NA,ncol=5,nrow=3+length(remain)) }
    ci2.1[,1:4]<- ci2[,1:4]; ci2<- ci2.1
    ci2.1p[,1:4]<- ci2_p[,1:4]; ci2_p<- ci2.1p
    col_names<- c("component","lower","median","upper","change") }
if (!is.null(remain)) { chg_test<- matrix(0,ncol=1,nrow=length(remain))
  for (i in 1:length(remain)) {
  if (z0_play[i,] == Inf | z0_play[i,] == -Inf) { chg_test[i,]<-1 }  }
 if (sum(chg_test) > 0 ) {
  ci2.1<- matrix(0,ncol=5,nrow=3+length(remain));ci2.1p<- matrix(0,ncol=5,nrow=3+length(remain))
  ci2.1[,1:4]<- ci2[,1:4]; ci2<- ci2.1
  ci2.1p[,1:4]<- ci2_p[,1:4]; ci2_p<- ci2.1p
  col_names<- c("component","lower","median","upper","change") } }
#changes
if (z0_add == Inf | z0_add == -Inf) { ci2[1,][2:4]<- ci[1,][2:4]; ci2[1,][5] <- "bias fail"
  ci2_p[1,][2:4]<- ci_p[1,][2:4]; ci2_p[1,][5] <- "bias fail" }
if (z0_na == Inf | z0_na == -Inf) { ci2[2,][2:4]<- ci[2,][2:4]; ci2[2,][5] <- "bias fail"
  ci2_p[2,][2:4]<- ci_p[2,][2:4]; ci2_p[2,][5] <- "bias fail"  }
if (z0_mat == Inf | z0_mat == -Inf) { ci2[3,][2:4]<- ci[3,][2:4]; ci2[3,][5]<- "bias fail"
  ci2_p[3,][2:4]<- ci_p[3,][2:4]; ci2_p[3,][5]<- "bias fail"   }
if (!is.null(remain) && sum(chg_test) > 0) { for (i in 1:length(remain)) {
   ci2[(3+i),][2:4]<- ci[(3+i),][2:4]; ci2[(3+i),][5]<- "bias fail"
   ci2_p[(3+i),][2:4]<- ci_p[(3+i),][2:4]; ci2_p[(3+i),][5]<- "bias fail" } }
#round, convert, and name columns
  ci2[,2:4]<- round(as.numeric(ci2[,2:4]),rnd_r)
  ci2_p[,2:4]<- round(as.numeric(ci2_p[,2:4]),rnd_p)
  ci2<- as.data.frame(ci2); colnames(ci2)<- col_names
  ci2_p<- as.data.frame(ci2_p); colnames(ci2_p)<- col_names
} #end null bias
#round, convert, and name columns
  ci[,2:4]<- round(as.numeric(ci[,2:4]),rnd_r)
  ci_p[,2:4]<- round(as.numeric(ci_p[,2:4]),rnd_p)
  ci<- as.data.frame(ci);colnames(ci)<- col_names1
  ci_p<- as.data.frame(ci_p);colnames(ci_p)<- col_names1
#finish
  if (is.null(trait) == T && is.null(bias)) { ci_obj<- list(raw=ci,percentage=ci_p); return(ci_obj) }
  if (is.null(trait) == T && !is.null(bias)) { ci_obj<- list(raw=ci2,percentage=ci2_p); return(ci_obj) }
  if (is.null(trait) == F && is.null(bias)) { ci$trait<- as.character(trait); ci_p$trait<- as.character(trait)
   ci_obj<- list(raw=ci,percentage=ci_p); return(ci_obj) }
  if (is.null(trait) == F && !is.null(bias)) { ci2$trait<- as.character(trait); ci2_p$trait<- as.character(trait)
   ci_obj<- list(raw=ci2,percentage=ci2_p); return(ci_obj) }
} #end function

#**************************************************************************************

##4. Jackknifed models: simple CI
#based on t distribution
#bias is raw observed variance components using full data: c(add,nonadd,mater,tot)
ciJack<- function(comp,full,level=95,rnd_r=3,rnd_p=1,trait=NULL) {
  if (missing(full)) stop("Need the observed values using full data")
  cia<- (100-level)/100/2
  n<- nrow(comp)
#find columns
  mater<- grep("maternal", colnames(comp))
  add<- grep("additive", colnames(comp))
  nonadd<- grep("nonadd", colnames(comp))
#convert to percentage
  comp$p_mat<- 100*comp[,mater]/comp$Total
  comp$p_add<- 100*comp[,add]/comp$Total
  comp$p_na<- 100*comp[,nonadd]/comp$Total
#Expand full vector to matrix
full_r<- do.call("rbind", replicate(n,full[1:3],simplify=F))      #raw
full_p1<- data.frame(additive=100*full[1]/full[4], nonadd=100*full[2]/full[4], maternal=100*full[3]/full[4])
full_p<- do.call("rbind", replicate(n,full_p1,simplify=F))        #percentage
#pseudo values
pseudo_r<- n*full_r - (n-1)*comp[,c(add,nonadd,mater)]
pseudo_p<- n*full_p - (n-1)*cbind(comp$p_add,comp$p_na,comp$p_mat)
#Confidence interval
lwr_r<- colMeans(pseudo_r)- qt(1-cia,n-1)*sqrt(apply(pseudo_r, 2, var)/n)
upp_r<- colMeans(pseudo_r) + qt(1-cia,n-1)*sqrt(apply(pseudo_r, 2, var)/n)
lwr_p<- colMeans(pseudo_p)- qt(1-cia,n-1)*sqrt(apply(pseudo_p, 2, var)/n)
upp_p<- colMeans(pseudo_p) + qt(1-cia,n-1)*sqrt(apply(pseudo_p, 2, var)/n)
#
ci<- data.frame(component=c("additive","nonadd","maternal"),lower= lwr_r, mean=colMeans(pseudo_r), upper= upp_r)
rownames(ci)<- c(1,2,3);ci[,2:4]<- round(ci[,2:4],rnd_r)
ci_p<- data.frame(component=c("additive","nonadd","maternal"),lower= lwr_p, mean=colMeans(pseudo_p), upper= upp_p)
rownames(ci_p)<- c(1,2,3);ci_p[,2:4]<- round(ci_p[,2:4],rnd_p)
#finish
  if (is.null(trait)) { ci_obj<- list(raw=ci,percentage=ci_p); return(ci_obj) }
  if (!is.null(trait)) { ci$trait<- as.factor(trait); ci_p$trait<- as.factor(trait);
    ci_obj<- list(raw=ci,percentage=ci_p); return(ci_obj) }
} #end function

#**************************************************************************************

##5. Jackknifed models: advanced CI
#based on t distribution
#bias is raw observed variance components using full data: c(add,nonadd,mater,tot)
ciJack2<- function(comp,full,level=95,rnd_r=3,rnd_p=1,position=NULL,block=NULL,trait=NULL) {
  if (missing(full)) stop("Need the observed values using full data")
  cia<- (100-level)/100/2
  n<- nrow(comp)
#find columns
  mater<- grep("maternal", colnames(comp))
  add<- grep("additive", colnames(comp))
  nonadd<- grep("nonadd", colnames(comp))
  if (!is.null(position)) { pos<- grep(paste(position), colnames(comp)) }
  if (!is.null(block)) { bloc<- grep(paste(block), colnames(comp)) }
#convert to percentage
  comp$p_mat<- 100*comp[,mater]/comp$Total
  comp$p_add<- 100*comp[,add]/comp$Total
  comp$p_na<- 100*comp[,nonadd]/comp$Total
  if (!is.null(position)) { comp$p_pos<- 100*comp[,pos]/comp$Total }
  if (!is.null(block)) { comp$p_bloc<- 100*comp[,bloc]/comp$Total }
#Expand full vector to matrix
if (is.null(position) && is.null(block)) {
 full_r<- do.call("rbind", replicate(n,full[1:3],simplify=F)) #raw
 full_p1<- data.frame(additive=100*full[1]/full[4], nonadd=100*full[2]/full[4], maternal=100*full[3]/full[4]) } #percentage
if (!is.null(position) && is.null(block)) {
 full_r<- do.call("rbind", replicate(n,full[c(1:3,5)],simplify=F))
 full_p1<- data.frame(additive=100*full[1]/full[4],nonadd=100*full[2]/full[4],maternal=100*full[3]/full[4],
   position=100*full[5]/full[4]) }
if (is.null(position) && !is.null(block)) {
 full_r<- do.call("rbind", replicate(n,full[c(1:3,5)],simplify=F))
 full_p1<- data.frame(additive=100*full[1]/full[4],nonadd=100*full[2]/full[4],maternal=100*full[3]/full[4],
   block=100*full[5]/full[4]) }
if (!is.null(position) && !is.null(block)) {
 full_r<- do.call("rbind", replicate(n,full[c(1:3,5,6)],simplify=F))
 full_p1<- data.frame(additive=100*full[1]/full[4],nonadd=100*full[2]/full[4],maternal=100*full[3]/full[4],
   position=100*full[5]/full[4],block=100*full[6]/full[4])  }
#
full_p<- do.call("rbind", replicate(n,full_p1,simplify=F))
#pseudo values with conditions
if (is.null(position) && is.null(block)) {
  pseudo_r<- n*full_r - (n-1)*comp[,c(add,nonadd,mater)]
  pseudo_p<- n*full_p - (n-1)*cbind(comp$p_add,comp$p_na,comp$p_mat) }
if (!is.null(position) && is.null(block)) {
  pseudo_r<- n*full_r - (n-1)*comp[,c(add,nonadd,mater,pos)]
  pseudo_p<- n*full_p - (n-1)*cbind(comp$p_add,comp$p_na,comp$p_mat,comp$p_pos) }
if (is.null(position) && !is.null(block)) {
  pseudo_r<- n*full_r - (n-1)*comp[,c(add,nonadd,mater,bloc)]
  pseudo_p<- n*full_p - (n-1)*cbind(comp$p_add,comp$p_na,comp$p_mat,comp$p_bloc) }
if (!is.null(position) && !is.null(block)) {
  pseudo_r<- n*full_r - (n-1)*comp[,c(add,nonadd,mater,pos,bloc)]
  pseudo_p<- n*full_p - (n-1)*cbind(comp$p_add,comp$p_na,comp$p_mat,comp$p_pos,comp$p_bloc) }
#Confidence intervals
lwr_r<- colMeans(pseudo_r)- qt(1-cia,n-1)*sqrt(apply(pseudo_r, 2, var)/n)
upp_r<- colMeans(pseudo_r) + qt(1-cia,n-1)*sqrt(apply(pseudo_r, 2, var)/n)
lwr_p<- colMeans(pseudo_p)- qt(1-cia,n-1)*sqrt(apply(pseudo_p, 2, var)/n)
upp_p<- colMeans(pseudo_p) + qt(1-cia,n-1)*sqrt(apply(pseudo_p, 2, var)/n)
#Conditions
if (is.null(position) && is.null(block)) {
  ci<- data.frame(component=c("additive","nonadd","maternal"),lower= lwr_r, mean=colMeans(pseudo_r), upper= upp_r)
  rownames(ci)<- c(1,2,3)
  ci_p<- data.frame(component=c("additive","nonadd","maternal"),lower= lwr_p, mean=colMeans(pseudo_p), upper= upp_p)
  rownames(ci_p)<- c(1,2,3) }
if (!is.null(position) && is.null(block)) {
  ci<- data.frame(component=c("additive","nonadd","maternal",paste(position)),lower= lwr_r, mean=colMeans(pseudo_r), upper= upp_r)
  rownames(ci)<- c(1,2,3,4)
  ci_p<- data.frame(component=c("additive","nonadd","maternal",paste(position)),lower= lwr_p, mean=colMeans(pseudo_p), upper= upp_p)
  rownames(ci_p)<- c(1,2,3,4) }
if (is.null(position) && !is.null(block)) {
  ci<- data.frame(component=c("additive","nonadd","maternal",paste(block)),lower= lwr_r, mean=colMeans(pseudo_r), upper= upp_r)
  rownames(ci)<- c(1,2,3,4)
  ci_p<- data.frame(component=c("additive","nonadd","maternal",paste(block)),lower= lwr_p, mean=colMeans(pseudo_p), upper= upp_p)
  rownames(ci_p)<- c(1,2,3,4) }
if (!is.null(position) && !is.null(block)) {
  ci<- data.frame(component=c("additive","nonadd","maternal",paste(position),paste(block)),lower= lwr_r,
   mean=colMeans(pseudo_r), upper= upp_r); rownames(ci)<- c(1,2,3,4,5)
  ci_p<- data.frame(component=c("additive","nonadd","maternal",paste(position),paste(block)),lower= lwr_p,
   mean=colMeans(pseudo_p), upper= upp_p);rownames(ci_p)<- c(1,2,3,4,5) }
#
ci[,2:4]<- round(ci[,2:4],rnd_r)
ci_p[,2:4]<- round(ci_p[,2:4],rnd_p)
#finish
  if (is.null(trait)) { ci_obj<- list(raw=ci,percentage=ci_p); return(ci_obj) }
  if (!is.null(trait)) { ci$trait<- as.factor(trait); ci_p$trait<- as.factor(trait);
    ci_obj<- list(raw=ci,percentage=ci_p); return(ci_obj) }
} #end function

#**************************************************************************************

##6. Jackknifed models: expert CI
#based on t distribution
#bias is raw observed variance components using full data: c(add,nonadd,mater,tot)
ciJack3<- function(comp,full,remain=NULL,level=95,rnd_r=3,rnd_p=1,trait=NULL) {
  if (missing(full)) stop("Need the observed values using full data")
  cia<- (100-level)/100/2
  n<- nrow(comp)
#find columns
  mater<- grep("maternal", colnames(comp))
  add<- grep("additive", colnames(comp))
  nonadd<- grep("nonadd", colnames(comp))
if (!is.null(remain)) {
  play<- matrix(0,ncol=1,nrow=length(remain))  #remaining columns
   for (i in 1:length(remain)) { play[i,]<- grep(paste(remain[i]), colnames(comp)) } }
#convert to percentage: comp
  perc<- matrix(0,ncol=length(remain)+3,nrow=nrow(comp))
  perc[,1]<- 100*comp[,add]/comp$Total
  perc[,2]<- 100*comp[,nonadd]/comp$Total
  perc[,3]<- 100*comp[,mater]/comp$Total
if (!is.null(remain)) {
  for (i in 1:length(remain)) { perc[,(i+3)]<- 100*comp[,play[i,]]/comp$Total } }
#Expand full vector to matrix
#raw
if (is.null(remain)) {
 full_r<- do.call("rbind", replicate(n,full[1:3],simplify=F)) #raw
 full_p1<- matrix(0,ncol=3,nrow=1) }  #percentage
if (!is.null(remain)) {
 full_r<- do.call("rbind", replicate(n,full[-4],simplify=F)) #no total
 full_p1<- matrix(0,ncol=3+length(remain),nrow=1) }
  full_p1[,1]<- 100*full[1]/full[4] #additive
  full_p1[,2]<- 100*full[2]/full[4] #non-additive
  full_p1[,3]<- 100*full[3]/full[4] #maternal
if (!is.null(remain)) {
  for (i in 1:length(remain)) { full_p1[,(3+i)]<- 100*full[(4+i)]/full[4] } }
#
full_p<- do.call("rbind", replicate(n,full_p1,simplify=F))
#pseudo values
if (is.null(remain)) {
  pseudo_r<- n*full_r - (n-1)*comp[,c(add,nonadd,mater)]
  pseudo_p<- n*full_p - (n-1)*perc[,c(1:3)] }
if (!is.null(remain)) {
  pseudo_r<- n*full_r - (n-1)*comp[,c(add,nonadd,mater,play)]
  pseudo_p<- n*full_p - (n-1)*perc[,c(1:(3+length(remain)))] }
#Confidence interval
lwr_r<- apply(pseudo_r, 2, mean)- qt(1-cia,n-1)*sqrt(apply(pseudo_r, 2, var)/n)
med_r<- apply(pseudo_r, 2, mean)
upp_r<- apply(pseudo_r, 2, mean) + qt(1-cia,n-1)*sqrt(apply(pseudo_r, 2, var)/n)
lwr_p<- apply(pseudo_p, 2, mean)- qt(1-cia,n-1)*sqrt(apply(pseudo_p, 2, var)/n)
med_p<- apply(pseudo_p, 2, mean)
upp_p<- apply(pseudo_p, 2, mean) + qt(1-cia,n-1)*sqrt(apply(pseudo_p, 2, var)/n)
#
if (is.null(remain)) { ci<- matrix(0,ncol=4,nrow=3); ci_p<- matrix(0,ncol=4,nrow=3) }
if (!is.null(remain)) { ci<- matrix(0,ncol=4,nrow=3+length(remain)); ci_p<- matrix(0,ncol=4,nrow=3+length(remain)) }
col_names1<- c("component","lower","median","upper") #know column names
ci[,1][1:3]<- c("additive","nonadd","maternal") #known labels
ci_p[,1][1:3]<- c("additive","nonadd","maternal")
#intervals
ci[,2][1:3]<- lwr_r[1:3]; ci_p[,2][1:3]<- lwr_p[1:3]  #known lower
ci[,3][1:3]<- med_r[1:3]; ci_p[,3][1:3]<- med_p[1:3] #known mean
ci[,4][1:3]<- upp_r[1:3]; ci_p[,4][1:3]<- upp_p[1:3]   #known upper
if (!is.null(remain)) { for (i in 1:length(remain)) {
  ci[,1][(3+i)]<- paste(remain[i]); ci_p[,1][(3+i)]<- paste(remain[i])
  ci[(3+i),][2:4]<- c(lwr_r[3+i],med_r[3+i],upp_r[3+i]); ci_p[(3+i),][2:4]<- c(lwr_p[3+i],med_p[3+i],upp_p[3+i]) }  }
#round, convert, and name columns
  ci[,2:4]<- round(as.numeric(ci[,2:4]),rnd_r); ci_p[,2:4]<- round(as.numeric(ci_p[,2:4]),rnd_p)
  ci<- as.data.frame(ci); ci_p<- as.data.frame(ci_p)
  colnames(ci)<- c("component","lower","mean","upper"); colnames(ci_p)<- c("component","lower","mean","upper")
#finish
  if (is.null(trait)) { ci_obj<- list(raw=ci,percentage=ci_p); return(ci_obj) }
  if (!is.null(trait)) { ci$trait<- as.factor(trait); ci_p$trait<- as.factor(trait);
    ci_obj<- list(raw=ci,percentage=ci_p); return(ci_obj) }
} #end function