###############################
#Results for Sim B
###############################


rm(list=ls())
library("dplyr")

#Load result matrix
load("./model2_nsim2000.RData")

nsim <- 2000



# Add parameter values to result matrix -----------------------------------


n_param_cols <- length(res[[1]]$used_parameters)



res2_m <- do.call(rbind,res)
res2_param_all <- res2_m %>%as.data.frame()%>% dplyr::select(used_parameters)

parameters <- res2_param_all%>%unique%>%unlist%>%na.omit()%>%as.numeric%>%matrix(ncol=n_param_cols,byrow = T)%>%data.frame
colnames(parameters) <- names(res[[1]]$used_parameters)
rm(list="res2_param_all")

#Summarize results in a matrix

nsettings <- dim(parameters)[1]
model1 <- res2_m  %>%cbind(rep(1:nsettings,each=nsim))
rm(list="res2_m")#avoiding too large objects in the workspace
colnames(model1)[length(colnames(model1))] <- "setting"

if(verbose)colnames(model1)
if(verbose)model1 %>%dim
model2 <- cbind(model1,
                rep(parameters$n.trials,each=nsim),
                rep(parameters$n.obs,each=nsim),
                rep(parameters$varnum,each=nsim),
                rep(parameters$cor.x,each=nsim),
                rep(parameters$corUbi,each=nsim),
                rep(parameters$corUbislope,each=nsim),
                #rep(parameters$ranef.intercept,each=nsim),
                rep(parameters$ranef.slope,each=nsim))
model1 <- NULL

nocolname <- which(colnames(model2)=="")
colnames(model2)[nocolname] <- c("n.trials","n.obs","varnum","cor.x",
                                 "corUbi","corUbislope",#"ranef.intercept",
                                 "ranef.slope")


save(list=c("model2","parameters"),
     file="./m2_model2.RData")



# Save subsets of results -------------------------------------------------

#Reduction of result matrix
model2tree <- model2 %>%as.data.frame()%>%
  dplyr::select(
    "f1_nnodes",
    "f2_nnodes",
    "f3_nnodes",                 
    "LM_size",
    "splitcut.f1",
    "splitcut.f2",
    "splitcut.f3",
    "splitvar.f1",
    "splitvar.f2",               
    "splitvar.f3",
    "l1_cut",
    "l1_var" , 
    "used_parameters","setting"
    
  )
# save(list=c("model2tree"),
#      file="./m2_model2_tree.RData")


model2variance_components <- model2 %>%as.data.frame()%>%
  dplyr::select(
    "f1_variance_components",    
    "f2_variance_components",
    "f3_variance_components",
    "f1_test_var_components",    
    "f2_test_var_components",
    "f3_test_var_components", 
    "used_parameters","setting"
    
  )
# save(list=c("model2variance_components"),
#      file="./m2_model2_variancecomponets.RData")




model2conv <- model2 %>%as.data.frame()%>%
  dplyr::select(
    "f1_model_c_message",
    "f2_model_c_message",
    "f3_model_c_message",
    "f1_warning",
    "f2_warning",
    "f3_warning",
    "f1_model_convergence",
    "f2_model_convergence",
    "f3_model_convergence",
    "f1_testmodel_convergence",
    "f2_testmodel_convergence",
    "f3_testmodel_convergence",  
    "f1_message",  
    "f2_message",  
    "f3_message",
    "used_parameters","setting"
    
  )

# save(list=c("model2conv"),
#      file="./m2_model2_convergence.RData")

model2_treatment <- model2%>%as.data.frame()%>%
  dplyr::select("f1_e","f2_e","f3_e","l1_e",
                "true_f1","true_f2","true_f3",
                "true_l1","used_parameters","setting",
                "test_e_f1","test_e_f2","test_e_f3","test_e_l1")

# save(list=c("model2_treatment"),
#      file="./m2_model2_treatment.RData")

model2_time <- model2%>%as.data.frame()%>%
  dplyr::select("time_f1",
                "time_f2",
                "time_f3","time_l1","used_parameters","setting",
  )

# save(list=c("model2_time"),
#      file="./m2_model2_time.RData")

# Calculate tree accuracy -------------------------------------------------


#load("./m2_model2_tree.RData")

total <- dim(model2tree)[1]
model2tree%>%colnames

#Calcuate Accuracy
f1_vars <- model2tree%>%select(splitvar.f1)
f1_vars$splitchar<- f1_vars$splitvar.f1%>%as.character

f2_vars <- model2tree%>%select(splitvar.f2)
f2_vars$splitchar<- f2_vars$splitvar.f2%>%as.character

f3_vars <- model2tree%>%select(splitvar.f3)
f3_vars$splitchar<- f3_vars$splitvar.f3%>%as.character


