diff --git a/R_Functions/helpfunctions.R b/R_Functions/helpfunctions.R
new file mode 100644
index 0000000000000000000000000000000000000000..48808c92a56859af7af4a6a90973d73a011c387a
--- /dev/null
+++ b/R_Functions/helpfunctions.R
@@ -0,0 +1,284 @@
+#function to clean the output folders from old files generated automatically with apollo
+
+moveold <- function(){
+ oldfiles <- list.files(pattern = "OLD[1-9]", recursive = TRUE)
+
+
+ for(file in oldfiles) {
+
+ file.rename(from = file, to = paste0("OLD/",gsub("^.*/", "",file)))
+
+ }
+
+}
+
+###z-standardization function###
+z_st <- function(var) {
+
+ database$mean.var<-mean(var)
+ m<- mean(var)
+ s<- sd(var)
+ var.z<-(var-m)/s
+ return( var.z)
+}
+
+
+
+## This function is used to create WTP values using the delta method.
+
+
+wtp <- function(cost, attr, modelname) {
+
+ wtp_values =data.frame(wtp =numeric(), robse=numeric() , robt= numeric() )
+ attr <- attr[-which(attr==cost)]
+
+ for (a in attr) {
+
+
+ deltaMethod_settings=list(operation="ratio", parName1=a, parName2=cost)
+ wtp_values[which(attr==a),]<- apollo_deltaMethod(modelname, deltaMethod_settings)
+
+ }
+ wtp_values$wtp <- wtp_values$wtp*-1
+ wtp_values$robse <- wtp_values$robse*1
+ wtp_values$robt <- wtp_values$robt*-1
+ wtp_values$pVal <- (1-pnorm((abs(wtp_values$robt))))*2
+
+ rownames(wtp_values) <- attr
+ return(wtp_values)
+
+}
+
+
+#this function uses the wtp function and wraps it for all Classes in a LC model.
+
+wtp_lc <-function(modelname) {
+
+
+ wtpvalues=list()
+
+ for (class in 1:(length(modelname$LL0)-1)) {
+
+
+ clet <- intToUtf8(96+class)
+ coefs<- data.frame(apollo_modelOutput(modelname, modelOutput_settings = list(printPVal=T)))
+ coefs<- coefs[grep(paste0("delta_.*", clet,"$"),x = rownames(coefs), value=TRUE, perl = TRUE), c(1,5:7)]
+
+
+
+
+ print(clet)
+
+ wtpvalues[[paste0("Class ",class)]] <-
+ wtp(paste0("cost_",clet),
+ grep(paste0("^(?=.*_",clet,")(?!.*delta)"), names(modelname$estimate) , value=T, perl = TRUE),modelname = modelname)
+
+colnames(coefs)<- colnames(wtpvalues[[paste0("Class ",class)]])
+
+wtpvalues[[paste0("Class ",class)]] <- rbind(wtpvalues[[paste0("Class ",class)]],coefs)
+
+ # print("this is other")
+ # print(other)
+ # if(class(other) =="numeric") other<-as.data.frame(as.list(other))
+ # colnames(other) <- names(wtpvalues[[paste0("Class ",class)]])
+ # print("this is other after rename")
+ # print(other)
+ # wtpvalues[[paste0("Class ",class)]] <-rbind(wtpvalues[[paste0("Class ",class)]],other)
+ }
+
+ return(wtpvalues)
+
+}
+
+# This function lets us create output tables with texreg with objects from Apollo
+
+
+quicktexregapollo <- function(model =model, wtpest=NULL) {
+
+ modelOutput_settings = list(printPVal=T)
+
+ if (is.null(wtpest)) { estimated <- janitor::clean_names(as.data.frame(apollo_modelOutput(model, modelOutput_settings)))
+ } else{
+ estimated <- wtpest
+ colnames(estimated)<- c("estimate", "rob_s_e", "robt", "p_1_sided_2")
+
+ }
+
+
+ coefnames <- gsub(pattern = "_[a-z]$", "" ,rownames(estimated))
+
+ texout <- createTexreg(coef.names = coefnames , coef = estimated[["estimate"]] , se = estimated[["rob_s_e"]] , pvalues = estimated$p_1_sided_2,
+ gof.names = c("No Observations" , "No Respondents" , "Log Likelihood (Null)" , "Log Likelihood (Converged)") ,
+ gof = c(model[["nObsTot"]] , model[["nIndivs"]], model[["LL0"]][[1]] , model[["LLout"]][[1]] ) ,
+ gof.decimal = c(FALSE,FALSE,TRUE,TRUE)
+ )
+
+
+ return(texout)
+
+}
+
+
+
+
+
+quicktexregapollo_old <- function(model =model) {
+
+ modelOutput_settings = list(printPVal=T)
+
+ estimated <- janitor::clean_names(as.data.frame(apollo_modelOutput(model, modelOutput_settings)))
+
+
+ texout <- createTexreg(coef.names = names(model[["estimate"]]) , coef = model[["estimate"]] , se = model[["robse"]] , pvalues = estimated$p_1_sided_2,
+ gof.names = c("No Observations" , "No Respondents" , "Log Likelihood (Null)" , "Log Likelihood (Converged)") ,
+ gof = c(model[["nObsTot"]] , model[["nIndivs"]], model[["LL0"]][[1]] , model[["LLout"]][[1]] ) ,
+ gof.decimal = c(FALSE,FALSE,TRUE,TRUE)
+ )
+
+
+ return(texout)
+
+}
+
+
+
+
+#function to assign labels for data generated by SurveyEngine.
+
+ass_labels <- function(path, seelab=TRUE, lower=FALSE) {
+
+ labels <- read_excel(path = path, sheet = "dictionary", col_names = TRUE)[-2:-1,2:4] %>% rename( "Variable"=1 , "Labels"=2 , "valuelabels"=3)
+
+
+ if (lower==TRUE) labels$Variable <- tolower(labels$Variable)
+
+
+ covdata <- read_excel(path = path)
+
+
+ ## check if variables are all present
+ #test 1
+
+ cat("Number of variables in dataset: ",length(names(covdata)) ,
+ "\n Number of variables in label set:", length(labels$Variable[!is.na(labels$Variable)]), "\n")
+
+ if (length(names(covdata)) != length(labels$Variable[!is.na(labels$Variable)]) ){
+ cat("\n labels do not match, will be ignored, but make sure this is ok.
+ \n Below are the variables that are problematic. \n \n These variables exist in the dataset but not in the label set:",
+ setdiff(names(covdata) , labels$Variable[!is.na(labels$Variable)]) ,
+ "\n and these exist in the labels and not in the dataset:" ,
+ setdiff(labels$Variable[!is.na(labels$Variable)], names(covdata)))
+ }
+
+ for (vn in names(covdata)) {
+ attr(covdata[[vn]], "label") <- toString(labels[which(labels$Variable==vn),"Labels"])
+ }
+
+
+ labels$Variable <- na.locf(labels$Variable)
+ labels <- labels[!is.na(labels$Labels),]
+
+ X <- base::split(labels, labels$Variable)
+
+ Y=lapply(X, row_to_names , row_number = 1)
+
+
+ for (vn in names(covdata)) {
+
+ if (is.null(attr(covdata[[vn]], "class")) == TRUE) {
+ attr(covdata[[vn]], "class") <- "haven_labelled"
+ }
+
+
+ if (exists(vn,Y)==TRUE && nrow(Y[[vn]])>1 ) {
+
+ if(seelab==TRUE) cat("\n the variable", vn , " will be labelled \n" )
+
+ t <- as.numeric(unlist(Y[[vn]][2]))
+ names(t) <- unlist(Y[[vn]][3])
+ attr(covdata[[vn]] , "labels") <- t
+ }
+ else{ if(seelab==TRUE) cat("\n Attention: the values of the variable", vn , " will NOT be labelled \n" )}
+
+ }
+
+ return(covdata)
+
+}
+
+
+
+# function to split model into different columns for texreg
+
+subcoef <- function(condition, mname){
+
+ sub <- grep(condition,slot(mname,"coef.names"))
+
+ for (ele in c("coef.names","coef","se","pvalues")) {
+ elements<- slot(mname,ele)[sub]
+ slot(mname,ele) <- elements
+ }
+
+ slot(mname,"coef.names")<-gsub(pattern = condition,replacement = "",x =slot(mname,"coef.names") )
+
+ slot(mname,"model.name")<-gsub("_","",condition)
+
+
+ return(mname)
+
+}
+
+#ff<- subcoef(mname=rpl,condition = "mean_")
+
+
+
+remGOF<- function(models){
+
+ gof<- function(m){
+slot(m,"gof.names")<- character(0)
+slot(m,"gof")<- numeric(0)
+slot(m,"gof.decimal")<- logical(0)
+
+return(m)
+}
+
+return(purrr::map(models,gof))
+
+}
+
+#tes <- remGOF(rpl_cols[2:5])
+
+
+
+uf <- function(var, int=NULL, pre){
+
+
+ par <- paste0("b_",var)
+ var<-paste0(pre,var)
+ int2<-NULL
+
+ main <- paste(paste(par,var,sep = "*"),collapse = "+")
+ form <-main
+ parnames<-par
+
+
+ if (!is.null(int)) {
+ int2 <- paste(paste(paste(par, int,sep = "X"),var,int,sep = "*"),collapse = "+")
+
+ form <- paste(main,int2,sep = "+")
+
+
+ parnames<-c(par,paste(par, int,sep = "X"))
+ }
+
+
+ par2<-rep(0,length(parnames))
+ names(par2)<-parnames
+
+
+ alls <- list(form,par2)
+
+ return(alls)
+
+}
+