##### Project Name and other inputs ######### server <- "https://central.server" project <- "https://central.server/v1/projects/21/forms/22M10512.svc" ## OData Link username <- "UserName" password <- "Password" timezone <- "Asia/Calcutta" project_name <- "ProjectName" ## Needed for output folder creation output_folder <- "/path/to/output/folder/" ## ############################################## Script if (file.exists(project_name)){ setwd(file.path(output_folder, project_name)) } else { dir.create(file.path(output_folder, project_name)) setwd(file.path(output_folder, project_name)) } ##### Function to load/install libraries loadpkg <- function(toLoad){ for(lib in toLoad){ if(! lib %in% installed.packages()[,1]) { install.packages(lib, repos='http://cran.rstudio.com/') } suppressMessages( library(lib, character.only=TRUE) ) } } loadpkg(c("dplyr", "ReporteRs", "readxl", "pollster", "rio" , "knitr", "openxlsx", "ruODK", "gridExtra", "stringr", "ggplot2", "repvisforODK", "plotly", "htmlwidgets", "plyr", "tableHTML", "sjPlot", "writexl")) source("https://pulsefe.org/R/pulseplot.R") ### load function to split multi-sellect response # Set project project <- project # `ruODK` users only need default settings to their ODK Central: ru_setup(url = server, un = username, pw = password, svc = project, tz = timezone) # File attachment download location loc <- fs::path("media") Sys.sleep(5) ## 5 Sec wait # GET data table fq_data <- ruODK::odata_submission_get( table = fq_svc$name[1], local_dir = loc, wkt=TRUE) # repvisforODK setup and get df_schema repvisforODK::setup_ruODK(svc = project, un = username, pw = password, tz = timezone, verbose = FALSE) # fq_form_schema <- ruODK::form_schema() df_schema <- ruODK::form_schema_ext() ####### function "odk_remove_group_names" with removed group-names odk_remove_group_names <- function(df_schema, fq_data){ dfvarname <- c() for (x in 1: nrow(df_schema)) { splt <- strsplit(df_schema$path[x], split = "/") splt <- splt[[1]] element <- gsub("-","_", splt[length(splt)]) dfvarname[x] <- element } df_schema_mod <- df_schema df_schema_mod$ruodk_name <- dfvarname df2 <- df_schema_mod[!(df_schema_mod$type=="structure" ),] varname <- df2$ruodk_name df3 = fq_data[,(2:(ncol(fq_data)-11) )] colnames(df3) <- varname # seperate server added data dmeta = fq_data[,(ncol(fq_data)-12+2):ncol(fq_data)] df <- cbind(df3,dmeta) ##### Remove all columns with d_ cnames <- colnames(df3) dlist <- which(startsWith(cnames, "d_")) dlist_1 <- dlist[1] dlist_f <- length(dlist) + dlist_1 - 1 d1 <- df3[-c(dlist_1:dlist_f)] ## all without "d_" d2 <- df3[c(dlist_1:dlist_f)] ## all "d_" cols d2start <- df3[1:4] d2 <- cbind(d2start,d2,dmeta) d1 <- cbind(d1, dmeta) ## List all outputs list(data = df, data_r = d1, data_d = d2, scema = df_schema_mod) } t <- odk_remove_group_names(df_schema, fq_data) data <- t$data schema <- t$scema data_d <- t$data_d data_r <- t$data_r # Find total submissions n <- nrow(data) ## list single choice questions singlec <- names(single_choice_question_pie(df = data_r, df_schema_ext = schema, choice_col = 'choices_english', label_col = 'label_english')) multic <- names(multiple_choice_question_bar(df = data_r, df_schema_ext = schema, choice_col = 'choices_english', label_col = 'label_english')) ### Spilt select multiple questions data_o <- data_r x <- 1 while (x <= length(multic)) { # z dataframe with multiselect split y <- func_pulse_multisplit(multic[x], data_o, schema) z <- y$raw z[z=="TRUE"]<- 1 z[z=="FALSE"]<- 0 st <- paste0(multic[x],"/",names(z), sep="") ## colnames(z) <- st indexvar <- which(colnames(data_o) == multic[x]) lefttable <- data_o[1:indexvar] righttable <- data_o[(indexvar+1):ncol(data_o)] data_o <- cbind(lefttable,z,righttable) x = x + 1 } ############ Add Variable Names to col heads ## Function strip HTML cleanHTML <- function(htmlString) { t <- gsub("<.*?>", "", htmlString) t <- gsub("[\r\n]", " ", t) t <- gsub("'", "", t) t <- str_trunc(t, 200, side = c("center"), ellipsis = "...") return(t) } ## Data frame for labeled values and variables data_OL <- data_o varlabels <- schema$label_english varnames <- schema$ruodk_name ## replace NA by 0 in varlabels vector varlabels[is.na(varlabels)] <- 0 ## Name variables as per lables in the data_OL df x <- 1 while (x <= length(varlabels)) { if ((varlabels[x]) != 0){names(data_OL)[names(data_OL) == varnames[x]] <- trimws(cleanHTML(varlabels[x]))} x = x + 1 } ######## Multi select split header - add option text in data_OL x <- 1 while (x <= length(multic)) { s <- schema %>% filter(ruodk_name == multic[x]) sx <- s$choices_english sxv <- sx[[1]]$values sxl <- sx[[1]]$labels y <- 1 while (y <= length(sxv)) { num <- which(colnames(data_OL) == paste0(multic[x],"/",sxv[y])) ## if (sxl[y] == "") { colnames(data_OL)[num] <- paste0(multic[x],"/",sxv[y]) ## } else { colnames(data_OL)[num] <- paste0(multic[x],"/",sxl[y]) ## } # print(paste("X Loop: ",x, " | Y loop: ", y)) y = y + 1 } x = x + 1 } ##### Single select option text on data_OL x <- 1 while (x <= length(singlec)) { s <- schema %>% filter(ruodk_name == singlec[x]) sx <- s$choices_english sxv <- sx[[1]]$values sxl <- sx[[1]]$labels sx <- as.data.frame(cbind(sxv,sxl)) colnames(sx) <- c("val","label") sx <- sx[!duplicated(sx), ] index <- which(colnames(data_o) == singlec[x]) colvector <- data_OL[index] coln <- colnames(colvector) colnames(colvector) <- c("val") dft <- left_join(colvector, sx, by="val") outvec <- dft$label data_OL[, index] <- outvec #print(x) x = x + 1 } ############ SPSS Script Build varlabels <- schema$label_english varnames <- schema$ruodk_name varlables_spss <- cleanHTML(schema$label_english) varlables_spss[is.na(varlables_spss)] <- "" spsslables <- paste0(varnames, " ", varlables_spss) dfspsslables <- data.frame(varname = varnames, lables = spsslables) outputvars <- colnames(data_o) outputvars <- data.frame(varname = outputvars) xtemp <- left_join(outputvars, dfspsslables, by = "varname") xtemp <- cbind(spss = "VARIABLE LABELS ", xtemp) ##### Replacing multi-select option variable names veclabels <- xtemp$lables vecmulti <- colnames(data_o) v <- vecmulti %>% str_subset(pattern = "/") ## x <- 1 while (x <= length(v)) { strs <- str_split(v[x], "/") ## strs <- strs[[1]] indexinvecmulti <- which(vecmulti == paste0(v[x])) s <- schema %>% filter(ruodk_name == strs[1]) sx <- s$choices_english sxv <- sx[[1]]$values sxl <- sx[[1]]$labels veclabels[indexinvecmulti] <- paste0(v[x], " ", sxl[as.integer(strs[2])]) x = x + 1 } xtemp <- cbind(xtemp[1:2], veclabels) #### Write SPSS Syntax File VARIABLE LABELS text <- paste0(xtemp$spss, gsub("/",".",xtemp$varname), " '", cleanHTML(xtemp$veclabels), "'.") cat(text, file = paste0(output_folder, project_name, "/spss_syntax.sps"), sep = "\n") paste0(project_name, "/data_spss.xlsx") #### Append SPSS Syntax File VALUE LABELS t <- "" x <- 1 while (x <= length(singlec)) { s <- schema %>% filter(ruodk_name == singlec[x]) sx <- s$choices_english sxv <- sx[[1]]$values sxl <- sx[[1]]$labels sxl <- cleanHTML(sxl) t1 <- paste0("VALUE LABELS ",singlec[x]) t2 <- paste0("\t", sxv, " '", sxl, "'", collapse = "\n" ) text2 <- paste0(t1, "\n", t2, sep = "\n" ) cat("\n", file = paste0(output_folder, project_name, "/spss_syntax.sps"), sep = "\n", append=TRUE) cat(text2, file = paste0(output_folder, project_name, "/spss_syntax.sps"), append=TRUE) cat(". \n", file = paste0(output_folder, project_name, "/spss_syntax.sps"), append=TRUE) x = x + 1 } ## SPSS Data-Frame | Align variable names with syntax (replace / with . for var names in) data_spss <- data_o names <- colnames(data_spss) names <- gsub("/",".",names) colnames(data_spss) <- names ## Write data files write_xlsx(data_o, path = paste0(output_folder, project_name, "/data_out.xlsx")) write_xlsx(data_d, path = paste0(output_folder, project_name, "/data_out_d.xlsx")) write_xlsx(data_OL, path = paste0(output_folder, project_name, "/data_out_L.xlsx")) write_xlsx(data_spss, path = paste0(output_folder, project_name, "/spss_data.xlsx"))