l1_vars <- model2tree%>%select(l1_var)
l1_vars$splitchar<- l1_vars$l1_var%>%as.character

# substr(f1_vars$splitchar,6,6)%>%as.numeric%>%head


#Extract Cut points 
f1_allcuts <- model2tree%>%select(splitcut.f1)
f2_allcuts <- model2tree%>%select(splitcut.f2)
f3_allcuts <- model2tree%>%select(splitcut.f3)
f0_allcuts <- model2tree%>%select(l1_cut)
select_cut_f1 <- function(x,split){f1_allcuts$splitcut.f1[x][[1]][[split]]%>%as.numeric}
select_cut_f2 <- function(x,split){f2_allcuts$splitcut.f2[x][[1]][[split]]%>%as.numeric}
select_cut_f3 <- function(x,split){f3_allcuts$splitcut.f3[x][[1]][[split]]%>%as.numeric}
select_cut_f0 <- function(x,split){f0_allcuts$l1_cut[x][[1]][[split]]%>%as.numeric}

#For split 2 or larger; 
#since some runs have convergence warnings, therefore if conditions have to be fullfilled
select_cut_f1_2 <- function(x,split){
  if(length(f1_allcuts$splitcut.f1[x]%>%unlist)<split){
    NA
  }else{
    f1_allcuts$splitcut.f1[x][[1]][[split]]%>%as.numeric
  }
}
select_cut_f2_2 <- function(x,split){
  if(length(f2_allcuts$splitcut.f2[x]%>%unlist)<split){
    NA
  }else{
    f2_allcuts$splitcut.f2[x][[1]][[split]]%>%as.numeric
  }
}

select_cut_f3_2 <- function(x,split){
  if(length(f3_allcuts$splitcut.f3[x]%>%unlist)<split){
    NA
  }else{
    f3_allcuts$splitcut.f3[x][[1]][[split]]%>%as.numeric
  }
}

select_cut_f0_2 <- function(x,split){
  if(length(f0_allcuts$l1_cut[x]%>%unlist)<split){
    NA
  }else{
    f0_allcuts$l1_cut[x][[1]][[split]]%>%as.numeric
  }
}

split1_f1 <- sapply(1:total,select_cut_f1,split=1)
split2_f1 <- sapply(1:total,select_cut_f1_2,split=2)
split3_f1 <- sapply(1:total,select_cut_f1_2,split=3)

split1_f2 <- sapply(1:total,select_cut_f2,split=1)
split2_f2 <- sapply(1:total,select_cut_f2_2,split=2)
split3_f2 <- sapply(1:total,select_cut_f2_2,split=3)

split1_f3 <- sapply(1:total,select_cut_f3,split=1)
split2_f3 <- sapply(1:total,select_cut_f3_2,split=2)
split3_f3 <- sapply(1:total,select_cut_f3_2,split=3)

split1_f0 <- sapply(1:total,select_cut_f0,split=1)
split2_f0 <- sapply(1:total,select_cut_f0_2,split=2)
split3_f0 <- sapply(1:total,select_cut_f0_2,split=3)


split3_f0%>%is.na%>%sum
split2_f0%>%is.na%>%sum


# save(list=c("split1_f0","split2_f0","split3_f0",
#             "split1_f1","split2_f1","split3_f1",
#             "split1_f2","split2_f2","split3_f2",
#             "split1_f3","split2_f3","split3_f3"
# ),
# file="./m2_cuts.RData")

# model2tree%>%select(splitcut.f1)%>%head
# select_cut_f1(5,split=3)
# 
# sapply(1:total,select_cut_f1,split=1)

f1_numbernodes <- model2tree%>%select(f1_nnodes)%>%unlist%>%as.numeric



f1_acc <- model2tree%>%select(f1_nnodes)==4& #number endnodes
  substr(f1_vars$splitchar,3,3)%>%as.numeric==4&
  substr(f1_vars$splitchar,6,6)%>%as.numeric==3&
  substr(f1_vars$splitchar,9,9)%>%as.numeric==7&
  split1_f1<=30+5&
  split1_f1>=30-5&
  split2_f1<=17+5&
  split2_f1>=17-5&
  split3_f1<=63+5&
  split3_f1>=63-5

f2_acc <- model2tree%>%select(f2_nnodes)==4& #number endnodes
  substr(f2_vars$splitchar,4,5)=="x4"&
  substr(f2_vars$splitchar,10,11)=="x3"&
  substr(f2_vars$splitchar,16,17)=="x7"&
  split1_f2<=30+5&
  split1_f2>=30-5&
  split2_f2<=17+5&
  split2_f2>=17-5&
  split3_f2<=63+5&
  split3_f2>=63-5


f3_acc <- model2tree%>%select(f3_nnodes)==4& #number endnodes
  substr(f3_vars$splitchar,4,5)=="x5"&
  substr(f3_vars$splitchar,10,11)=="x4"&
  substr(f3_vars$splitchar,16,17)=="x8"&
  split1_f3<=30+5&
  split1_f3>=30-5&
  split2_f3<=17+5&
  split2_f3>=17-5&
  split3_f3<=63+5&
  split3_f3>=63-5 



f0_acc <- model2tree%>%select(LM_size)==4& 
  substr(l1_vars$splitchar,4,5)=="x4"&
  substr(l1_vars$splitchar,10,11)=="x3"&
  substr(l1_vars$splitchar,16,17)=="x7"&
  split1_f0<=30+5&
  split1_f0>=30-5&
  split2_f0<=17+5&
  split2_f0>=17-5&
  split3_f0<=63+5&
  split3_f0>=63-5



parameters_all <- model2tree%>%select(used_parameters)%>%unlist%>%matrix(ncol=9,byrow = T)%>%as.data.frame()

accuracy_complete <- cbind(f0_acc,f1_acc,f2_acc,f3_acc,parameters_all)
colnames(accuracy_complete) <- c("f0","f1","f2","f3","varnum","n.trials","n.obs","tau_gamma",
                                 "ranef.slope","cor.x","corUbi","corUbislope","diff")
accuracy_complete <- data.frame(f1=
                                  f1_acc,
                                f2=f2_acc ,
                                f3=f2_acc ,
                                f0=f0_acc,
                                ntrial=model2tree%>%select(used_parameters)%>%unlist%>%matrix(ncol=9,byrow = T)%>%as.data.frame()%>%select(V2),
                                nobs=model2tree%>%select(used_parameters)%>%unlist%>%matrix(ncol=9,byrow = T)%>%as.data.frame()%>%select(V3),
                                corUbi=model2tree%>%select(used_parameters)%>%unlist%>%matrix(ncol=9,byrow = T)%>%as.data.frame()%>%select(V7),
                                ranef.intercept=model2tree%>%select(used_parameters)%>%unlist%>%matrix(ncol=9,byrow = T)%>%as.data.frame()%>%select(V4),
                                corUbislope=model2tree%>%select(used_parameters)%>%unlist%>%matrix(ncol=9,byrow = T)%>%as.data.frame()%>%select(V8),
                                ranef.slope=model2tree%>%select(used_parameters)%>%unlist%>%matrix(ncol=9,byrow = T)%>%as.data.frame()%>%select(V5),
                                cor.x=model2tree%>%select(used_parameters)%>%unlist%>%matrix(ncol=9,byrow = T)%>%as.data.frame()%>%select(V6),
                                varnum=model2tree%>%select(used_parameters)%>%unlist%>%matrix(ncol=9,byrow = T)%>%as.data.frame()%>%select(V1))


accuracy_complete%>%summary


# save(list=c("accuracy_complete"),
#      file="./m2_accuracy.RData")




# Plot for tree accuracy --------------------------------------------------


library("ggplot2")

colnames(accuracy_complete)
treeaccuracy.long <- data.frame(accuracy=stack(accuracy_complete[,1:4]), 
                                nobs=rep(accuracy_complete$n.obs, 4), 
                                corx=rep(accuracy_complete$cor.x, 4), 
                                varnum=rep(accuracy_complete$varnum, 4), 
                                corUbi=rep(accuracy_complete$corUbi, 4), 
                                corUbislope=rep(accuracy_complete$corUbislope, 4), 
                                ntrials=rep(accuracy_complete$n.trials, 4), 
                                tau_gamma=rep(accuracy_complete$tau_gamma, 4),
                                ranefslope=rep(accuracy_complete$ranef.slope, 4),
                                datasetID=factor(rep(1:nrow(accuracy_complete), 4)))

treeaccuracy.long$accuracy.ind <- factor(treeaccuracy.long$accuracy.ind,labels=c("MOB","MOB-RI","metaMOB-RI","metaMOB-SI"),
                                         levels = c("f0","f1","f2","f3"))
# treeaccuracy.long$ranefslope <- factor(treeaccuracy.long$ranefslope,
#                                        labels=c("tau[0]^2==0",
#                                                 "tau[0]^2==5",
#                                                 "tau[0]^2==10"))

treeaccuracy.long$tau_gamma <- factor(treeaccuracy.long$tau_gamma,
                                      labels=c("tau[gamma]==0",
                                               "tau[gamma]==5",
                                               "tau[gamma]==10"))
#treeaccuracy.long$ranefintercept <- factor(as.numeric(as.character(treeaccuracy.long$ranefintercept)), ordered=T)
treeaccuracy.long$n.obs <- factor(as.numeric(as.character(treeaccuracy.long$nobs)), ordered=T)
treeaccuracy.long$corUbislope <- factor(treeaccuracy.long$corUbislope,
                                        labels = c("cor(b[1], X)== 0",#0
                                                   "cor(b[1], X[split])!= 0",#1
                                                   "cor(b[1], X[non-split])!= 0")) #2

#treeaccuracy.long$ranefslope <- factor(treeaccuracy.long$ranefslope,ordered=T) 

# treeaccuracy.long$corUbi <- factor(treeaccuracy.long$corUbi,
#                                    labels = c("b and X uncorrelated")) #2


#Mean over K and N
treeacc <- aggregate(formula=accuracy.values  ~ accuracy.ind + ranefslope + corUbislope+tau_gamma, 
                     FUN=mean, data=treeaccuracy.long)

treeacc%>%head()


# pdf("./m2ranef2p5_taccuracy_V2.pdf",
#     width=9.5,height=6)
ggplot(treeacc, aes(x=ranefslope,y=accuracy.values,colour=accuracy.ind,group=accuracy.ind))+
  geom_point()+
  geom_line(size=1.2) +
  #geom_hline(yintercept=4, linetype="dashed", color = "gray")+
  facet_grid(tau_gamma~corUbislope,margins=F,labeller = label_parsed)+
  # ggtitle("Tree Accuracy ")+
  ylab("Tree accuracy")+xlab(expression(tau[1]))+
  scale_x_continuous(breaks = c(0,2.5,5,10)) +
  labs(colour = "Method")+
  theme_minimal()+
  theme(plot.title = element_text(size = 20, face = "bold"),
        legend.title=element_text(size=20), 
        legend.text=element_text(size=20),
        axis.title=element_text(size=20),
        axis.text.x = element_text(angle = 30, hjust = 1,size=18),
        text = element_text(size=20),
        legend.position = "bottom",
        panel.spacing = unit(1.5, "lines"),
        legend.key.size=unit(1,"cm"))+guides(color = guide_legend(override.aes = list(size = 2))) 
#dev.off()

accuracy_complete%>%mutate(MOB0=as.numeric(f0),
                           MOB1=as.numeric(f1),
                           MOB2=as.numeric(f2),
                           MOB3=as.numeric(f3))%>%filter(tau_gamma==5)%>%
  select(MOB0,MOB1,MOB2,MOB3)%>%summary

accuracy_complete%>%mutate(MOB0=as.numeric(f0),
                           MOB1=as.numeric(f1),
                           MOB2=as.numeric(f2),
                           MOB3=as.numeric(f3))%>%filter(tau_gamma==0)%>%
  select(MOB0,MOB1,MOB2,MOB3)%>%summary

accuracy_complete%>%mutate(MOB0=as.numeric(f0),
                           MOB1=as.numeric(f1),
                           MOB2=as.numeric(f2),
                           MOB3=as.numeric(f3))%>%filter(tau_gamma==10)%>%
  select(MOB0,MOB1,MOB2,MOB3)%>%summary

accuracy_complete%>%mutate(MOB0=as.numeric(f0),
                           MOB1=as.numeric(f1),
                           MOB2=as.numeric(f2),
                           MOB3=as.numeric(f3))%>%filter(corUbislope==0)%>%
  select(MOB0,MOB1,MOB2,MOB3)%>%summary

accuracy_complete%>%mutate(MOB0=as.numeric(f0),
                           MOB1=as.numeric(f1),
                           MOB2=as.numeric(f2),
                           MOB3=as.numeric(f3))%>%filter(ranef.slope==0)%>%
  select(MOB0,MOB1,MOB2,MOB3)%>%summary



# Computation time --------------------------------------------------------


time.m2 <- model2_time%>%mutate(
  f1= sapply(1:total,function(a)time_f1[[a]][3]),
  f2= sapply(1:total,function(a)time_f2[[a]][3]),
  f3= sapply(1:total,function(a)time_f3[[a]][3]),
  l1= sapply(1:total,function(a)time_l1[[a]][3])
)

time.m2%>%dplyr::select(f1,f2,f3,l1)%>%summary
(time.m2%>%dplyr::select(f1,f2,f3,l1)%>%colSums()) /total
time.m2%>%dplyr::select(f1,f2,f3,l1)%>%colMeans()




# Convergence -------------------------------------------------------------


convergence_m2 <- model2conv%>%as.data.frame%>%cbind(
  w1=model2conv %>% dplyr::select(f1_warning)  %>% unlist %>% as.numeric(),
  w2=model2conv %>% dplyr::select(f2_warning)  %>% unlist %>% as.numeric(),
  w3=model2conv %>% dplyr::select(f3_warning) %>% unlist %>% as.numeric())

#(convergence_m2%>%dplyr::select(w1,w2,w3)%>%colSums(na.rm=T)) /total
convergence_m2%>%dplyr::select(w1,w2,w3)%>%colMeans()