From 1c393738ef284695991e5caa36faee44b3966fed Mon Sep 17 00:00:00 2001 From: Edouard-Legoupil Date: Tue, 16 Jul 2019 11:08:22 +0300 Subject: [PATCH] fix issues for CRAN Registration... --- .Rbuildignore | 1 + DESCRIPTION | 76 +- NAMESPACE | 25 +- R/kobo_anonymisation_report.R | 26 +- R/kobo_anonymise.R | 2 +- R/kobo_atlas_report.R | 4 +- R/kobo_bar_multi.R | 187 --- R/kobo_bar_multi_facet.R | 221 ---- R/kobo_bar_multi_print.R | 122 -- R/kobo_bar_one.R | 161 --- R/kobo_bar_one_facet.R | 230 ---- R/kobo_bar_one_facet_print.R | 116 -- R/kobo_bar_one_print.R | 119 -- R/kobo_boxplot_facet.R | 121 -- R/kobo_clean.R | 11 +- R/kobo_cluster_report.R | 34 +- R/kobo_consolidateone.R | 152 +-- R/kobo_correlation.R | 125 -- R/kobo_correlation_analysis.R | 80 +- R/kobo_corrplot.R | 29 - R/kobo_create_indicators.R | 24 +- R/kobo_crunching_report.R | 62 +- R/kobo_data_downloader.R | 134 +- R/kobo_ddi.R | 118 +- R/kobo_dico.R | 20 +- R/kobo_dummy.R | 64 +- R/kobo_edit_form.R | 38 +- R/kobo_encode.R | 14 +- R/kobo_encode_repeat.R | 90 +- R/kobo_form.R | 114 +- R/kobo_forminfo.R | 93 +- R/kobo_get_begin_repeat.R | 16 +- R/kobo_get_config.R | 13 +- R/kobo_get_dataframes_levels.R | 14 +- R/kobo_histo.R | 115 -- R/kobo_histo_print.R | 72 -- R/kobo_indicator.R | 24 +- R/kobo_label.R | 10 +- R/kobo_left_align.R | 3 + R/kobo_load_data.R | 34 +- R/kobo_prediction_report.R | 12 +- R/kobo_prepare_form.R | 14 +- R/kobo_projectinit.R | 92 +- R/kobo_question.R | 32 +- R/kobo_registration.R | 50 +- R/kobo_samplingframe.R | 20 +- R/kobo_shiny.R | 4 +- R/kobo_split_multiple.R | 4 +- R/kobo_surveyname.R | 34 - R/kobo_text_cloud.R | 31 - R/kobo_to_xlsform.R | 52 +- R/kobo_trend.R | 99 -- R/kobo_trend_report.R | 32 - R/kobo_weight.R | 6 +- R/shortcuts.R | 45 +- R/utils.R | 210 ++- R/utils2.R | 195 +-- R/zzz.R | 31 + README.md | 5 + _pkgdown.yml | 20 +- docs/articles/Anonymisation.html | 2 +- docs/articles/Cleaning.html | 2 +- docs/articles/Console.html | 2 +- docs/articles/Crunching.html | 2 +- docs/articles/Dissiminating.html | 2 +- docs/articles/Getting_data.html | 2 +- docs/articles/Predicting_Scoring.html | 2 +- docs/articles/Sampling.html | 2 +- docs/articles/Troubleshooting.html | 2 +- docs/articles/xlsform.html | 2 +- docs/index.html | 8 + docs/reference/code/run-analysis.R | 22 +- .../code/shiny_app/app_main_koboloadeR.R | 1141 ++++++++++++----- docs/reference/data/form.xls | Bin 6144 -> 7168 bytes docs/reference/format_si.html | 2 +- docs/reference/index.html | 123 +- docs/reference/kobo_anonymise.html | 8 +- docs/reference/kobo_atlas_report.html | 12 +- .../kobo_check_project_configuration.html | 218 ++++ docs/reference/kobo_clean.html | 12 +- docs/reference/kobo_crunching_report.html | 46 +- docs/reference/kobo_dummy.html | 8 +- docs/reference/kobo_edit_form.html | 2 +- docs/reference/kobo_form.html | 12 +- docs/reference/kobo_getMainDirectory.html | 4 - .../reference/kobo_get_dataframes_levels.html | 10 +- docs/reference/kobo_label.html | 8 +- docs/reference/kobo_left_align.html | 16 +- docs/reference/kobo_prediction_report.html | 12 +- docs/reference/kobo_projectinit.html | 4 - docs/reference/kobo_samplingframe.html | 16 +- docs/reference/kobo_shiny.html | 2 +- docs/reference/kobo_surveyname.html | 2 +- docs/reference/kobo_time_parser.html | 2 +- docs/reference/kobo_time_parser_UTC.html | 5 - docs/reference/kobo_to_xlsform.html | 14 +- docs/reference/kobo_trend_report.html | 2 +- docs/reference/psum.html | 4 + docs/reference/round2.html | 8 +- docs/sitemap.xml | 46 +- ...w.png => KoboloadeR_User_Journey_Flow.png} | Bin inst/script/koboloadeR.png | Bin 0 -> 98036 bytes man/kobo_anonymise.Rd | 4 +- man/kobo_atlas_report.Rd | 6 +- man/kobo_bar_multi.Rd | 26 - man/kobo_bar_multi_facet.Rd | 26 - man/kobo_bar_multi_print.Rd | 28 - man/kobo_bar_one.Rd | 26 - man/kobo_bar_one_facet.Rd | 26 - man/kobo_bar_one_facet_print.Rd | 28 - man/kobo_bar_one_print.Rd | 28 - man/kobo_boxplot_facet.Rd | 28 - man/kobo_clean.Rd | 6 +- man/kobo_correlation.Rd | 28 - man/kobo_corrplot.Rd | 27 - man/kobo_dummy.Rd | 4 +- man/kobo_form.Rd | 8 +- man/kobo_histo.Rd | 26 - man/kobo_histo_print.Rd | 28 - man/kobo_label.Rd | 4 +- man/kobo_left_align.Rd | 5 + man/kobo_prediction_report.Rd | 6 +- man/kobo_samplingframe.Rd | 11 +- man/kobo_shiny.Rd | 2 +- man/kobo_surveyname.Rd | 26 - man/kobo_text_cloud.Rd | 29 - man/kobo_time_parser.Rd | 26 - man/kobo_time_parser_UTC.Rd | 3 - man/kobo_to_xlsform.Rd | 2 + man/kobo_trend.Rd | 32 - man/kobo_trend_report.Rd | 27 - man/psum.Rd | 2 + man/round2.Rd | 4 +- vignettes/Anonymisation.Rmd | 2 +- vignettes/Cleaning.Rmd | 2 +- vignettes/Console.Rmd | 2 +- vignettes/Crunching.Rmd | 2 +- vignettes/Dissiminating.Rmd | 2 +- vignettes/Getting_data.Rmd | 2 +- vignettes/Predicting_Scoring.Rmd | 2 +- vignettes/Sampling.Rmd | 2 +- vignettes/Troubleshooting.Rmd | 2 +- vignettes/xlsform.Rmd | 2 +- 143 files changed, 2299 insertions(+), 3944 deletions(-) delete mode 100644 R/kobo_bar_multi.R delete mode 100644 R/kobo_bar_multi_facet.R delete mode 100644 R/kobo_bar_multi_print.R delete mode 100644 R/kobo_bar_one.R delete mode 100644 R/kobo_bar_one_facet.R delete mode 100644 R/kobo_bar_one_facet_print.R delete mode 100644 R/kobo_bar_one_print.R delete mode 100644 R/kobo_boxplot_facet.R delete mode 100644 R/kobo_correlation.R delete mode 100644 R/kobo_corrplot.R delete mode 100644 R/kobo_histo.R delete mode 100644 R/kobo_histo_print.R delete mode 100644 R/kobo_surveyname.R delete mode 100644 R/kobo_text_cloud.R delete mode 100644 R/kobo_trend.R delete mode 100644 R/kobo_trend_report.R create mode 100644 R/zzz.R create mode 100644 docs/reference/kobo_check_project_configuration.html rename inst/script/{KoboloadeR User Journey Flow.png => KoboloadeR_User_Journey_Flow.png} (100%) create mode 100644 inst/script/koboloadeR.png delete mode 100644 man/kobo_bar_multi.Rd delete mode 100644 man/kobo_bar_multi_facet.Rd delete mode 100644 man/kobo_bar_multi_print.Rd delete mode 100644 man/kobo_bar_one.Rd delete mode 100644 man/kobo_bar_one_facet.Rd delete mode 100644 man/kobo_bar_one_facet_print.Rd delete mode 100644 man/kobo_bar_one_print.Rd delete mode 100644 man/kobo_boxplot_facet.Rd delete mode 100644 man/kobo_correlation.Rd delete mode 100644 man/kobo_corrplot.Rd delete mode 100644 man/kobo_histo.Rd delete mode 100644 man/kobo_histo_print.Rd delete mode 100644 man/kobo_surveyname.Rd delete mode 100644 man/kobo_text_cloud.Rd delete mode 100644 man/kobo_time_parser.Rd delete mode 100644 man/kobo_trend.Rd delete mode 100644 man/kobo_trend_report.Rd diff --git a/.Rbuildignore b/.Rbuildignore index 628f1d0..0fadfe9 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -2,6 +2,7 @@ ^\.Rproj\.user$ ^\.Rprofile$ ^appveyor\.yml$ +^codecov\.yml$ ^\.travis\.yml$ ^cran-comments\.md$ ^_config\.yml$ diff --git a/DESCRIPTION b/DESCRIPTION index 0c8921e..81aac07 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Package: koboloadeR Type: Package Title: A metapackage for Survey Data Crunching Version: 0.1.6 -Authors@R: c(person("Edouard", "Legoupil", role = c("aut", "cre"), email = "legoupil@unhcr.org"), +Authors@R: c(person("Edouard", "Legoupil", role = c("aut", "cre"), email = "edouard.legoupil@gmail.com"), person("Maher", "Daoud", role = "aut", email = "daoudma@unhcr.org"), person("Elliott", "Messeiller", role = "ctb", email = "elliott.messeiller@acted.org"), person("Damien", "Seite", role = "ctb", email = "damien.seite@eleve.ensai.fr")) @@ -11,47 +11,67 @@ Description: This package facilitates the data crunching & exploration for datas License: GPL-3 LazyData: TRUE Depends: - utils, - data.table (>= 1.9.4), - curl, - RCurl, - httr, - bit64, - readr, + utils +Imports: + ggplot2, + DDIwR, DT, - plyr, - dplyr, - tidyr, + glue, + ggthemes, + ggrepel, + httr, + haven, + OpenRepGrid, + plyr, + RCurl, readxl, - ggplot2, reshape2, - digest, - sdcMicro, + readr, rJava, - xlsx, - haven, + RODBC, + rstudioapi, + shiny, shinydashboard, shinyalert, - ape, - sp, - gdata, - rhandsontable, + survey, stringr, stringi, + sp, simFrame, - classInt, - ggrepel, - DDIwR, + sdcMicro, truncnorm, - OpenRepGrid + xlsx, + tidyr Suggests: - shiny, + ape, + bit64, + classInt, + curl, + car, + corrplot, + data.table, + digest, + dplyr, + forcats, + graphics, + gridExtra, + hexbin, + kableExtra, + knitr, + koRpus, + lubridate, + rmarkdown, + RColorBrewer, + rhandsontable, + scales, + tables, + vcd, + viridis, testthat (>= 2.1.0), - utils, - knitr + zoo URL: https://github.com/unhcr/koboloadeR/docs BugReports: https://github.com/unhcr/koboloadeR/issues RoxygenNote: 6.1.1 -VignetteBuilder: utils +VignetteBuilder: knitr Encoding: UTF-8 SystemRequirements: Java (>= 8) diff --git a/NAMESPACE b/NAMESPACE index 7a1eea3..e77c97a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,22 +6,12 @@ export(kobo_anonymise) export(kobo_apps) export(kobo_arrange_variablename) export(kobo_atlas_report) -export(kobo_bar_multi) -export(kobo_bar_multi_facet) -export(kobo_bar_multi_print) -export(kobo_bar_one) -export(kobo_bar_one_facet) -export(kobo_bar_one_facet_print) -export(kobo_bar_one_print) -export(kobo_boxplot_facet) export(kobo_check_analysis_plan) +export(kobo_check_project_configuration) export(kobo_clean) export(kobo_cluster_report) export(kobo_consolidateone) -export(kobo_correlation) export(kobo_correlation_analysis) -export(kobo_check_project_configuration) -export(kobo_corrplot) export(kobo_create_indicators) export(kobo_crunching_report) export(kobo_data_downloader) @@ -40,8 +30,6 @@ export(kobo_get_begin_repeat) export(kobo_get_config) export(kobo_get_dataframes_levels) export(kobo_get_theme) -export(kobo_histo) -export(kobo_histo_print) export(kobo_indicator) export(kobo_label) export(kobo_left_align) @@ -60,13 +48,8 @@ export(kobo_samplingframe) export(kobo_shiny) export(kobo_split_multiple) export(kobo_submission_count) -export(kobo_surveyname) -export(kobo_text_cloud) -export(kobo_time_parser) export(kobo_time_parser_UTC) export(kobo_to_xlsform) -export(kobo_trend) -export(kobo_trend_report) export(kobo_unhcr_style_bar) export(kobo_unhcr_style_histo) export(kobo_unhcr_style_map) @@ -76,13 +59,7 @@ export(ltbl) export(multresponse) export(psum) export(round2) -import(DT) import(RCurl) -import(bit64) -import(data.table) -import(dplyr) -import(httr) import(plyr) import(readr) import(readxl) -import(tidyr) diff --git a/R/kobo_anonymisation_report.R b/R/kobo_anonymisation_report.R index c7ca3d7..128768b 100644 --- a/R/kobo_anonymisation_report.R +++ b/R/kobo_anonymisation_report.R @@ -21,9 +21,9 @@ #' #' -kobo_anonymisation_report <- function(frame, form = "form.xls", app="console") { +kobo_anonymisation_report <- function(frame, form = "form.xls", app = "console") { tryCatch({ - if(app=="shiny"){ + if (app == "shiny") { progress <- shiny::Progress$new() progress$set(message = "Generating crunching report in progress...", value = 0) on.exit(progress$close()) @@ -40,9 +40,9 @@ kobo_anonymisation_report <- function(frame, form = "form.xls", app="console") { mainDir <- kobo_getMainDirectory() form_tmp <- paste(mainDir, "data", form, sep = "/", collapse = "/") - dico <- read.csv(paste0(mainDir,"/data/dico_",form,".csv"), encoding = "UTF-8", na.strings = "") + dico <- utils::read.csv(paste0(mainDir,"/data/dico_",form,".csv"), encoding = "UTF-8", na.strings = "") framename <- deparse(substitute(frame)) - write.csv(frame, paste0(mainDir,"/data/anomreport-",framename,".csv"), row.names = FALSE, na = "") + utils::write.csv(frame, paste0(mainDir,"/data/anomreport-",framename,".csv"), row.names = FALSE, na = "") ## Check that all those selectedVars are in the frame #### check <- as.data.frame(names(frame)) @@ -51,12 +51,12 @@ kobo_anonymisation_report <- function(frame, form = "form.xls", app="console") { #### Check presence of variable for anom plan... - if(app=="shiny"){ + if (app == "shiny") { progress$set(message = "Check presence of variable for anom plan...") updateProgress() } selected.key <- dico[ which(dico$anonymise == "key" & dico$type == "select_one" ) , ] - selected.key <- join(x = selected.key, y = check, by = "fullname", type = "left") + selected.key <- plyr::join(x = selected.key, y = check, by = "fullname", type = "left") selected.key <- selected.key[!is.na(selected.key$id), ] if ( nrow(selected.key) == 0) { @@ -64,11 +64,11 @@ kobo_anonymisation_report <- function(frame, form = "form.xls", app="console") { return(structure("You have not selected key variables for your dataset!", class = "try-error")) } else { selected.sensible <- dico[ which(dico$anonymise == "sensitive" & dico$type == "select_one" ), ] - selected.sensible <- join(x = selected.sensible, y = check, by = "fullname", type = "left") + selected.sensible <- plyr::join(x = selected.sensible, y = check, by = "fullname", type = "left") selected.sensible <- selected.sensible[!is.na(selected.sensible$id), ] selected.num <- dico[ which(dico$anonymise == "outlier" ), ] - selected.num <- join(x = selected.num, y = check, by = "fullname", type = "left") + selected.num <- plyr::join(x = selected.num, y = check, by = "fullname", type = "left") selected.num <- selected.num[!is.na(selected.num$id), ] @@ -113,10 +113,10 @@ kobo_anonymisation_report <- function(frame, form = "form.xls", app="console") { cat("## Provide below the name of the form in xsl form - format should be xls not xlsx", file = reportanom , sep = "\n", append = TRUE) cat("form <- \"form.xls\"", file = reportanom , sep = "\n", append = TRUE) #cat("kobo_dico(form)", file = reportanom , sep = "\n", append = TRUE) - cat("dico <- read.csv(paste0(mainDirroot,\"/data/dico_\",form,\".csv\"), encoding = \"UTF-8\", na.strings = \"\")", file = reportanom , sep = "\n", append = TRUE) + cat("dico <- utils::read.csv(paste0(mainDirroot,\"/data/dico_\",form,\".csv\"), encoding = \"UTF-8\", na.strings = \"\")", file = reportanom , sep = "\n", append = TRUE) cat("\n", file = reportanom , sep = "\n", append = TRUE) - cat(paste0("dataanom <- read.csv(paste0(mainDirroot,\"/data/anomreport-",framename,".csv\"), sep = \",\", encoding = \"UTF-8\", na.strings = \"\")"), file = reportanom , sep = "\n", append = TRUE) + cat(paste0("dataanom <- utils::read.csv(paste0(mainDirroot,\"/data/anomreport-",framename,".csv\"), sep = \",\", encoding = \"UTF-8\", na.strings = \"\")"), file = reportanom , sep = "\n", append = TRUE) # cat(paste0("dataanom <- read.csv(paste0(mainDirroot,\"/data/anomreport-",framename,".csv\") , sep = \";\", encoding = \"UTF-8\", na.strings = \"\")", file = reportanom , sep = "\n", append = TRUE)) @@ -134,16 +134,16 @@ kobo_anonymisation_report <- function(frame, form = "form.xls", app="console") { cat("\n", file = reportanom , sep = "\n", append = TRUE) cat(" #### Remove ###############", file = reportanom , sep = "\n", append = TRUE) cat("selected.key <- dico[ which(dico$anonymise == \"key\" & dico$type == \"select_one\" ) , ]", file = reportanom , sep = "\n", append = TRUE) - cat("selected.key <- join(x = selected.key, y = check, by = \"fullname\", type = \"left\")", file = reportanom , sep = "\n", append = TRUE) + cat("selected.key <- plyr::join(x = selected.key, y = check, by = \"fullname\", type = \"left\")", file = reportanom , sep = "\n", append = TRUE) cat("selected.key <- selected.key[!is.na(selected.key$id), ]", file = reportanom , sep = "\n", append = TRUE) cat("\n", file = reportanom , sep = "\n", append = TRUE) cat("\n", file = reportanom , sep = "\n", append = TRUE) cat("selected.sensible <- dico[ which(dico$anonymise == \"sensitive\" & dico$type == \"select_one\" ), ]", file = reportanom , sep = "\n", append = TRUE) - cat("selected.sensible <- join(x = selected.sensible, y = check, by = \"fullname\", type = \"left\")", file = reportanom , sep = "\n", append = TRUE) + cat("selected.sensible <- plyr::join(x = selected.sensible, y = check, by = \"fullname\", type = \"left\")", file = reportanom , sep = "\n", append = TRUE) cat("selected.sensible <- selected.sensible[!is.na(selected.sensible$id), ]", file = reportanom , sep = "\n", append = TRUE) cat("\n", file = reportanom , sep = "\n", append = TRUE) cat("selected.num <- dico[ which(dico$anonymise == \"outlier\" ), ]", file = reportanom , sep = "\n", append = TRUE) - cat("selected.num <- join(x = selected.num, y = check, by = \"fullname\", type = \"left\")", file = reportanom , sep = "\n", append = TRUE) + cat("selected.num <- plyr::join(x = selected.num, y = check, by = \"fullname\", type = \"left\")", file = reportanom , sep = "\n", append = TRUE) cat("selected.num <- selected.num[!is.na(selected.num$id), ]", file = reportanom , sep = "\n", append = TRUE) cat("\n", file = reportanom , sep = "\n", append = TRUE) cat("\n", file = reportanom , sep = "\n", append = TRUE) diff --git a/R/kobo_anonymise.R b/R/kobo_anonymise.R index 220daa5..4d37109 100644 --- a/R/kobo_anonymise.R +++ b/R/kobo_anonymise.R @@ -30,7 +30,7 @@ #' } #' #' -#' @param kobo or odk dataset to use +#' @param frame dataset to use #' @param dico Generated from kobo_dico function #' #' @author Edouard Legoupil diff --git a/R/kobo_atlas_report.R b/R/kobo_atlas_report.R index 672764a..685c163 100644 --- a/R/kobo_atlas_report.R +++ b/R/kobo_atlas_report.R @@ -7,9 +7,9 @@ #' #' #' -#' @param kobo or odk dataset to use +#' @param frame odk dataset to use #' @param dico Generated from kobo_dico function -#' @param map equaly mappoly or mappoint depending on the type of visualisation expected - polygons or points +#' @param mappoly or mappoint depending on the type of visualisation expected - polygons or points #' #' @author Edouard Legoupil #' diff --git a/R/kobo_bar_multi.R b/R/kobo_bar_multi.R deleted file mode 100644 index 36a521f..0000000 --- a/R/kobo_bar_multi.R +++ /dev/null @@ -1,187 +0,0 @@ -#' @name kobo_bar_multi -#' @rdname kobo_bar_multi -#' @title Generate bar Chart - frequency - for select_multiple questions -#' -#' @description Automatically generate bar chart for each of the select_multiple question in the dataset. ggplot2 is used. -#' -#' -#' @param mainDir Path to the project's working directory: mainly for proper shiny app path -#' -#' -#' @author Edouard Legoupil, Elliott Messeiller -#' -#' @examples -#' kobo_bar_multi() -#' -#' @export kobo_bar_multi -#' -#' @examples -#' \dontrun{ -#' kobo_bar_multi() -#' } -#' -#' - -kobo_bar_multi <- function(mainDir='') { - - # Making your life easier by finding the dico and data from 0-config.R (created during kobo_project_config()) - if (mainDir==''){ - mainDir <- getwd() - } - - source(paste0(mainDir,"/code/0-config.R"), local=TRUE) - - # List of select_multiple questions and choices - selectdf <- dico[dico$type == "select_multiple", c("fullname","listname","label","name","disaggregation"), ] - - - ### Verify that those variables are actually in the original dataframe - check <- as.data.frame(names(data)) - names(check)[1] <- "fullname" - check$id <- row.names(check) - selectdf <- join(x=selectdf, y=check, by="fullname", type="left") - selectdf <- selectdf[!is.na(selectdf$id), ] - - if (nrow(selectdf)==0){ - cat("There's no select_multiple questions \n") - } else{ - - - selectmulti <- as.character(selectdf[, c("fullname")]) - data.selectmulti <- data [selectmulti ] - data.selectmulti <- kobo_label(data.selectmulti, dico) - - listmulti <- dico[dico$type=="select_multiple_d", c("listname","label","name","fullname","disaggregation", "qlevel")] - selectdf1 <- as.data.frame(unique(selectdf$listname)) - names(selectdf1)[1] <- "listname" - listmulti <- join(x=listmulti, y=selectdf1, by="listname", type="left") - - listmultichoice <- dico[dico$type=="select_multiple", c("listname","label","name","fullname","disaggregation","labelchoice")] - - - for (i in 1:nrow(listmulti) ) { - listloop <- as.character(listmulti[i,1]) - listlabel <- as.character(listmulti[i,2]) - listfullname <- as.character(listmulti[i,"fullname"]) - - ### select variable for a specific multiple questions - - - ## Check that those variable are in the dataset - selectdf <- dico[dico$type=="select_multiple" & dico$listname==listloop & dico$qlevel==listfullname , c("fullname","listname","label","name","disaggregation","labelchoice")] - selectdf2 <- join(x=selectdf, y=check, by="fullname", type="left") - selectdf2 <- selectdf2[!is.na(selectdf2$id), ] - - listlabelchoice <- as.character(selectdf2[,"labelchoice"]) - ordinal <- as.character(dico[dico$type=="select_multiple_d" & dico$listname==listloop,c("ordinal")]) - - - - # If no answers to this question, passing to the next select_multiple - if (nrow(selectdf2)==0){ cat("passing \n") - } - else { - - # Listing the choices to the question - selectmultilist <- as.character(selectdf2[, c("fullname")]) - - ## Reshape answers - # Selecting only the answers to this question - data.selectmultilist <- data.selectmulti[selectmultilist] - #Getting ride of unselected choices - data.selectmultilist <- data.selectmultilist[, colSums(!is.na(data.selectmultilist)) != 0] - - - if (ncol(data.selectmultilist)==0){ cat("passing \n") - } - else{ - - - names(data.selectmultilist) <- listlabelchoice - - - - - #Count total answer (for the survey) and answered to this question - - totalanswer <- nrow(data.selectmulti) - count_replied <- as.numeric(sum(!is.na(data.selectmultilist[,1 ]))) - - - ## subsetting those who replied - - percentresponse <- paste(round((count_replied/totalanswer)*100,digits=2),"%",sep="") - - if (usedweight=="sampling_frame"){ - data.selectmultilist$weight <- data$weight - meltdata <- melt(data.selectmultilist,id="weight") - meltdata$value <- as.numeric(meltdata$value) - - castdata <- as.data.frame(table(meltdata[,c("value","variable","weight")])) - castdata$Freq <- as.numeric(as.character(castdata$Freq)) - castdata$weight <- as.numeric(as.character(castdata$weight)) - castdata$freqper <- round((castdata$Freq*castdata$weight)/count_replied,digits=2) - } - else{ - data.selectmultilist$id <- rownames(data.selectmultilist) - meltdata <- melt(data.selectmultilist,id="id") - meltdata$value <- as.numeric(meltdata$value) - - castdata <- as.data.frame(table(meltdata[,c("value","variable")])) - castdata$Freq <- as.numeric(as.character(castdata$Freq)) - castdata$freqper <- round((castdata$Freq)/count_replied,digits=2) - - } - castdata <- castdata[castdata$Freq!=0, ] - #castdata <- dcast(meltdata, value~variable, fun.aggregate = length) - - #levels(castdata$Var1) - castdata <- castdata[castdata$value!=0, ] - castdata<- ddply(castdata, "variable",numcolwise(sum)) - - - - #castdata$variable<-factor(castdata$variable, levels = castdata$variable[order(castdata$freqper)]) - - castdata <- arrange(castdata,freqper) - - castdata$variable = str_wrap(castdata$variable,width=15) - castdata$variable <- factor(castdata$variable, levels=castdata$variable) - - - theme_set(theme_gray(base_size = 20)) - - - ggplot(castdata, aes(x=variable, y=freqper)) + - geom_bar(fill="#2a87c8",colour="#2a87c8",stat = "identity") + - geom_text(aes(label=paste(round(freqper*100),"%",sep=""), hjust = -0.2))+ - xlab("") + ylab("")+ - scale_y_continuous(labels=percent, limits=c(0,1))+ - scale_fill_brewer("PuBu")+ - coord_flip()+ - ggtitle(str_wrap(listlabel,width=50))+ - theme(plot.title=element_text(face="bold", size=22), - plot.background = element_rect(fill = "transparent",colour = NA)) - ggsave(filename=paste(mainDir, "/out/bar_multi/bar_multi_",listfullname,".png",sep=""), width=10, height=10,units="in", dpi=300) - - cat(paste0("Generated bar chart for question: ", listlabel , "\n")) - } - } - - - - } - } - - cat(" \n") - cat(" \n") - cat(" ################################################################\n") - cat(" # The bar charts for select_mutliple questions were generated! #\n") - cat(" # You can find them in the folder 'out/bar_multi'! #\n") - cat(" ################################################################\n") - - - - -} -NULL diff --git a/R/kobo_bar_multi_facet.R b/R/kobo_bar_multi_facet.R deleted file mode 100644 index a9e0c92..0000000 --- a/R/kobo_bar_multi_facet.R +++ /dev/null @@ -1,221 +0,0 @@ -#' @name kobo_bar_multi_facet -#' @rdname kobo_bar_multi_facet -#' @title Generate frequency bar chart for select_multiple variable and save output as svg for illustrator -#' -#' @description Automatically generate faceted chart for select multiple variables. ggplot2 is used. -#' -#' -#' @param mainDir Path to the project's working directory: mainly for proper shiny app path -#' -#' -#' -#' @author Edouard Legoupil -#' -#' @examples -#' kobo_bar_multi_facet() -#' -#' @export kobo_bar_multi_facet -#' -#' @examples -#' \dontrun{ -#' kobo_bar_multi_facet() -#' } -#' -#' - -kobo_bar_multi_facet <- function(mainDir='') { - # Making your life easier by finding the dico and data from 0-config.R (created during kobo_project_config()) - if (mainDir==''){ - mainDir <- getwd() - } - - source(paste0(mainDir,"/code/0-config.R"), local=TRUE) - - - # List of select_multiple questions and choices - selectdf <- dico[dico$type == "select_multiple", c("fullname","listname","label","name","disaggregation"), ] - - ### Verify that those variables are actually in the original dataframe - check <- as.data.frame(names(data)) - names(check)[1] <- "fullname" - check$id <- row.names(check) - selectdf <- join(x=selectdf, y=check, by="fullname", type="left") - selectdf <- selectdf[!is.na(selectdf$id), ] - - allvar<-dico[, c("fullname","listname","label","name","disaggregation"), ] - - ## now correct list of variables - selectone <- as.character(selectdf[selectdf$disaggregation!=""& selectdf$disaggregation!="weight", c("fullname")]) - ## df of variable to loop around - selectonet <- as.data.frame(selectone) - - - if (nrow(selectdf)==0){ - cat("There's no select_multiple questions \n") - } else{ - - ## get list of variables used for faceting - selectfacet <- as.character(selectdf[selectdf$disaggregation!="" & selectdf$disaggregation!="weight", c("fullname")]) - selectfacet <- selectfacet[!is.na(selectfacet)] - - if(length(selectfacet)==0) { - cat("There's no variable to disaggregate in your data analysis plan.\n") - - } else { cat(paste0( length(selectfacet) , " variable(s) to disaggregate in your data analysis plan. Let's proceed! \n")) - - selectmulti <- as.character(selectdf[, c("fullname")]) - data.selectmulti <- data [selectmulti] - data.selectmulti <- data [selectfacet] - data.selectmulti <- kobo_label(data.selectmulti, dico) - - selectfacett <- selectdf[selectdf$disaggregation!=""& selectdf$disaggregation!="weight", c("fullname","disaggregation")] - single.facet <- as.data.frame(table(selectfacett[,2])) - single.facet <- as.data.frame(single.facet[single.facet$Var1!="",c("Var1")]) - names(single.facet) <- "Var1" - - - listmulti <- dico[dico$type=="select_multiple_d", c("listname","label","name","fullname","disaggregation")] - selectdf1 <- as.data.frame(unique(selectdf$listname)) - names(selectdf1)[1] <- "listname" - listmulti <- join(x=listmulti, y=selectdf1, by="listname", type="left") - - listmultichoice <- dico[dico$type=="select_multiple_d", c("listname","label","name","fullname","disaggregation","labelchoice")] - - for (i in 1:nrow(listmulti) ) { - # i <- 7 - variablename <- as.character(listmulti[i,"fullname"]) - listloop <- as.character(listmulti[i,1]) - listlabel <- as.character(listmulti[i,2]) - - - ### select variable for a specific multiple questions - selectmultilist <- as.character(dico[dico$type=="select_multiple" & dico$listname==listloop & dico$label==listlabel, c("fullname")]) - - ## Check that those variable are in the dataset - selectdf <- dico[dico$type=="select_multiple" & dico$listname==listloop & dico$qlevel==variablename , c("fullname","listname","label","name","disaggregation","labelchoice")] - selectdf2 <- join(x=selectdf, y=check, by="fullname", type="left") - selectdf2 <- selectdf2[!is.na(selectdf2$id), ] - - # If no answers to this question, passing to the next select_multiple - if (nrow(selectdf2)==0){ cat("Only empty values, passing. \n") - } else { - - listlabelchoice <- as.character(selectdf2[,"labelchoice"]) - selectmultilist <- as.character(selectdf2[, c("fullname")]) - data.selectmultilist <- data.selectmulti[selectmultilist] - names(data.selectmultilist) <- listlabelchoice - - # Listing the choices to the question - selectmultilist <- as.character(selectdf2[, c("fullname")]) - - ## Reshape answers - # Selecting only the answers to this question - - data.selectmultilist <- data.selectmultilist[, colSums(!is.na(data.selectmultilist)) != 0] - if (ncol(data.selectmultilist)==0){ cat("Only empty values, passing. \n") - }else{ - - #Selecting only the answers selected at least once - data.selectmultilist <- sapply(data.selectmultilist, as.numeric) - - data.selectmultilist <- data.frame(data.selectmultilist[, colSums(data.selectmultilist,na.rm=TRUE) != 0, drop=FALSE],check.names=FALSE) - - for (j in 1:nrow(single.facet) ) { - - - if(listmultichoice[i,"disaggregation"]!=single.facet[j,1]){ - } else{ - - facetname1 <- as.character(single.facet[j,1]) - facetname <- as.character(allvar[allvar$name==facetname1,c("fullname")]) - - facetlabel <- as.character(dico[dico$fullname==facetname,c("label")]) - facetchoices <- dico[dico$name==facetname1, c("name","labelchoice","listname")] - facetchoices <-dico[dico$listname==facetchoices[,3], c("name","labelchoice","listname")] - facetchoices <- facetchoices[facetchoices$name!=facetname1, c("name","labelchoice","listname")] - - # Put ID to each row - - data.selectmultilist$id <- rownames(data.selectmultilist) - - if(usedweight=="sampling_frame"){ - data.selectmultilist$weight <- data$weight - names(data.selectmultilist$weight) <- "weight" - } - - data.selectmultilist[facetname] <- data[facetname] - names(data.selectmultilist)[length(names(data.selectmultilist))] <- "facet" - - - - #Count total answer (for the survey) and answered to this question - - totalanswer <- nrow(data.selectmultilist) - count_replied <- as.numeric(sum(!is.na(data.selectmultilist[,1 ]))) - - percentresponse <- paste(round((count_replied/totalanswer)*100,digits=2),"%",sep="") - - if(usedweight=="sampling_frame"){ - - meltdata <- melt(data.selectmultilist,id=c("weight","id","facet")) - - castdata <- as.data.frame(table(meltdata[,c("value","variable","facet","weight")])) - castdata$Freq <- as.numeric(as.character(castdata$Freq)) - castdata$weight <- as.numeric(as.character(castdata$weight)) - castdata$freqper <- round((castdata$Freq*castdata$weight)/count_replied,digits=2) - } - - else{ - meltdata <- melt(data.selectmultilist,id=c("id","facet")) - - castdata <- as.data.frame(table(meltdata[,c("value","variable","facet")])) - castdata$Freq <- as.numeric(as.character(castdata$Freq)) - castdata$freqper <- round((castdata$Freq)/count_replied,digits=2) - } - - castdata <- castdata[castdata$value!=0, ] - - #combining values - castdata<- ddply(castdata, c("variable","facet"),numcolwise(sum)) - - castdata$variable = str_wrap(castdata$variable,width=15) - - background_rect <- data.frame(unique(castdata[,c("variable")])) - names(background_rect) <- c("variable") - background_rect$freqper <-1 - - theme_set(theme_gray(base_size = 20) - ) - - ggplot(castdata,aes(x=variable, y=freqper)) + - geom_bar(data=background_rect,aes(x=variable),stat = "identity", alpha=0.2)+ - geom_bar(stat = "identity", position="dodge",aes(fill=facet))+ - geom_text(aes(label=paste(round(freqper*100),"%",sep=""), fill=facet, hjust = -0.5), position=position_dodge(width=0.8))+ - xlab("") + ylab("")+ - scale_y_continuous(labels=percent, limits = c(0,1))+ - scale_fill_brewer(name=paste0(facetlabel),palette="PuBu")+ - coord_flip()+ - ggtitle(str_wrap(listlabel,width=50))+ - theme(plot.title=element_text(face="bold", size=25)) - - ggsave(filename=paste(mainDir, "/out/disagg_multi/",variablename,"_bar_multi_disagg_",facetname,".png",sep=""), width=12, height=10,units="in", dpi=300) - - cat(paste0("Generated bar chart for question: ", listlabel , "\n")) - } - } - } - } - } - } - } - - cat(" \n") - cat(" \n") - cat(" ###################################################################\n") - cat(" # The bar charts for select_mutliple questions were generated! #\n") - cat(" # You can find them in the folder 'out/disagg_multi'! #\n") - cat(" ###################################################################\n") - -} -NULL - diff --git a/R/kobo_bar_multi_print.R b/R/kobo_bar_multi_print.R deleted file mode 100644 index f376640..0000000 --- a/R/kobo_bar_multi_print.R +++ /dev/null @@ -1,122 +0,0 @@ -#' @name kobo_bar_multi_print -#' @rdname kobo_bar_multi_print -#' @title Generate bar Chart - frequency - for select_multiple questions and save output as svg for illustrator -#' -#' @description Automatically generate bar chart for each of the select_multiple question in the dataset. used in report -#' -#' -#' @param data kobodatset to use -#' @param dico ( generated from kobo_dico) -#' -#' -#' -#' @author Edouard Legoupil -#' -#' @examples -#' kobo_bar_multi_print() -#' -#' @export kobo_bar_multi_print -#' -#' @examples -#' \dontrun{ -#' kobo_bar_multi_print(data, dico) -#' } -#' -#' - -kobo_bar_multi_print <- function(data, dico) { - - - selectdf <- dico[dico$type=="select_multiple", c("fullname","listname","label","name","variable","disaggregation")] - - - ### Verify that those variable are actually in the original dataframe - check <- as.data.frame(names(data)) - names(check)[1] <- "fullname" - check$id <- row.names(check) - selectdf <- join(x=selectdf, y=check, by="fullname", type="left") - selectdf <- selectdf[!is.na(selectdf$id), ] - - if (nrow(selectdf)==0){ - cat("There's no disagreggated select_multiple variables. \n") - } else{ - - selectmulti <- as.character(selectdf[, c("fullname")]) - data.selectmulti <- data [selectmulti ] - data.selectmulti <- kobo_label(data.selectmulti, dico) - - - listmulti <- dico[dico$type=="select_multiple_d", c("listname","label","name","fullname","variable","disaggregation","qrepeat")] - selectdf1 <- as.data.frame(unique(selectdf$listname)) - names(selectdf1)[1] <- "listname" - listmulti <- join(x=listmulti, y=selectdf1, by="listname", type="left") - - - for (i in 1:nrow(listmulti) ) { - # i <- 7 - listloop <- as.character(listmulti[i,1]) - listlabel <- as.character(listmulti[i,2]) - - - ### select variable for a specific multiple questions - selectmultilist <- as.character(dico[dico$type=="select_multiple" & dico$listname==listloop , c("fullname")]) - - ## Check that those variable are in the dataset - selectdf <- dico[dico$type=="select_multiple" & dico$listname==listloop , c("fullname","listname","label","name","variable","disaggregation")] - selectdf2 <- join(x=selectdf, y=check, by="fullname", type="left") - selectdf2 <- selectdf2[!is.na(selectdf2$id), ] - - if (nrow(selectdf2)==0){ cat("passing \n") - } else { - - selectmultilist <- as.character(selectdf2[, c("fullname")]) - - ## Reshape answers - data.selectmultilist <- data.selectmulti[ selectmultilist ] - data.selectmultilist$id <- rownames(data.selectmultilist) - - totalanswer <- nrow(data.selectmultilist) - ## subsetting to those who replied - - data.selectmultilist <- data.selectmultilist[ data.selectmultilist[ ,1]!="Not replied", ] - - percentreponse <- paste(round((nrow(data.selectmultilist)/totalanswer)*100,digits=1),"%",sep="") - - - meltdata <- melt(data.selectmultilist,id="id") - - #prop.table(table(meltdata$variable, meltdata$value),2) - - castdata <- as.data.frame(table(meltdata[c("value")])) #, useNA = "ifany" - castdata$freqper <- castdata$Freq/nrow(data.selectmultilist) - - castdata <- castdata[castdata$Var1!="Not selected", ] - #castdata <- dcast(meltdata, value~variable, fun.aggregate = length) - castdata$Var1 <-factor(castdata$Var1, levels=castdata[order(castdata$freqper), "Var1"]) - - #levels(castdata$Var1) - castdata <- castdata[castdata$Var1!="", ] - - plot <- ggplot(castdata, aes(x=Var1, y=freqper)) + - geom_bar(fill="#2a87c8",colour="#2a87c8",stat = "identity") + - xlab("") + ylab("")+ - scale_y_continuous(labels=percent)+ - coord_flip()+ - ggtitle(listlabel, - subtitle = paste0("Select_multiple question: Response rate to this question is ",percentreponse," of the total."))+ - theme(plot.title=element_text(face="bold", size=9), - plot.background = element_rect(fill = "transparent",colour = NA)) - # ggsave(filename=paste("out/bar_multi/bar_multifreq_",listloop,".png",sep=""), width=8, height=10,units="in", dpi=300) - - #cat(paste0("Generated bar chart for question: ", listlabel , "\n")) - print(plot) - cat("\n") - cat("\n") - - } - } - - } - -} -NULL diff --git a/R/kobo_bar_one.R b/R/kobo_bar_one.R deleted file mode 100644 index 8e7f09a..0000000 --- a/R/kobo_bar_one.R +++ /dev/null @@ -1,161 +0,0 @@ -#' @name kobo_bar_one -#' @rdname kobo_bar_one -#' @title Generate bar Chart - frequency - for select_one questions - -#' @description Automatically generate bar chart for each of the select_one question in the dataset. ggplot2 is used. -#' -#' -#' @param mainDir Path to the project's working directory: mainly for shiny app -#' -#' -#' @author Edouard Legoupil, Elliott Messeiller -#' -#' @examples -#' kobo_bar_one() -#' -#' @export kobo_bar_one -#' @examples -#' \dontrun{ -#' kobo_bar_one() -#' } -#' -#' - -kobo_bar_one <- function(mainDir='') { - if (mainDir==''){ - mainDir <- getwd() - } - - source(paste0(mainDir,"/code/0-config.R"), local=TRUE) - - - ## Check that variable are in the dataset - selectdf <- dico[dico$type=="select_one" , c("fullname","listname","label","name","disaggregation","labelchoice")] - - check <- as.data.frame(names(data)) - names(check)[1] <- "fullname" - check$id <- row.names(check) - selectdf2 <- join(x=selectdf, y=check, by="fullname", type="left") - selectdf3 <- selectdf2[!is.na(selectdf2$id), ] - selectone <- as.character(selectdf3[, c("fullname")]) - - selectonet <- as.data.frame(selectone) - - selectfacet <- as.character(selectdf[selectdf$disaggregation!="" , c("fullname")]) - selectfacet <- selectfacet[!is.na(selectfacet)] - - # Replacing names by labels - selectchoices_questions <- dico[dico$type=="select_one_d" , c("listname","name","labelchoice")] - selectchoices <- unique(dico[dico$type=="select_one_d" , c("listname","name","labelchoice")]) - - selectoneans <-(dico[dico$type=="select_one_d", c("fullname","name","listname")]) - short_ans <- paste(sapply(strsplit(as.character(selectoneans$fullname),".",fixed = TRUE),"[[",1), sapply(strsplit(as.character(selectoneans$fullname),".",fixed = TRUE),"[[",2), sep = ".") - selectchoices_questions$qname <- short_ans - - - data.single <- data.frame(data [selectone]) - - for (j in 1:ncol(data.single)){ - data.single[,j] <- data.frame(selectchoices[,3][match(data.single[,j],selectchoices[,2])], stringsAsFactors = FALSE) - data.single[,j] <- factor(data.single[,j]) - } - - - ## Remove variable where we get only NA - data.single <- data.single[,colSums(is.na(data.single))% arrange(Var1) - } - - theme_set(theme_gray(base_size = 20)) - color<-"#2a87c8" - - - ## and now the graph - plotfreq <- ggplot(frequ, aes(x= Var1, y=freqper)) + - geom_bar(fill=color,colour=color,stat = "identity") + - geom_text(aes(label=paste(round(frequ$freqper*100),"%",sep=""), hjust = -0.5))+ - #facet_wrap(~subgov, ncol=4) + - ylab("Frequency") + - scale_y_continuous(labels=percent, limits = c(0,1))+ - scale_fill_brewer("PuBu")+ - xlab("") + - coord_flip() + - ggtitle(str_wrap(title,width=50))+ - theme( plot.title=element_text(face="bold", size=20), - plot.background = element_rect(fill = "transparent",colour = NA)) - ggsave(filename=paste(mainDir,"/out/bar_one/",variablename,"_bar_one.png",sep=""), width=10, height=10,units="in", dpi=300) - - cat(paste0("Generated bar chart for question: ", title , "\n")) - - #Writting file - - #rm(variablename,frequ) - } - } - - cat(" \n") - cat(" \n") - cat(" ###########################################################\n") - cat(" # The bar charts for select_one questions were generated! #\n") - cat(" # You can find them in the folder 'out/bar_one'! #\n") - cat(" ###########################################################\n") - if(length(selectfacet)!=0) { - cat(" \n") - cat(" ###########################################################\n") - cat(" # Variable(s) to disaggregate in your data analysis plan. # \n") - cat(" # Run kobo_bar_one_facet() ! # \n") - cat(" ###########################################################\n") - - } - - -} -NULL diff --git a/R/kobo_bar_one_facet.R b/R/kobo_bar_one_facet.R deleted file mode 100644 index 3c47202..0000000 --- a/R/kobo_bar_one_facet.R +++ /dev/null @@ -1,230 +0,0 @@ -#' @name kobo_bar_one_facet -#' @rdname kobo_bar_one_facet -#' @title Generate faceted frequency bar chart -#' -#' @description Automatically generate faceted chart for select one variable.. ggplot2 is used. -#' -#' -#' @param mainDir Path to the project's working directory: mainly for proper shiny app path -#' -#' -#' -#' @author Edouard Legoupil, Elliott Messeiller -#' -#' @examples -#' kobo_bar_one_facet() -#' -#' @export kobo_bar_one_facet -#' -#' @examples -#' \dontrun{ -#' kobo_bar_one_facet() -#' } -#' -#' - -kobo_bar_one_facet <- function(mainDir='') { - if (mainDir==''){ - mainDir <- getwd() - } - - source(paste0(mainDir,"/code/0-config.R"), local=TRUE) - - - mainDirectory <- paste0(mainDir,"/out") - subDir <- "/disagg_one" - if (file.exists(paste(mainDirectory, subDir, "/", sep = "/", collapse = "/"))) { - cat("disagg_one directory exists in out directory and is a directory.\n") - } else if (file.exists(paste(mainDirectory, subDir, sep = "/", collapse = "/"))) { - cat("disagg_one directory exists in your out directory.\n") - # you will probably want to handle this separately - } else { - cat("disagg_one directory does not exist in your out directory - creating now!\n ") - dir.create(file.path(mainDirectory, subDir)) - } - - - ## get list of all nominal variables - - - ## Check that those variable are in the dataset - selectdf <- dico[dico$type=="select_one" , c("fullname","listname","label","name","disaggregation","labelchoice")] - - check <- as.data.frame(names(data)) - names(check)[1] <- "fullname" - check$id <- row.names(check) - selectdf2 <- join(x=selectdf, y=check, by="fullname", type="left") - selectdf3 <- selectdf2[!is.na(selectdf2$id), ] - selectone <- as.character(selectdf3[, c("fullname")]) - - selectonet <- as.data.frame(selectone) - - selectfacet <- as.character(selectdf[selectdf$disaggregation!="" & selectdf$disaggregation!="weight" , c("fullname")]) - selectfacet <- selectfacet[!is.na(selectfacet)] - - # Replacing names by labels - selectchoices_questions <- dico[dico$type=="select_one_d" , c("listname","name","labelchoice")] - selectchoices <- unique(dico[dico$type=="select_one_d" , c("listname","name","labelchoice")]) - - selectoneans <-(dico[dico$type=="select_one_d", c("fullname","name","listname")]) - short_ans <- paste(sapply(strsplit(as.character(selectoneans$fullname),".",fixed = TRUE),"[[",1), sapply(strsplit(as.character(selectoneans$fullname),".",fixed = TRUE),"[[",2), sep = ".") - selectchoices_questions$qname <- short_ans - - - data.single <- data.frame(data [selectone]) - - for (j in 1:ncol(data.single)){ - data.single[,j] <- data.frame(selectchoices[,3][match(data.single[,j],selectchoices[,2])], stringsAsFactors = FALSE) - data.single[,j] <- factor(data.single[,j]) - } - - - ## Remove variable where we get only NA - data.single <- data.single[,colSums(is.na(data.single))% arrange(data) - } - - - - ## and now the graph - - background_rect <- data.frame(unique(frequ[,c("data")])) - names(background_rect) <- c("data") - background_rect$freqper <-1 - - theme_set(theme_gray(base_size = 20)) - - - ggplot(frequ,aes(x=data, y=freqper)) + - geom_bar(data=background_rect,aes(x=data),stat = "identity", alpha=0.2)+ - geom_bar(stat = "identity", position="dodge",aes(fill=facet))+ - geom_text(aes(label=paste(round(freqper*100),"%",sep=""), fill=facet, hjust = -0.5), position=position_dodge(width=0.8))+ - xlab("") + ylab("")+ - scale_y_continuous(labels=percent, limits = c(0,1))+ - scale_fill_brewer(name=paste0(facetlabel),palette="PuBu")+ - coord_flip()+ - ggtitle(str_wrap(title,width=50))+ - theme(plot.title=element_text(face="bold", size=25)) - # Saving graphs - ggsave(filename=paste(mainDir,"/out/disagg_one/",variablename,"_disagg_",facetname,"bar_one.png",sep=""), width=10, height=10,units="in", dpi=300) - cat(paste0("Generated bar chart for question: ",i, " ", title ," - with disaggregation on - ",j, " ",facetlabel, " saved as image: ", variablename,"_disagg_",facetname,"\n")) - } - ### End testing - } - } - ### End loop around variable - } - ### End loop around facet - - } - ### Test if facet in dico - cat(" ########################################################################\n") - cat(" # The bar charts for select_one questions dissagrated were generated! #\n") - cat(" # You can find them in the folder 'out/disagg_one'! #\n") - cat(" ########################################################################\n") - -} -NULL - diff --git a/R/kobo_bar_one_facet_print.R b/R/kobo_bar_one_facet_print.R deleted file mode 100644 index 8acbb95..0000000 --- a/R/kobo_bar_one_facet_print.R +++ /dev/null @@ -1,116 +0,0 @@ -#' @name kobo_bar_one_facet_print -#' @rdname kobo_bar_one_facet_print -#' @title Generate faceted frequency bar chart and save output as svg for illustrator -#' -#' @description Automatically generate faceted chart for select one variable.. ggplot2 is used. -#' -#' -#' @param data kobodatset to use -#' @param dico ( generated from kobo_dico) -#' -#' -#' -#' @author Edouard Legoupil -#' -#' @examples -#' kobo_bar_one_facet_print() -#' -#' @export kobo_bar_one_facet_print -#' -#' @examples -#' \dontrun{ -#' kobo_bar_one_facet_print(data, dico) -#' } -#' -#' - -kobo_bar_one_facet_print <- function(data, dico) { - - - - ## get list of all nominal variables - selectone <- as.character(dico[dico$type=="select_one", c("fullname")]) - - ## Check that those variable are in the dataset - selectdf <- dico[dico$type=="select_one" , c("fullname","listname","label","name","variable","disaggregation")] - check <- as.data.frame(names(data)) - names(check)[1] <- "fullname" - check$id <- row.names(check) - selectdf <- join(x=selectdf, y=check, by="fullname", type="left") - selectdf <- selectdf[!is.na(selectdf$id), ] - - ## now correct list of variables - selectone <- as.character(selectdf[, c("fullname")]) - ## df of variable to loop around - selectonet <- as.data.frame(selectone) - - ## get list of variables used for faceting - selectfacet <- as.character(selectdf[selectdf$disaggregation=="facet" , c("fullname")]) - selectfacet <- selectfacet[!is.na(selectfacet)] - - if(length(selectfacet)==0) { - cat("There's no variable to facet in your data analysis plan.\n") - } else { cat(paste0( length(selectfacet) , " variable(s) to facet in your data analysis plan. Let's proceed! \n")) - - selectfacett <- as.data.frame(selectfacet) - - ## subset data with selectone - data.single <- data [ selectone ] - - ## force to data frame - data.single <- as.data.frame(data.single) - ## Remove variable where we get only NA - # data.single <- data.single[,colSums(is.na(data.single)) 0) { cat(paste0(nrow(dico.clean), " potential variables to clean\n")) @@ -48,7 +51,7 @@ kobo_clean <- function(frame, dico) { varia <- paste0(framename,"$",as.character(dico.clean[ i, c("fullname")])) variable <- paste0(as.character(dico.clean[ i, c("fullname")])) cleanfile <- paste0(as.character(dico.clean[ i, c("clean")])) - cleanframe <- paste0(substr(as.character(dico.clean[ i, c("clean")]), 1, nchar(cleanfile)-4)) + cleanframe <- paste0(substr(as.character(dico.clean[ i, c("clean")]), 1, nchar(cleanfile) - 4)) formula1 <- paste0(cleanframe," <- read.csv(\"data/", cleanfile,"\", encoding = \"UTF-8\", na.strings = \"\")" ) formula2 <- paste0("names(",cleanframe,")[1] <- \"",dico.clean[ i, c("fullname")],"\"" ) formula3 <- paste0("names(",cleanframe,")[2] <- \"",dico.clean[ i, c("fullname")],".clean\"" ) diff --git a/R/kobo_cluster_report.R b/R/kobo_cluster_report.R index b924fd8..ffedd6e 100644 --- a/R/kobo_cluster_report.R +++ b/R/kobo_cluster_report.R @@ -46,10 +46,10 @@ kobo_cluster_report <- function(frame, form = "form.xls", app="console") { # frame <- household # framename <- "household" framename <- deparse(substitute(frame)) - write.csv(frame, paste0(mainDir,"/data/clustering-report-",framename,".csv"), row.names = FALSE, na = "") + utils::write.csv(frame, paste0(mainDir,"/data/clustering-report-",framename,".csv"), row.names = FALSE, na = "") ## Check that all those selectedVars are in the frame #### - if(app=="shiny"){ + if (app == "shiny") { progress$set(message = "Check that all those selectedVars are in the frame...") updateProgress() } @@ -57,32 +57,32 @@ kobo_cluster_report <- function(frame, form = "form.xls", app="console") { names(check)[1] <- "fullname" check$id <- row.names(check) - dico <- read.csv(paste0(mainDir,"/data/dico_",form,".csv"), encoding = "UTF-8", na.strings = "") + dico <- utils::read.csv(paste0(mainDir,"/data/dico_",form,".csv"), encoding = "UTF-8", na.strings = "") #### Check presence of variable for anom plan... - if(app=="shiny"){ + if (app == "shiny") { progress$set(message = "Check presence of variable for anom plan...") updateProgress() } selected.cluster <- dico[ which(dico$cluster == "TRUE" & dico$type == "select_one" ), ] - selected.cluster <- join(x = selected.cluster, y = check, by = "fullname", type = "left") + selected.cluster <- plyr::join(x = selected.cluster, y = check, by = "fullname", type = "left") selected.cluster <- selected.cluster[!is.na(selected.cluster$id), ] selected.clusterVars <- as.character(selected.cluster[ , c("fullname")]) #selected.clusterVars2 <- as.character(selected.cluster[ , c("name")]) - selected.clusterVars2 <- str_replace_all(as.character(selected.cluster[ , c("name")]), "_", ".") + selected.clusterVars2 <- stringr::str_replace_all(as.character(selected.cluster[ , c("name")]), "_", ".") selected.id <- dico[ which(dico$cluster == "id"), ] - selected.id <- join(x = selected.id, y = check, by = "fullname", type = "left") + selected.id <- plyr::join(x = selected.id, y = check, by = "fullname", type = "left") selected.id <- selected.id[!is.na(selected.id$id), ] selected.idVars <- as.character(selected.id[ , c("fullname")]) if (nrow(selected.cluster) == 0) { - cat ("You have not selected variables to cluster for your dataset! \n") + cat("You have not selected variables to cluster for your dataset! \n") return(structure("You have not selected variables to cluster for your dataset!", class = "try-error")) } else { - if(app=="shiny"){ + if (app == "shiny") { progress$set(message = "Generating Multivariate Analysis in progress...") updateProgress() } @@ -129,10 +129,10 @@ kobo_cluster_report <- function(frame, form = "form.xls", app="console") { cat("## Provide below the name of the form in xsl form - format should be xls not xlsx", file = reportcluster , sep = "\n", append = TRUE) cat("form <- \"form.xls\"", file = reportcluster , sep = "\n", append = TRUE) cat("\n", file = reportcluster , sep = "\n", append = TRUE) - cat("dico <- read.csv(paste0(mainDirroot,\"/data/dico_\",form,\".csv\"), encoding = \"UTF-8\", na.strings = \"\")", file = reportcluster , sep = "\n", append = TRUE) + cat("dico <- utils::read.csv(paste0(mainDirroot,\"/data/dico_\",form,\".csv\"), encoding = \"UTF-8\", na.strings = \"\")", file = reportcluster , sep = "\n", append = TRUE) cat("\n", file = reportcluster , sep = "\n", append = TRUE) - cat(paste0("datacluster <- read.csv(paste0(mainDirroot,\"/data/clustering-report-",framename,".csv\"), sep = \",\", encoding = \"UTF-8\", na.strings = \"\")"), file = reportcluster , sep = "\n", append = TRUE) + cat(paste0("datacluster <- utils::read.csv(paste0(mainDirroot,\"/data/clustering-report-",framename,".csv\"), sep = \",\", encoding = \"UTF-8\", na.strings = \"\")"), file = reportcluster , sep = "\n", append = TRUE) cat(" if(nrow(datacluster) > 10000) { @@ -194,19 +194,19 @@ kobo_cluster_report <- function(frame, form = "form.xls", app="console") { cat("check <- as.data.frame(names(datacluster))", file = reportcluster , sep = "\n", append = TRUE) cat("names(check)[1] <- \"fullname\"", file = reportcluster , sep = "\n", append = TRUE) cat("check$id <- row.names(check)", file = reportcluster , sep = "\n", append = TRUE) - cat("check <- join(x = check, y = dico, by = \"fullname\", type = \"left\")", file = reportcluster , sep = "\n", append = TRUE) + cat("check <- plyr::join(x = check, y = dico, by = \"fullname\", type = \"left\")", file = reportcluster , sep = "\n", append = TRUE) cat("\n", file = reportcluster , sep = "\n", append = TRUE) cat("\n", file = reportcluster , sep = "\n", append = TRUE) cat("selected.cluster <- dico[ which(dico$cluster == \"yes\" & dico$type == \"select_one\" ), ]", file = reportcluster , sep = "\n", append = TRUE) - cat("selected.cluster <- join(x = selected.cluster, y = check, by = \"fullname\", type = \"left\")", file = reportcluster , sep = "\n", append = TRUE) + cat("selected.cluster <- plyr::join(x = selected.cluster, y = check, by = \"fullname\", type = \"left\")", file = reportcluster , sep = "\n", append = TRUE) cat("selected.cluster <- selected.cluster[!is.na(selected.cluster$id), ]", file = reportcluster , sep = "\n", append = TRUE) cat("selected.clusterVars <- as.character(selected.cluster[ , c(\"fullname\")])", file = reportcluster , sep = "\n", append = TRUE) cat("#selected.clusterVars2 <- as.character(selected.cluster[ , c(\"name\")])", file = reportcluster , sep = "\n", append = TRUE) - cat("selected.clusterVars2 <- str_replace_all(as.character(selected.cluster[ , c(\"name\")]), \"_\", \".\")", file = reportcluster , sep = "\n", append = TRUE) + cat("selected.clusterVars2 <- stringr::str_replace_all(as.character(selected.cluster[ , c(\"name\")]), \"_\", \".\")", file = reportcluster , sep = "\n", append = TRUE) cat("\n", file = reportcluster , sep = "\n", append = TRUE) cat("\n", file = reportcluster , sep = "\n", append = TRUE) cat("selected.id <- dico[ which(dico$cluster == \"id\"), ]", file = reportcluster , sep = "\n", append = TRUE) - cat("selected.id <- join(x = selected.id, y = check, by = \"fullname\", type = \"left\")", file = reportcluster , sep = "\n", append = TRUE) + cat("selected.id <- plyr::join(x = selected.id, y = check, by = \"fullname\", type = \"left\")", file = reportcluster , sep = "\n", append = TRUE) cat("selected.id <- selected.id[!is.na(selected.id$id), ]", file = reportcluster , sep = "\n", append = TRUE) cat("selected.idVars <- as.character(selected.id[ , c(\"fullname\")])", file = reportcluster , sep = "\n", append = TRUE) cat("\n", file = reportcluster , sep = "\n", append = TRUE) @@ -227,10 +227,10 @@ kobo_cluster_report <- function(frame, form = "form.xls", app="console") { cat("check2 <- as.data.frame(names(datacluster2))", file = reportcluster , sep = "\n", append = TRUE) cat("names(check2)[1] <- \"fullname\"", file = reportcluster , sep = "\n", append = TRUE) cat("check2$id <- row.names(check2)", file = reportcluster , sep = "\n", append = TRUE) - cat("check2 <- join(x = check2, y = dico, by = \"fullname\", type = \"left\")", file = reportcluster , sep = "\n", append = TRUE) + cat("check2 <- plyr::join(x = check2, y = dico, by = \"fullname\", type = \"left\")", file = reportcluster , sep = "\n", append = TRUE) cat("\n", file = reportcluster , sep = "\n", append = TRUE) cat("## Take out special characters from those name", file = reportcluster , sep = "\n", append = TRUE) - cat("check2$name2 <- str_replace_all(check2$name, \"_\", \".\")", file = reportcluster , sep = "\n", append = TRUE) + cat("check2$name2 <- stringr::str_replace_all(check2$name, \"_\", \".\")", file = reportcluster , sep = "\n", append = TRUE) cat("\n", file = reportcluster , sep = "\n", append = TRUE) cat("names(datacluster2) <- check2[, c(\"name2\")]", file = reportcluster , sep = "\n", append = TRUE) cat("\n", file = reportcluster , sep = "\n", append = TRUE) diff --git a/R/kobo_consolidateone.R b/R/kobo_consolidateone.R index 84b8ab6..ed501df 100644 --- a/R/kobo_consolidateone.R +++ b/R/kobo_consolidateone.R @@ -1,76 +1,76 @@ -#' @name kobo_consolidateone -#' @rdname kobo_consolidateone -#' @title Merge disagregated select_one variable -#' -#' @description Merge disagregated select_one variable -#' -#' @param data original dataset -#' @param dico dictionnary -#' -#' @return A "data.table" with additional select_one variable. -#' -#' @author Edouard Legoupil -#' -#' @examples -#' kobo_consolidateone() -#' -#' @export kobo_consolidateone -#' @examples -#' \dontrun{ -#' kobo_consolidateone("myform.xls") -#' } -#' -#' @export kobo_consolidateone -#' -#' @return data - -kobo_consolidateone <- function(data,dico) { - - ### List of select_one questions - listoned <- dico[dico$type=="select_one_d" , c("listname","label","name","fullname")] - listoned$qname <- "" - for (i in 1:nrow(listoned)) { - listoned[i,5] <- substr(as.character(listoned[i,4]), 1 , nchar(as.character(listoned[i,4])) -1 - nchar(as.character(listoned[i,3]))) - } - - check <- as.data.frame(names(data)) - names(check)[1] <- "fullname" - check$id <- row.names(check) - listoned2 <- join(x=listoned, y=check, by="fullname", type="left") - listoned <- listoned2[!is.na(listoned2$id), ] - - - ## List of sub select_one - liston <- dico[dico$type=="select_one" & is.na(dico$qrepeat), c("listname","label","name","fullname")] - # liston2 <- join(x=liston, y=check, by="fullname", type="left") - # liston3 <- liston2[!is.na(liston$id), ] - names(liston)[4] <- "qname" - - # test <- join(y=liston, x=listoned, type="left", by="qname") - - for (i in 1:nrow(liston) ) { - # i <- 1 - newlistone <- as.character(liston[i,4]) - ### select variable for a specific multiple questions - selectlistoned <- as.data.frame(listoned[listoned$qname==newlistone , c("fullname")]) - names(selectlistoned)[1] <- "vartoconact" - selectlistoned$vartoconact <- as.character(selectlistoned$vartoconact) - #data <- data[ , c(1:745)] - data$newvar <- "" - - for (j in 1:nrow(selectlistoned) ) { - #j <- 7 - if (!is.na(selectlistoned[j , 1]) ) { - data[ ,selectlistoned[j,1] ][is.na(data[ ,selectlistoned[j,1] ])] <- "" - data$newvar <- paste0(data$newvar, data[ ,selectlistoned[j,1] ] ) - cat(paste("i=",i," - j=",j,"\n")) - } else{ } - } - #View(data$newvar) - names(data)[names(data)=="newvar"] <- newlistone - } - - #rm(liston,listoned,selectlistoned,i,newlistone) -return(data) -} -NULL +#' @name kobo_consolidateone +#' @rdname kobo_consolidateone +#' @title Merge disagregated select_one variable +#' +#' @description Merge disagregated select_one variable +#' +#' @param data original dataset +#' @param dico dictionnary +#' +#' @return A "data.table" with additional select_one variable. +#' +#' @author Edouard Legoupil +#' +#' @examples +#' kobo_consolidateone() +#' +#' @export kobo_consolidateone +#' @examples +#' \dontrun{ +#' kobo_consolidateone("myform.xls") +#' } +#' +#' @export kobo_consolidateone +#' +#' @return data + +kobo_consolidateone <- function(data,dico) { + + ### List of select_one questions + listoned <- dico[dico$type == "select_one_d" , c("listname","label","name","fullname")] + listoned$qname <- "" + for (i in 1:nrow(listoned)) { + listoned[i,5] <- substr(as.character(listoned[i,4]), 1 , nchar(as.character(listoned[i,4])) - 1 - nchar(as.character(listoned[i,3]))) + } + + check <- as.data.frame(names(data)) + names(check)[1] <- "fullname" + check$id <- row.names(check) + listoned2 <- plyr::join(x = listoned, y = check, by = "fullname", type = "left") + listoned <- listoned2[!is.na(listoned2$id), ] + + + ## List of sub select_one + liston <- dico[dico$type == "select_one" & is.na(dico$qrepeat), c("listname","label","name","fullname")] + # liston2 <- plyr::join(x=liston, y=check, by="fullname", type="left") + # liston3 <- liston2[!is.na(liston$id), ] + names(liston)[4] <- "qname" + + # test <- plyr::join(y=liston, x=listoned, type="left", by="qname") + + for (i in 1:nrow(liston) ) { + # i <- 1 + newlistone <- as.character(liston[i,4]) + ### select variable for a specific multiple questions + selectlistoned <- as.data.frame(listoned[listoned$qname == newlistone , c("fullname")]) + names(selectlistoned)[1] <- "vartoconact" + selectlistoned$vartoconact <- as.character(selectlistoned$vartoconact) + #data <- data[ , c(1:745)] + data$newvar <- "" + + for (j in 1:nrow(selectlistoned) ) { + #j <- 7 + if (!is.na(selectlistoned[j , 1]) ) { + data[ ,selectlistoned[j,1] ][is.na(data[ ,selectlistoned[j,1] ])] <- "" + data$newvar <- paste0(data$newvar, data[ ,selectlistoned[j,1] ] ) + cat(paste("i=",i," - j=",j,"\n")) + } else { } + } + #View(data$newvar) + names(data)[names(data) == "newvar"] <- newlistone + } + + #rm(liston,listoned,selectlistoned,i,newlistone) +return(data) +} +NULL diff --git a/R/kobo_correlation.R b/R/kobo_correlation.R deleted file mode 100644 index 574b64e..0000000 --- a/R/kobo_correlation.R +++ /dev/null @@ -1,125 +0,0 @@ -#' @name kobo_correlation -#' @rdname kobo_correlation -#' @title Generate histogramm plots based on dates -#' -#' @description Automatically generate maps for all nominal & ordinal variables based on dates. ggplot2 is used. -#' -#' -#' @param data kobodatset to use -#' @param dico ( generated from kobo_dico) -#' -#' -#' -#' @author Edouard Legoupil -#' -#' @examples -#' kobo_correlation() -#' -#' @export kobo_correlation -#' -#' @examples -#' \dontrun{ -#' kobo_correlation(S) -#' } -#' -#' - -kobo_correlation <- function() { - - source("code/0-config.R") - data <- read.csv(path.to.data,sep = ";") - dico <- read.csv(path.to.dico,sep = ",") - - mainDir <- "out" - subDir <- "correlation" - if (file.exists(paste(mainDir, subDir, "/", sep = "/", collapse = "/"))) { - cat("correlation directory exists in out directory and is a directory.\n") - } else if (file.exists(paste(mainDir, subDir, sep = "/", collapse = "/"))) { - cat("correlation directory exists in your out directory.\n") - # you will probably want to handle this separately - } else { - cat("correlation directory does not exist in your out directory - creating now!\n ") - dir.create(file.path(mainDir, subDir)) - } - - - ## Check that those variable are in the dataset - selectdf <- dico[dico$type=="integer" , c("fullname","listname","label","name","variable","disaggregation","correlate")] - check <- as.data.frame(names(data)) - names(check)[1] <- "fullname" - check$id <- row.names(check) - selectdf <- join(x=selectdf, y=check, by="fullname", type="left") - selectdf <- selectdf[!is.na(selectdf$id), ] - - ## now correct list of variables - selectinteger <- as.character(selectdf[, c("fullname")]) - ## df of variable to loop around - selectintegert <- as.data.frame(selectinteger) - - ## get list of variables used for faceting - selectcorrel <- as.character(selectdf[selectdf$correlate!="" , c("fullname")]) - selectcorrel <- selectcorrel[!is.na(selectcorrel)] - selectcorrelt <- as.data.frame(selectcorrel) - - if(length(selectcorrel)==0) { - cat("There's no variable to be correlated in your data analysis plan.\n") - } else { cat(paste0( length(selectcorrel) , " variable(s) to correlate in your data analysis plan. Let's proceed! \n")) - - ## subset data with selectone - data.integer <- data [ selectinteger ] - ## force to data frame - data.integer <- as.data.frame(data.integer) - - ## Remove variable where we get only NA - data.integer <- data.integer[,colSums(is.na(data.integer))"), - str_locate(bound, ".>="), - str_locate(bound, ".> "), - str_locate(bound, ".>= "))) + detectlow <- as.data.frame(rbind( stringr::str_locate(bound, ".>"), + stringr::str_locate(bound, ".>="), + stringr::str_locate(bound, ".> "), + stringr::str_locate(bound, ".>= "))) detectlow <- as.numeric(max(detectlow$end, na.rm = TRUE)) - detectlowzero <- as.data.frame(str_locate(substr(bound, detectlow + 1,nchar(bound)), " ")) + detectlowzero <- as.data.frame(stringr::str_locate(substr(bound, detectlow + 1,nchar(bound)), " ")) detectlowzero <- ifelse( is.na(detectlowzero$start), nchar(bound), as.numeric(min(detectlowzero$start, na.rm = TRUE))) dico[i, c("lowerbound")] <- substr(bound, detectlow + 1, detectlow + detectlowzero ) - detecthigh <- as.data.frame(rbind( str_locate(bound, ".<"), - str_locate(bound, ".<="), - str_locate(bound, ".< "), - str_locate(bound, ".<= "))) + detecthigh <- as.data.frame(rbind( stringr::str_locate(bound, ".<"), + stringr::str_locate(bound, ".<="), + stringr::str_locate(bound, ".< "), + stringr::str_locate(bound, ".<= "))) detecthigh <- as.numeric(max(detecthigh$end, na.rm = TRUE)) - detecthighzero <- as.data.frame(str_locate(substr(bound, detecthigh + 1,nchar(bound)), " ")) + detecthighzero <- as.data.frame(stringr::str_locate(substr(bound, detecthigh + 1,nchar(bound)), " ")) #detecthighzero <- as.numeric(min(detecthighzero$end, na.rm = TRUE)) detecthighzero <- ifelse( is.na(detecthighzero$start), @@ -109,13 +109,13 @@ kobo_dummy <- function(form = "form.xls") { if ( !(is.na(relevant)) & relevant != "" ) { # selected(${ - detectrelevant1 <- as.data.frame(str_locate(relevant, "\\{")) + detectrelevant1 <- as.data.frame(stringr::str_locate(relevant, "\\{")) detectrelevant1 <- as.numeric(max(detectrelevant1$end, na.rm = TRUE)) # },' - detectrelevant2 <- as.data.frame(str_locate(relevant, "\\}")) + detectrelevant2 <- as.data.frame(stringr::str_locate(relevant, "\\}")) detectrelevant2 <- as.numeric(max(detectrelevant2$end, na.rm = TRUE)) # ') - detectrelevant3 <- as.data.frame(str_locate(relevant, "\\)")) + detectrelevant3 <- as.data.frame(stringr::str_locate(relevant, "\\)")) detectrelevant3 <- as.numeric(max(detectrelevant3$end, na.rm = TRUE)) dico[i, c("relevantifvar")] <- substr(relevant, detectrelevant1 + 1, detectrelevant2 - 1 ) dico[i, c("relevantifvalue")] <- substr(relevant, detectrelevant2 + 3, detectrelevant3 - 2 ) @@ -140,7 +140,7 @@ kobo_dummy <- function(form = "form.xls") { # https://stringr.tidyverse.org/articles/regular-expressions.html # https://stat545.com/block022_regular-expression.html - # dummydata$UNHCRCaseNo <- stri_rand_strings(n = samplesize, + # dummydata$UNHCRCaseNo <- stringi::stri_rand_strings(n = samplesize, # length = 4, # # pattern = "(LEB)|(leb)|(0-9)]{3}-[0-9]{2}[c|C][0-9]{5}") # pattern = "^LEB|leb[0-9])$") @@ -184,7 +184,7 @@ kobo_dummy <- function(form = "form.xls") { ## generate the unique ID for each observation - dummydata <- data.frame(stri_rand_strings(samplesize, 8)) + dummydata <- data.frame(stringi::stri_rand_strings(samplesize, 8)) names(dummydata)[1] <- "instanceID" cat("Generating household table") @@ -201,7 +201,7 @@ kobo_dummy <- function(form = "form.xls") { ### case to handle # "imei" "deviceid" "phonenumber" if (typedata %in% c("imei", "deviceid", "phonenumber") ) { - dummydata[ , i + 1] <- stri_rand_strings(n = samplesize, 8) + dummydata[ , i + 1] <- stringi::stri_rand_strings(n = samplesize, 8) } # "date" "today" "start" if (typedata %in% c("date", "today", "start") ) { @@ -237,7 +237,7 @@ kobo_dummy <- function(form = "form.xls") { if (typedata == "integer") { lowerbound <- ifelse( is.na(dico.household[ i, c("lowerbound")]), 0, as.numeric(dico.household[ i, c("lowerbound" )])) upperbound <- ifelse( is.na(dico.household[ i, c("upperbound")]), 100, as.numeric(dico.household[ i, c("upperbound")])) - dummydata[ , i + 1] <- round(rtruncnorm(n = samplesize, + dummydata[ , i + 1] <- round(truncnorm::rtruncnorm(n = samplesize, a = lowerbound, #lowerbound, # vector of lower bounds. These may be -Inf b = upperbound, # vector of upper bounds. These may be Inf mean = ((upperbound - lowerbound ) / 2), # vector of means. @@ -247,7 +247,7 @@ kobo_dummy <- function(form = "form.xls") { if (typedata == "calculate") { lowerbound <- ifelse( is.na(as.numeric(dico.household[ i, c("lowerbound")])), 0, as.numeric(dico.household[ i, c("lowerbound")])) upperbound <- ifelse(is.na(as.numeric(dico.household[ i, c("upperbound")])), 100, as.numeric(dico.household[ i, c("upperbound")])) - dummydata[ , i + 1] <- round(rtruncnorm(n = samplesize, + dummydata[ , i + 1] <- round(truncnorm::rtruncnorm(n = samplesize, a = lowerbound, #lowerbound, # vector of lower bounds. These may be -Inf b = upperbound, # vector of upper bounds. These may be Inf mean = ((upperbound - lowerbound ) / 2), # vector of means. @@ -257,7 +257,7 @@ kobo_dummy <- function(form = "form.xls") { if (typedata == "decimal") { lowerbound <- ifelse( is.na(as.numeric(dico.household[ i, c("lowerbound")])), 0, as.numeric(dico.household[ i, c("lowerbound")])) upperbound <- ifelse(is.na(as.numeric(dico.household[ i, c("upperbound")])), 100, as.numeric(dico.household[ i, c("upperbound")])) - dummydata[ , i + 1] <- rtruncnorm(n = samplesize, + dummydata[ , i + 1] <- truncnorm::rtruncnorm(n = samplesize, a = lowerbound, #lowerbound, # vector of lower bounds. These may be -Inf b = upperbound, # vector of upper bounds. These may be Inf mean = ((upperbound - lowerbound ) / 2), # vector of means. @@ -268,14 +268,14 @@ kobo_dummy <- function(form = "form.xls") { # "text" if (typedata == "text") { #dummydata[ , i + 1] <- "this is a dummy text" - dummydata[ , i + 1] <- randomSentences(n = samplesize, 3:10) + dummydata[ , i + 1] <- OpenRepGrid::randomSentences(n = samplesize, 3:10) } # "geopoint" if (typedata == "geopoint") { #dummydata[ , i + 1] <- "this is a dummy text" - dummydata[ , i + 1] <- paste( round(spsample(BoxSpatialPoly, n = samplesize, "random")@coords[ ,1], 6), - round(spsample(BoxSpatialPoly, n = samplesize, "random")@coords[ ,2], 6), + dummydata[ , i + 1] <- paste( round(sp::spsample(BoxSpatialPoly, n = samplesize, "random")@coords[ ,1], 6), + round(sp::spsample(BoxSpatialPoly, n = samplesize, "random")@coords[ ,2], 6), sep = ",") } @@ -301,7 +301,7 @@ kobo_dummy <- function(form = "form.xls") { } } } - write.csv(dummydata, "data/MainDataFrame.csv", row.names = FALSE) + utils::write.csv(dummydata, "data/MainDataFrame.csv", row.names = FALSE) rm(categ_level, fullname, i , l, listname, lowerbound, upperbound, value, datacheck, dico.household, relevantifvalue, relevantifvar, relevantifvar2, samplesize, typedata) @@ -412,7 +412,7 @@ kobo_dummy <- function(form = "form.xls") { if (typedata == "integer") { lowerbound <- ifelse( is.na(as.numeric(dico.repeat1[ i, c("lowerbound")])), 0, as.numeric(dico.repeat1[ i, c("lowerbound")])) upperbound <- ifelse(is.na(as.numeric(dico.repeat1[ i, c("upperbound")])), 100, as.numeric(dico.repeat1[ i, c("upperbound")])) - dummydatarepeat[ , i + 1] <- round(rtruncnorm(n = samplesize, + dummydatarepeat[ , i + 1] <- round(truncnorm::rtruncnorm(n = samplesize, a = lowerbound, #lowerbound, # vector of lower bounds. These may be -Inf b = upperbound, # vector of upper bounds. These may be Inf mean = ((upperbound - lowerbound ) / 2), # vector of means. @@ -422,7 +422,7 @@ kobo_dummy <- function(form = "form.xls") { if (typedata == "calculate") { lowerbound <- ifelse( is.na(as.numeric(dico.repeat1[ i, c("lowerbound")])), 0, as.numeric(dico.repeat1[ i, c("lowerbound")])) upperbound <- ifelse(is.na(as.numeric(dico.repeat1[ i, c("upperbound")])), 100, as.numeric(dico.repeat1[ i, c("upperbound")])) - dummydatarepeat[ , i + 1] <- round(rtruncnorm(n = samplesize, + dummydatarepeat[ , i + 1] <- round(truncnorm::rtruncnorm(n = samplesize, a = lowerbound, #lowerbound, # vector of lower bounds. These may be -Inf b = upperbound, # vector of upper bounds. These may be Inf mean = ((upperbound - lowerbound ) / 2), # vector of means. @@ -432,7 +432,7 @@ kobo_dummy <- function(form = "form.xls") { if (typedata == "decimal") { lowerbound <- ifelse( is.na(as.numeric(dico.repeat1[ i, c("lowerbound")])), 0, as.numeric(dico.repeat1[ i, c("lowerbound")])) upperbound <- ifelse(is.na(as.numeric(dico.repeat1[ i, c("upperbound")])), 100, as.numeric(dico.repeat1[ i, c("upperbound")])) - dummydatarepeat[ , i + 1] <- rtruncnorm(n = samplesize, + dummydatarepeat[ , i + 1] <- truncnorm::rtruncnorm(n = samplesize, a = lowerbound, #lowerbound, # vector of lower bounds. These may be -Inf b = upperbound, # vector of upper bounds. These may be Inf mean = ((upperbound - lowerbound ) / 2), # vector of means. @@ -442,7 +442,7 @@ kobo_dummy <- function(form = "form.xls") { if (typedata == "text") { #dummydatarepeat[ , i + 1] <- "this is a dummy text" - dummydatarepeat[ , i + 1] <- randomSentences(n = samplesize, 3:10) + dummydatarepeat[ , i + 1] <- OpenRepGrid::randomSentences(n = samplesize, 3:10) } ## Then rename correctly @@ -475,7 +475,7 @@ kobo_dummy <- function(form = "form.xls") { } } # } - write.csv(dummydatarepeatall, paste0("data/",repeat_table,".csv"), row.names = FALSE) + utils::write.csv(dummydatarepeatall, paste0("data/",repeat_table,".csv"), row.names = FALSE) cat(paste0("\n\n\n Finished generation of nested table ", h, " - ", repeat_table, "\n")) rm(dummydatarepeatall) diff --git a/R/kobo_edit_form.R b/R/kobo_edit_form.R index 8559e85..d3e0df3 100644 --- a/R/kobo_edit_form.R +++ b/R/kobo_edit_form.R @@ -33,11 +33,11 @@ kobo_edit_form <- function(form = "form.xls", survey = NULL, choices = NULL, ind wb <- xlsx::createWorkbook(type = "xls") #create xls workbook mainDir <- kobo_getMainDirectory() form_tmp <- paste(mainDir, "data", form, sep = "/", collapse = "/") - + #################################### survey sheet ###################################### if(is.null(survey)){ survey <- tryCatch({ - as.data.frame(read_excel(form_tmp, sheet = "survey"), + as.data.frame(readxl::read_excel(form_tmp, sheet = "survey"), stringsAsFactors = FALSE) #read survey sheet from the form }, error = function(err) { data.frame( #if it doesn't exist, we need to create empty dataframe with those fields @@ -61,7 +61,7 @@ kobo_edit_form <- function(form = "form.xls", survey = NULL, choices = NULL, ind ) }) } - + if(!is.null(survey)){ survey[is.na(survey)] <- "" sheetname <- "survey" @@ -70,12 +70,12 @@ kobo_edit_form <- function(form = "form.xls", survey = NULL, choices = NULL, ind surveySheet <- xlsx::createSheet(wb, sheetname) #create survey sheet in wb xlsx::addDataFrame(survey, surveySheet, col.names=TRUE, row.names=FALSE) #add survey dataframe in the survey sheet } - - + + #################################### choices sheet ###################################### if(is.null(choices)){ choices <- tryCatch({ - as.data.frame(read_excel(form_tmp, sheet = "choices"), + as.data.frame(readxl::read_excel(form_tmp, sheet = "choices"), stringsAsFactors = FALSE) #read survey sheet from the form }, error = function(err) { data.frame( #if it doesn't exist, we need to create empty dataframe with those fields @@ -94,11 +94,11 @@ kobo_edit_form <- function(form = "form.xls", survey = NULL, choices = NULL, ind choicesSheet <- xlsx::createSheet(wb, sheetName=sheetname) xlsx::addDataFrame(choices, choicesSheet, col.names=TRUE, row.names=FALSE) } - + #################################### indicator sheet ###################################### if(is.null(indicator)){ indicator <- tryCatch({ - as.data.frame(read_excel(form_tmp, sheet = "indicator"),stringsAsFactors = FALSE) + as.data.frame(readxl::read_excel(form_tmp, sheet = "indicator"),stringsAsFactors = FALSE) }, error = function(err) { data.frame( type = character(), @@ -131,13 +131,13 @@ kobo_edit_form <- function(form = "form.xls", survey = NULL, choices = NULL, ind indicatorSheet <- xlsx::createSheet(wb, sheetName=sheetname) xlsx::addDataFrame(indicator, indicatorSheet, col.names=TRUE, row.names=FALSE) } - - - + + + #################################### settings sheet ###################################### if(is.null(settings)){ settings <- tryCatch({ - as.data.frame(read_excel(form_tmp, sheet = "settings"), + as.data.frame(readxl::read_excel(form_tmp, sheet = "settings"), stringsAsFactors = FALSE) }, error = function(err) { data.frame( @@ -150,18 +150,18 @@ kobo_edit_form <- function(form = "form.xls", survey = NULL, choices = NULL, ind } if(!is.null(settings)){ sheetname <- "settings" - + if(!is.null(xlsx::getSheets(wb)[[sheetname]])) xlsx::removeSheet(wb, sheetname) settingsSheet <- xlsx::createSheet(wb, sheetName=sheetname) #create sheet with settings name xlsx::addDataFrame(settings, settingsSheet, col.names=TRUE, row.names=FALSE) #add settings data frame to this sheet } - - + + #################################### settings sheet ###################################### if(is.null(analysisSettings)){ analysisSettings <- tryCatch({ - as.data.frame(read_excel(form_tmp, sheet = "analysisSettings"), + as.data.frame(readxl::read_excel(form_tmp, sheet = "analysisSettings"), stringsAsFactors = FALSE) }, error = function(err) { data.frame( @@ -175,7 +175,7 @@ kobo_edit_form <- function(form = "form.xls", survey = NULL, choices = NULL, ind } if(!is.null(analysisSettings)){ sheetname <- "analysisSettings" - + if(!is.null(xlsx::getSheets(wb)[[sheetname]])) xlsx::removeSheet(wb, sheetname) settingsSheet <- xlsx::createSheet(wb, sheetName=sheetname) #create sheet with analysisSettings name @@ -183,8 +183,8 @@ kobo_edit_form <- function(form = "form.xls", survey = NULL, choices = NULL, ind } if (file.exists(form_tmp)) file.remove(form_tmp) xlsx::saveWorkbook(wb, form_tmp) - - + + }, error = function(err) { print("kobo_load_data_ERROR") return(structure(err, class = "try-error")) diff --git a/R/kobo_encode.R b/R/kobo_encode.R index 66264f2..fdb7d20 100644 --- a/R/kobo_encode.R +++ b/R/kobo_encode.R @@ -29,7 +29,7 @@ kobo_encode <- function(data, dico) { # data <- MainDataFrame data.label <- as.data.frame(names(data)) names(data.label)[1] <- "fullname" - data.label <- join(x = data.label, y = dico, by = "fullname", type = "left" ) + data.label <- plyr::join(x = data.label, y = dico, by = "fullname", type = "left" ) ## Now we can also re-encode the records themself ################################################################################################# @@ -41,7 +41,7 @@ kobo_encode <- function(data, dico) { check <- as.data.frame(names(data)) names(check)[1] <- "fullname" check$id <- row.names(check) - selectdf2 <- join(y = check, x = selectdf, by = "fullname", type = "left") + selectdf2 <- plyr::join(y = check, x = selectdf, by = "fullname", type = "left") selectdf3 <- selectdf[!is.na(selectdf2$id), ] if (nrow(selectdf3) == 0) { @@ -103,7 +103,7 @@ kobo_encode <- function(data, dico) { check <- as.data.frame(names(data)) names(check)[1] <- "fullname" check$id <- row.names(check) - selectdf2 <- join(y = check, x = selectdf, by = "fullname", type = "left") + selectdf2 <- plyr::join(y = check, x = selectdf, by = "fullname", type = "left") selectdf3 <- selectdf[!is.na(selectdf2$id), ] if (nrow(selectdf3) == 0) { @@ -131,7 +131,7 @@ kobo_encode <- function(data, dico) { if (nrow(variablelevel) > 0) { variablelevel <- cbind(variablelevel,fullname,variablename,variablelistname) - variablelevel <- join(x = variablelevel, y = dico, by = "fullname", type = "left" ) + variablelevel <- plyr::join(x = variablelevel, y = dico, by = "fullname", type = "left" ) labelchoice <- as.character(dico[dico$fullname == fullname, c("labelchoice")]) data[ , fullname][data[ , fullname] == variablecode] <- labelchoice @@ -152,7 +152,7 @@ kobo_encode <- function(data, dico) { check <- as.data.frame(names(data)) names(check)[1] <- "fullname" check$id <- row.names(check) - selectdf2 <- join(y = check, x = selectdf, by = "fullname", type = "left") + selectdf2 <- plyr::join(y = check, x = selectdf, by = "fullname", type = "left") selectdf3 <- selectdf[!is.na(selectdf2$id), ] #names(selectdf)[1] <- "selectvar" @@ -180,7 +180,7 @@ kobo_encode <- function(data, dico) { df <- as.data.frame(data[ , fullname]) names(df)[1] <- "name" df$name <- as.character(df$name) - df <- join(df,variablelevel, by = "name") + df <- plyr::join(x = df, y = variablelevel, by = "name") data[ , fullname] <- as.character(data[ , fullname]) data[ , fullname] <- df$labelchoice #data[ , fullname] <- as.factor(data[ , fullname]) @@ -200,7 +200,7 @@ kobo_encode <- function(data, dico) { check <- as.data.frame(names(data)) names(check)[1] <- "fullname" check$id <- row.names(check) - selectdf2 <- join(y = check, x = selectdf, by = "fullname", type = "left") + selectdf2 <- plyr::join(y = check, x = selectdf, by = "fullname", type = "left") selectdf3 <- selectdf[!is.na(selectdf2$id), ] #names(selectdf)[1] <- "selectvar" diff --git a/R/kobo_encode_repeat.R b/R/kobo_encode_repeat.R index c6f0ed2..d5ab33f 100644 --- a/R/kobo_encode_repeat.R +++ b/R/kobo_encode_repeat.R @@ -29,7 +29,7 @@ kobo_encode_repeat <- function(data, dico) { #data <- data data.label <- as.data.frame(names(data)) names(data.label)[1] <- "name" - data.label <- join (x=data.label, y=dico, by="name", type="left" ) + data.label <- plyr::join(x = data.label, y = dico, by = "name", type = "left" ) ## Now we can also re-encode the records themself ################################################################################################# @@ -41,51 +41,51 @@ kobo_encode_repeat <- function(data, dico) { check <- as.data.frame(names(data)) names(check)[1] <- "fullname" check$id <- row.names(check) - selectdf2 <- join(y=check, x=selectdf, by="name", type="left") + selectdf2 <- plyr::join(y = check, x = selectdf, by = "name", type = "left") selectdf3 <- selectdf[!is.na(selectdf2$id), ] - if(nrow(selectdf3)==0){ + if (nrow(selectdf3) == 0) { cat("There's no disagreggated select_multiple variables to re-encoded \n") } else{ #names(selectdf)[1] <- "selectvar" for (i in 1:nrow(selectdf3)) { # i <- 98 - fullname <- as.character(selectdf3 [ i,1]) - variablename <- as.character(selectdf3 [ i,2]) - variablelistname <- as.character(selectdf3 [ i,3]) + fullname <- as.character(selectdf3[ i,1]) + variablename <- as.character(selectdf3[ i,2]) + variablelistname <- as.character(selectdf3[ i,3]) # variablelevel <- as.data.frame(levels(as.factor(data[ ,fullname]))) variablelevel <- as.data.frame(levels(as.factor(data[[fullname]]))) names(variablelevel)[1] <- "namecoded" - labelchoice <- as.character(dico[dico$fullname==fullname, c("labelchoice")]) - if (nrow(variablelevel)>0) { - if (nrow(variablelevel)>1) { + labelchoice <- as.character(dico[dico$fullname == fullname, c("labelchoice")]) + if (nrow(variablelevel) > 0) { + if (nrow(variablelevel) > 1) { data[ , fullname][is.na(data[ , fullname])] <- "Not replied" - data[ , fullname][data[ , fullname]=="Not replied"] <- "Not replied" - data[ , fullname][data[ , fullname]=="0"] <- "Not selected" - data[ , fullname][data[ , fullname]=="FALSE"] <- "Not selected" - data[ , fullname][data[ , fullname]=="False"] <- "Not selected" - data[ , fullname][data[ , fullname]=="1"] <- labelchoice - data[ , fullname][data[ , fullname]=="TRUE"] <- labelchoice - data[ , fullname][data[ , fullname]=="True"] <- labelchoice + data[ , fullname][data[ , fullname] == "Not replied"] <- "Not replied" + data[ , fullname][data[ , fullname] == "0"] <- "Not selected" + data[ , fullname][data[ , fullname] == "FALSE"] <- "Not selected" + data[ , fullname][data[ , fullname] == "False"] <- "Not selected" + data[ , fullname][data[ , fullname] == "1"] <- labelchoice + data[ , fullname][data[ , fullname] == "TRUE"] <- labelchoice + data[ , fullname][data[ , fullname] == "True"] <- labelchoice } else{ data[ , fullname][is.na(data[ , fullname])] <- "" - data[ , fullname][data[ , fullname]=="0"] <- "" - data[ , fullname][data[ , fullname]=="FALSE"] <- "" - data[ , fullname][data[ , fullname]=="False"] <- "" - data[ , fullname][data[ , fullname]=="1"] <- labelchoice - data[ , fullname][data[ , fullname]=="TRUE"] <- labelchoice - data[ , fullname][data[ , fullname]=="True"] <- labelchoice + data[ , fullname][data[ , fullname] == "0"] <- "" + data[ , fullname][data[ , fullname] == "FALSE"] <- "" + data[ , fullname][data[ , fullname] == "False"] <- "" + data[ , fullname][data[ , fullname] == "1"] <- labelchoice + data[ , fullname][data[ , fullname] == "TRUE"] <- labelchoice + data[ , fullname][data[ , fullname] == "True"] <- labelchoice } cat(paste0(i, "- Recode disagreggated select_multiple variable ", fullname," for: ",labelchoice, "\n")) - } else{ cat(paste0("The following variable has no answers to recode in the dataset: ",fullname, "\n")) } + } else {cat(paste0("The following variable has no answers to recode in the dataset: ",fullname, "\n")) } rm(fullname, variablename, variablelistname,variablelevel) } @@ -98,10 +98,10 @@ kobo_encode_repeat <- function(data, dico) { check <- as.data.frame(names(data)) names(check)[1] <- "fullname" check$id <- row.names(check) - selectdf2 <- join(y=check, x=selectdf, by="name", type="left") + selectdf2 <- plyr::join(y = check, x = selectdf, by = "name", type = "left") selectdf3 <- selectdf[!is.na(selectdf2$id), ] - if(nrow(selectdf3)==0) { + if (nrow(selectdf3) == 0) { cat("There's no disaggregated select_one variable to re-encoded \n") } else{ #names(selectdf)[1] <- "selectvar" @@ -111,24 +111,24 @@ kobo_encode_repeat <- function(data, dico) { #i <-1 #i <-195 #cat(i) - fullname <- as.character(selectdf3 [ i,1]) - variablename <- as.character(selectdf3 [ i,2]) - variablelistname <- as.character(selectdf3 [ i,3]) + fullname <- as.character(selectdf3[ i,1]) + variablename <- as.character(selectdf3[ i,2]) + variablelistname <- as.character(selectdf3[ i,3]) variablelevel <- as.data.frame(levels(as.factor(data[ ,fullname]))) names(variablelevel)[1] <- "namecoded" variablecode <- as.character(levels(as.factor(variablelevel$namecoded))) - if (nrow(variablelevel)>0) { + if (nrow(variablelevel) > 0) { variablelevel <- cbind(variablelevel,fullname,variablename,variablelistname) - variablelevel <- join (x=variablelevel, y=dico, by="fullname", type="left" ) - labelchoice <- as.character(dico[dico$fullname==fullname, c("labelchoice")]) - data[ , fullname][data[ , fullname]==variablecode] <- labelchoice + variablelevel <- plyr::join(x = variablelevel, y = dico, by = "fullname", type = "left" ) + labelchoice <- as.character(dico[dico$fullname == fullname, c("labelchoice")]) + data[ , fullname][data[ , fullname] == variablecode] <- labelchoice cat(paste0("Recode disaggregated select_one variable: ", fullname," for: ",labelchoice, "\n")) #View(data[i]) - } else { cat(paste0("The following disaggregated select_one variable has no answers to recode in the dataset: ",fullname, "\n")) } + } else {cat(paste0("The following disaggregated select_one variable has no answers to recode in the dataset: ",fullname, "\n")) } rm(fullname, variablename, variablelistname,variablelevel) } @@ -142,30 +142,30 @@ kobo_encode_repeat <- function(data, dico) { check <- as.data.frame(names(data)) names(check)[1] <- "fullname" check$id <- row.names(check) - selectdf2 <- join(y=check, x=selectdf, by="name", type="left") + selectdf2 <- plyr::join(y = check, x = selectdf, by = "name", type = "left") selectdf3 <- selectdf[!is.na(selectdf2$id), ] #names(selectdf)[1] <- "selectvar" - if(nrow(selectdf3)==0) { + if (nrow(selectdf3) == 0) { cat("There's no select_one variables to re-encode \n") } else { cat(paste0("There's ",nrow(selectdf3)," select_one variables to encode \n")) for (i in 1:nrow(selectdf3)) { # i <- 1 - fullname <- as.character(selectdf3 [ i,1]) - variablename <- as.character(selectdf3 [ i,2]) - variablelistname <- as.character(selectdf3 [ i,3]) + fullname <- as.character(selectdf3[ i,1]) + variablename <- as.character(selectdf3[ i,2]) + variablelistname <- as.character(selectdf3[ i,3]) - variablelevel <- dico[ dico$listname==variablelistname & dico$type=="select_one_d", c("name","labelchoice")] + variablelevel <- dico[ dico$listname == variablelistname & dico$type == "select_one_d", c("name","labelchoice")] variablelevel <- unique(variablelevel[ c("name","labelchoice")]) - if (nrow(variablelevel)>0) { + if (nrow(variablelevel) > 0) { #rm(df) df <- as.data.frame(data[ , fullname]) names(df)[1] <- "name" df$name <- as.character(df$name) - df <- join(df,variablelevel, by="name") + df <- plyr::join(x = df, y = variablelevel, by = "name") data[ , fullname] <- as.character(data[ , fullname]) data[ , fullname] <- df$labelchoice #data[ , fullname] <- as.factor(data[ , fullname]) @@ -173,7 +173,7 @@ kobo_encode_repeat <- function(data, dico) { #View(data[i]) cat(paste0("Recode variable: ", fullname," \n")) - } else { cat(paste0("The following variable has no answers to recode in the dataset: ",fullname, "\n")) } + } else {cat(paste0("The following variable has no answers to recode in the dataset: ",fullname, "\n")) } rm(fullname, variablename, variablelistname,variablelevel) } @@ -185,13 +185,13 @@ kobo_encode_repeat <- function(data, dico) { check <- as.data.frame(names(data)) names(check)[1] <- "fullname" check$id <- row.names(check) - selectdf2 <- join(y=check, x=selectdf, by="name", type="left") + selectdf2 <- plyr::join(y = check, x = selectdf, by = "name", type = "left") selectdf3 <- selectdf[!is.na(selectdf2$id), ] #names(selectdf)[1] <- "selectvar" - if(nrow(selectdf3)>=1) { + if (nrow(selectdf3) >= 1) { cat("Uhmm you have concatenated select_multiple. This case is not handled yet. \n") - } else{ cat("No concatenated select_multiple. Better like this! \n") } + } else {cat("No concatenated select_multiple. Better like this! \n") } return(data) } diff --git a/R/kobo_form.R b/R/kobo_form.R index 1feb2e7..4fa199a 100644 --- a/R/kobo_form.R +++ b/R/kobo_form.R @@ -1,57 +1,57 @@ -#' @name kobo_form -#' @rdname kobo_form -#' @title Download form from the platform -#' -#' @description Download form from the platform -#' -#' @param formid The ID of the form to be accessed (as a character string). -#' @param user Optional. A single string indicating the username and password -#' (in the form of \code{"username:password"}), or a character vector or list, -#' length 2, with the first value being the "username", and the second being -#' the "password". -#' @param api The URL at which the API can be accessed. -#' Defaults to "unhcr", which loads the UNHCR KoBo Toolbox API. -#' -#' @return Downloaded form path. -#' -#' @author Edouard Legoupil -#' -#' @examples -#' kobo_form() -#' -#' @examples -#' \dontrun{ -#' kobo_form("15051") -#' kobo_form("31511", user = userpwd, api = "unhcr") -#' } -#' -#' @export kobo_form -#' - - -kobo_form <- function(formid, userpwd, api) { - - URL1 <- sprintf(fmt = '%sforms/%s/form.xls', api, formid) - form_tmp <- file(paste0("data/form_",formid,".xls"), open = "wb") - #rm(form_tmp) - bin <- getBinaryURL(URL1, userpwd , httpauth = 1L, ssl.verifypeer=FALSE ) - writeBin(bin, form_tmp) - close(form_tmp) - - ## test with xlsx - URL2 <- sprintf(fmt = '%sforms/%s/form.xlsx', api, formid) - form_tmp2 <- file(paste0("data/form_",formid,".xlsx"), open = "wb") - bin <- getBinaryURL(URL2, userpwd , httpauth = 1L, ssl.verifypeer=FALSE ) - writeBin(bin, form_tmp2) - close(form_tmp2) - - #locfileform <- sprintf(fmt = "form_%s", formid) - #URL <- sprintf(fmt = '%sforms/%s/form.xls', koboloadeR::host(api), formid) - #x <- koboloadeR::get_me(user, URL) - #cat("\n\n") - #form <- koboloadeR::f_csv(x) - #assign(locfileform, form, envir = .GlobalEnv) - #out - - return(form_tmp) -} +#' @name kobo_form +#' @rdname kobo_form +#' @title Download form from the platform +#' +#' @description Download form from the platform +#' +#' @param formid The ID of the form to be accessed (as a character string). +#' @param userpwd Optional. A single string indicating the username and password +#' (in the form of \code{"username:password"}), or a character vector or list, +#' length 2, with the first value being the "username", and the second being +#' the "password". +#' @param api The URL at which the API can be accessed. +#' Defaults to "unhcr", which loads the UNHCR KoBo Toolbox API. +#' +#' @return Downloaded form path. +#' +#' @author Edouard Legoupil +#' +#' @examples +#' kobo_form() +#' +#' @examples +#' \dontrun{ +#' kobo_form("15051") +#' kobo_form("31511", user = userpwd, api = "unhcr") +#' } +#' +#' @export kobo_form +#' + + +kobo_form <- function(formid, userpwd, api) { + + URL1 <- sprintf(fmt = '%sforms/%s/form.xls', api, formid) + form_tmp <- file(paste0("data/form_",formid,".xls"), open = "wb") + #rm(form_tmp) + bin <- RCurl::getBinaryURL(URL1, userpwd , httpauth = 1L, ssl.verifypeer=FALSE ) + writeBin(bin, form_tmp) + close(form_tmp) + + ## test with xlsx + URL2 <- sprintf(fmt = '%sforms/%s/form.xlsx', api, formid) + form_tmp2 <- file(paste0("data/form_",formid,".xlsx"), open = "wb") + bin <- RCurl::getBinaryURL(URL2, userpwd , httpauth = 1L, ssl.verifypeer=FALSE ) + writeBin(bin, form_tmp2) + close(form_tmp2) + + #locfileform <- sprintf(fmt = "form_%s", formid) + #URL <- sprintf(fmt = '%sforms/%s/form.xls', koboloadeR::host(api), formid) + #x <- koboloadeR::get_me(user, URL) + #cat("\n\n") + #form <- koboloadeR::f_csv(x) + #assign(locfileform, form, envir = .GlobalEnv) + #out + + return(form_tmp) +} diff --git a/R/kobo_forminfo.R b/R/kobo_forminfo.R index f933d26..58c545d 100644 --- a/R/kobo_forminfo.R +++ b/R/kobo_forminfo.R @@ -1,46 +1,47 @@ -#' @name kobo_forminfo -#' @rdname kobo_forminfo -#' @title Get form attributes -#' -#' -#' @description Obtain form info in order to correctly retrieve the form. -#' -#' @param formid The ID of the form to be accessed (as a character string). -#' @param user Optional. A single string indicating the username and password -#' (in the form of \code{"username:password"}), or a character vector or list, -#' length 2, with the first value being the "username", and the second being -#' the "password". -#' @param api The URL at which the API can be accessed. -#' Defaults to "unhcr", which loads the UNHCR KoBo Toolbox API. -#' @return A "data.table" with the full forminfo. -#' The forminfo would be named in the form of "data_formid". -#' -#' @return The URL of the form based on form id. -#' -#' @author Edouard Legoupil -#' -#' @examples kobo_forminfo() -#'#' @examples -#' \dontrun{ -#' kobo_forminfo("15051") -#' kobo_forminfo("31511", api = "unhcr") -#' } -#' -#' -#' @export kobo_forminfo -#' - -kobo_forminfo <- function(formid, user = NULL, api = api) { - - locfile <- sprintf(fmt = "forminfo_%s", formid) - - URL <- sprintf(fmt = '%sforms/%s?format=csv', api, formid) - - x <- get_me(user, URL) - out <- f_csv(x) - assign(locfile, out, envir = .GlobalEnv) - out - formauthor <- as.charater(out[, c("owner")]) - formdescr <- out[, c("id_string")] -} -NULL +#' @name kobo_forminfo +#' @rdname kobo_forminfo +#' @title Get form attributes +#' +#' +#' @description Obtain form info in order to correctly retrieve the form. +#' +#' @param formid The ID of the form to be accessed (as a character string). +#' @param user Optional. A single string indicating the username and password +#' (in the form of \code{"username:password"}), or a character vector or list, +#' length 2, with the first value being the "username", and the second being +#' the "password". +#' @param api The URL at which the API can be accessed. +#' Defaults to "unhcr", which loads the UNHCR KoBo Toolbox API. +#' @return A "data.table" with the full forminfo. +#' The forminfo would be named in the form of "data_formid". +#' +#' @return The URL of the form based on form id. +#' +#' @author Edouard Legoupil +#' +#' @examples kobo_forminfo() +#'#' @examples +#' \dontrun{ +#' kobo_forminfo("15051") +#' kobo_forminfo("31511", api = "unhcr") +#' } +#' +#' +#' @export kobo_forminfo +#' + +kobo_forminfo <- function(formid, user = NULL, api = api) { + + locfile <- sprintf(fmt = "forminfo_%s", formid) + + URL <- sprintf(fmt = '%sforms/%s?format=csv', api, formid) + + x <- get_me(user, URL) + out <- f_csv(x) + assign(locfile, out #, envir = .GlobalEnv + ) + out + formauthor <- as.charater(out[, c("owner")]) + formdescr <- out[, c("id_string")] +} +NULL diff --git a/R/kobo_get_begin_repeat.R b/R/kobo_get_begin_repeat.R index ffaf701..88b2019 100644 --- a/R/kobo_get_begin_repeat.R +++ b/R/kobo_get_begin_repeat.R @@ -26,13 +26,13 @@ #' kobo_get_begin_repeat <- function(form = "form.xls") { - + mainDir <- kobo_getMainDirectory() form_tmp <- paste(mainDir, "data", form, sep = "/", collapse = "/") - + ### First review all questions from survey sheet ################################################# survey <- tryCatch({ - as.data.frame(read_excel(form_tmp, sheet = "survey")) #read survey sheet from the form + as.data.frame(readxl::read_excel(form_tmp, sheet = "survey")) #read survey sheet from the form }, error = function(err) { return( list( @@ -41,12 +41,12 @@ kobo_get_begin_repeat <- function(form = "form.xls") { ) ) }) - + survey$type <- tolower(survey$type) - result <- survey %>% filter(type=="begin repeat" | type=="begin_repeat" | type=="begin-repeat") + result <- survey %>% dplyr::filter(type == "begin repeat" | type == "begin_repeat" | type == "begin-repeat") result <- result$name - - if(length(result)==0){ + + if (length(result) == 0) { return( list( names = result, @@ -64,4 +64,4 @@ kobo_get_begin_repeat <- function(form = "form.xls") { ) } } -NULL \ No newline at end of file +NULL diff --git a/R/kobo_get_config.R b/R/kobo_get_config.R index 6b7e147..04b8397 100644 --- a/R/kobo_get_config.R +++ b/R/kobo_get_config.R @@ -2,17 +2,17 @@ #' @rdname kobo_get_config #' @title Get Configuration #' -#' @description Return all configuration from Analysis Settings sheet of xlsform -#' +#' @description Return all configuration from Analysis Settings sheet of xlsform +#' #' @param form The full filename of the form to be accessed (xls or xlsx file). where settings sheet contains all configuration of the project -#' +#' #' @return Return a dataframe that contains configuration of the project #' #' @author Maher Daoud #' #' @examples #' kobo_get_config() -#' +#' #' @export kobo_get_config #' @@ -20,8 +20,7 @@ kobo_get_config <- function(form = "form.xls") { mainDir <- kobo_getMainDirectory() form_tmp <- paste(mainDir, "data", form, sep = "/", collapse = "/") settings <- tryCatch({ - as.data.frame(read_excel(form_tmp, sheet = "analysisSettings"), - stringsAsFactors = FALSE) + as.data.frame(readxl::read_excel(form_tmp, sheet = "analysisSettings"), stringsAsFactors = FALSE) }, error = function(err) { data.frame( name = character(), @@ -32,4 +31,4 @@ kobo_get_config <- function(form = "form.xls") { ) }) return(settings) -} \ No newline at end of file +} diff --git a/R/kobo_get_dataframes_levels.R b/R/kobo_get_dataframes_levels.R index 0483c24..bc8c813 100644 --- a/R/kobo_get_dataframes_levels.R +++ b/R/kobo_get_dataframes_levels.R @@ -28,7 +28,7 @@ kobo_get_dataframes_levels <- function(form="form.xls") { mainDir <- kobo_getMainDirectory() form_tmp <- paste(mainDir, "data", form, sep = "/", collapse = "/") survey <- tryCatch({ - as.data.frame(read_excel(form_tmp, sheet = "survey"), + as.data.frame(readxl::read_excel(form_tmp, sheet = "survey"), stringsAsFactors = FALSE) #read survey sheet from the form }, error = function(err) { data.frame( #if it doesn't exist, we need to create empty dataframe with those fields @@ -53,11 +53,11 @@ kobo_get_dataframes_levels <- function(form="form.xls") { }) survey <- survey[c("name","type")] survey$type <- tolower(survey$type) - survey$type <- str_replace(survey$type,"_"," ") - survey$type <- str_replace(survey$type,"-"," ") + survey$type <- stringr::str_replace(survey$type,"_"," ") + survey$type <- stringr::str_replace(survey$type,"-"," ") survey <- survey[!is.na(survey$type),] survey <- survey[survey$type=="begin repeat" | survey$type=="end repeat", ] - + if(nrow(survey)==0){ return(data.frame( name = "MainDataFrame", @@ -66,7 +66,7 @@ kobo_get_dataframes_levels <- function(form="form.xls") { ,stringsAsFactors = F )) } - + result <- data.frame( name = "MainDataFrame", level = 1, @@ -78,7 +78,7 @@ kobo_get_dataframes_levels <- function(form="form.xls") { open = logical(), stringsAsFactors = F ) - + for(i in 1:nrow(survey)){ st <- survey$type[i] sn <- ifelse(st=="begin repeat",survey$name[i],NA) @@ -94,7 +94,7 @@ kobo_get_dataframes_levels <- function(form="form.xls") { c(sn, as.integer(result[result$name==tempName,"level"]) + 1, tempName) ) } - opcl <- rbind(opcl, + opcl <- rbind(opcl, data.frame( name = sn, open = T, diff --git a/R/kobo_histo.R b/R/kobo_histo.R deleted file mode 100644 index bd2ff0a..0000000 --- a/R/kobo_histo.R +++ /dev/null @@ -1,115 +0,0 @@ -#' @name kobo_histo -#' @rdname kobo_histo -#' @title Generate histograme for all integer questions -#' -#' @description Automatically generate histogrammes for each of the integer questions in the dataset. ggplot2 is used. -#' -#' @param mainDir Path to the project's working directory: mainly for proper shiny app path -#' -#' @author Edouard Legoupil -#' -#' @examples -#' kobo_histo() -#' -#' @export kobo_histo -#' -#' @examples -#' \dontrun{ -#' kobo_histo() -#' } -#' -#' - -kobo_histo <- function(mainDir='') { - if (mainDir==''){ - mainDir <- getwd() - } - - source(paste0(mainDir,"/code/0-config.R"), local=TRUE) - data <- read_excel(path.to.data, sheet=sheet) - - - mainDirectory <- paste0(mainDir,"/out") - subDir <- "/histo" - if (file.exists(paste(mainDirectory, subDir, "/", sep = "/", collapse = "/"))) { - cat("histo directory exists in out directory and is a directory.\n") - } else if (file.exists(paste(mainDirectory, subDir, sep = "/", collapse = "/"))) { - cat("histo directory exists in your out directory.\n") - # you will probably want to handle this separately - } else { - cat("histo directory does not exist in your out directory - creating now!\n ") - dir.create(file.path(mainDirectory, subDir)) - } - - - selectdf <- dico[dico$type=="integer" | dico$type=="decimal" | dico$type=="calculate" &dico$name!=c("__version__","_version_"), c("fullname","listname","label","name","type")] - - - ### Verify that those variable are actually in the original dataframe - check <- as.data.frame(names(data)) - names(check)[1] <- "fullname" - check$id <- row.names(check) - selectdf <- join(x=selectdf, y=check, by="fullname", type="left") - selectdf <- selectdf[!is.na(selectdf$id), ] - - if (nrow(selectdf)==0){ - cat("There's no integer variables. \n") - } else{ - - selectinteger <- as.character(selectdf[, c("fullname")]) - data.integer <- data [selectinteger ] - - selectfacet <- as.character(selectdf[selectdf$disaggregation!="" , c("fullname")]) - selectfacet <- selectfacet[!is.na(selectfacet)] - - - ## force to data frame - data.integer <- as.data.frame(data.integer) - data.integer <- kobo_label(data.integer, dico) - wrapper <- function(x, ...) - { - paste(strwrap(x, ...), collapse = "\n") - } - for (i in 1:nrow(selectdf) ) { - # for (i in 1:2 ) { - # i <- 67 - variablename <- names(data.integer)[i] - title <- attributes(data.integer)$variable.labels[i] - - ## Ensure that the variable is recognised as integer - select.data.integer <- data.frame(as.numeric(na.omit(data.integer[ ,i]))) - #str(data.integer[ , i]) - - totalanswer <- nrow(data.integer) - - count_replied <- (sum(!is.na(data.integer[,i ]))) - - percentresponse <- paste(round((count_replied/totalanswer*100),digits=2),"%",sep="") - - theme_set(theme_gray(base_size = 18)) - - - # trendline on histogram by adding geom_density - ggplot(data=select.data.integer, aes(select.data.integer)) + - geom_histogram(aes(y =..density..), fill="#2a87c8", alpha = .6, binwidth=0.5) + - geom_density(adjust=2) + - scale_x_continuous(expand = c(0,0)) + - ggtitle(wrapper(title,width=50))+ - labs(x="", y="Frequency")+ - theme(plot.title=element_text(face="bold", size=20), - plot.background = element_rect(fill = "transparent",colour = NA)) - ggsave(filename=paste(mainDir,"/out/histo/",variablename,"_histo.png",sep=""), width=10, height=10,units="in", dpi=300) - - cat(paste0(i, "- Generated density graphs for question: ", title , "\n")) - } - } - cat(" \n") - cat(" \n") - cat(" ###########################################################\n") - cat(" # The histograms for number questions were generated! #\n") - cat(" # You can find them in the folder 'out/histo'! #\n") - cat(" ###########################################################\n") - - -} -NULL diff --git a/R/kobo_histo_print.R b/R/kobo_histo_print.R deleted file mode 100644 index 0b41a90..0000000 --- a/R/kobo_histo_print.R +++ /dev/null @@ -1,72 +0,0 @@ -#' @name kobo_histo_print -#' @rdname kobo_histo_print -#' @title Generate histograme for all integer questions -#' -#' @description Automatically generate histogrammes for each of the integer questions in the dataset. ggplot2 is used. -#' -#' @param data kobodatset to use -#' @param dico ( generated from kobo_dico) -#' -#' @author Edouard Legoupil -#' -#' @examples -#' kobo_histo_print() -#' -#' @export kobo_histo_print -#' -#' @examples -#' \dontrun{ -#' kobo_histo_print(data, dico) -#' } -#' -#' - -kobo_histo_print <- function(data, dico) { - - selectdf <- dico[dico$type=="integer", c("fullname","listname","label","name","qrepeat","type")] - - - ### Verify that those variable are actually in the original dataframe - check <- as.data.frame(names(data)) - names(check)[1] <- "fullname" - check$id <- row.names(check) - selectdf <- join(x=selectdf, y=check, by="fullname", type="left") - selectdf <- selectdf[!is.na(selectdf$id), ] - - if (nrow(selectdf)==0){ - cat("There's no integer variables. \n") - } else{ - - selectinteger <- as.character(selectdf[, c("fullname")]) - data.integer <- data [selectinteger ] - - ## force to data frame - data.integer <- as.data.frame(data.integer) - data.integer <- kobo_label(data.integer, dico) - - for (i in 1:nrow(selectdf) ) { - # for (i in 1:2 ) { - # i <- 67 - variablename <- names(data.integer)[i] - title <- attributes(data.integer)$variable.labels[i] - - ## Ensure that the variable is recognised as integer - data.integer[ , i] <- as.integer(data.integer[ , i]) - # regular histogram - plot <- ggplot(data=data.integer, aes(data.integer[ , i])) + - geom_histogram(fill="#2a87c8",colour="white", binwidth = 1) + - ggtitle(title)+ - labs(x="", y="Count")+ - #scale_x_discrete() + - scale_x_continuous(breaks= pretty_breaks()) + - theme(plot.title=element_text(face="bold", size=9), - plot.background = element_rect(fill = "transparent",colour = NA)) - print(plot) - ##ggsave(filename=paste("out/histo/histo_",variablename,".png",sep=""), width=10, height=10,units="in", dpi=300) - ##cat(paste0("Generated histogramme for question: ", title , "\n")) - } - - - } -} -NULL diff --git a/R/kobo_indicator.R b/R/kobo_indicator.R index 2f2e80b..5bd59a8 100644 --- a/R/kobo_indicator.R +++ b/R/kobo_indicator.R @@ -21,12 +21,12 @@ kobo_indicator <- function(mainDir = '') { mainDir <- getwd() } source(paste0(mainDir, "/code/0-config.R"), local = TRUE) - data <- read_excel(path.to.data, sheet=sheet) + data <- readxl::read_excel(path.to.data, sheet = sheet) if (analysis_plan == "y") { # Getting the analysis plan - selectdf <-read_excel(paste0(mainDir, "/data/", form) , sheet = 'analysis_plan') + selectdf <- readxl::read_excel(paste0(mainDir, "/data/", form) , sheet = 'analysis_plan') selectdf <- data.frame(selectdf, stringsAsFactors = FALSE) calculation <- data.frame(selectdf["calculation"]) @@ -81,15 +81,15 @@ kobo_indicator <- function(mainDir = '') { # Getting calculation calc <- as.character(calculation[i, "calculation"]) #splitting variables and operators - calc_split <-data.frame(strsplit(calc, ",")[[1]], stringsAsFactors = FALSE) + calc_split <- data.frame(strsplit(calc, ",")[[1]], stringsAsFactors = FALSE) operators <- c("+", "-", "/", "*", "(", ")") #Matching variables with dico and renaming for (j in 1:nrow(calc_split)) { - split_temp <- as.character(trim(calc_split[j, ])) + split_temp <- as.character(glue::trim(calc_split[j, ])) if (split_temp %in% operators) { - calc_split[j, ] <- trim(calc_split[j, ]) + calc_split[j, ] <- glue::trim(calc_split[j, ]) } else{ calc_split[j, ] <- as.character(dico[dico$name == split_temp, c("fullname"), ]) @@ -100,7 +100,7 @@ kobo_indicator <- function(mainDir = '') { # Calculating values ### data frame to keep all the results - res_tab <-data.frame(c(1:nrow(calc_split)), stringsAsFactors = FALSE) + res_tab <- data.frame(c(1:nrow(calc_split)), stringsAsFactors = FALSE) #Going through all observations for (k in 1:nrow(data)) { @@ -141,12 +141,12 @@ kobo_indicator <- function(mainDir = '') { data <- data.frame(data) #Rewrite data with new variables - wb <- loadWorkbook(path.to.data) - sheets <- getSheets(wb) - removeSheet(wb, sheetName = "cleaned_data") - new_sheet <- createSheet(wb, sheetName = as.character("cleaned_data")) - addDataFrame(data, new_sheet, row.names = FALSE) - saveWorkbook(wb, path.to.data) + wb <- xlsx::loadWorkbook(path.to.data) + sheets <- xlsx::getSheets(wb) + xlsx::removeSheet(wb, sheetName = "cleaned_data") + new_sheet <- xlsx::createSheet(wb, sheetName = as.character("cleaned_data")) + xlsx::addDataFrame(data, new_sheet, row.names = FALSE) + xlsx::saveWorkbook(wb, path.to.data) } diff --git a/R/kobo_label.R b/R/kobo_label.R index 58aa54d..86a6a07 100644 --- a/R/kobo_label.R +++ b/R/kobo_label.R @@ -5,8 +5,8 @@ #' @description Insert the full label in data frame based on dictionnary #' #' -#' @param data . -#' @param dico ( generated from kobo_dico) +#' @param datalabel file to be labeled +#' @param dico generated from kobo_dico) #' #' #' @return A "data.table" with the full data.label. To be used for graphs generation. @@ -31,14 +31,14 @@ kobo_label <- function(datalabel, dico) { #datalabel <- household_member data.label <- as.data.frame(names(datalabel)) names(data.label)[1] <- "fullname" - data.label <- join (x=data.label, y=dico, by="fullname", type="left" ) + data.label <- plyr::join(x = data.label, y = dico, by = "fullname", type = "left" ) # write.csv(data.label, "out/datalabel.csv") for (i in 1:nrow(data.label)) { attributes(datalabel)$variable.labels[ i] <- as.character(data.label[ i, c("labelReport")]) } test <- data.label[ !(is.na(data.label$name)), ] if (nrow(data.label) > nrow(test)) { - cat (paste0("you have ",nrow(data.label), " variables in you frame but only ",nrow(test) ," were relabeled.\n")) + cat(paste0("you have ",nrow(data.label), " variables in you frame but only ",nrow(test) ," were relabeled.\n")) cat(" You may double check that the form and the data are matching \n") cat("Double check as well that you did download the data with the correct header (i.e. full path with point delimiters) \n") - } else { cat ("All variables were mapped. great \n")} + } else {cat("All variables were mapped. great \n")} return(datalabel) } diff --git a/R/kobo_left_align.R b/R/kobo_left_align.R index 37022fb..1f266bb 100644 --- a/R/kobo_left_align.R +++ b/R/kobo_left_align.R @@ -8,6 +8,9 @@ #' #' @author Edouard Legoupil - with inspiration from bbc #' +#' @param plot_name ggplot2 object +#' @param pieces plot labels to align +#' #' @examples #' kobo_left_align() #' diff --git a/R/kobo_load_data.R b/R/kobo_load_data.R index 0919799..732dedf 100644 --- a/R/kobo_load_data.R +++ b/R/kobo_load_data.R @@ -55,16 +55,16 @@ kobo_load_data <- function(form = "form.xls", app = "console") { cat("\n\n\n Generate dictionnary from the xlsform \n\n\n\n") mainDir <- kobo_getMainDirectory() kobo_dico(form) - dico <- read.csv(paste0(mainDir,"/data/dico_",form,".csv"), encoding = "UTF-8", na.strings = "") + dico <- utils::read.csv(paste0(mainDir,"/data/dico_",form,".csv"), encoding = "UTF-8", na.strings = "") ## Load data ####################################################################### cat("\n\n\n Load original dataset \n\n\n\n") - originalData <- read.csv(configInfoOrigin[configInfoOrigin$name == "MainDataFrame", "path"], sep = ",", encoding = "UTF-8", na.strings = "") + originalData <- utils::read.csv(configInfoOrigin[configInfoOrigin$name == "MainDataFrame", "path"], sep = ",", encoding = "UTF-8", na.strings = "") if (ncol(originalData) == 1) { cat("seems like you file use ; rather , variable separator.... \n") - originalData <- read.csv(configInfoOrigin[configInfoOrigin$name == "MainDataFrame", "path"], sep = ";", encoding = "UTF-8", na.strings = "") + originalData <- utils::read.csv(configInfoOrigin[configInfoOrigin$name == "MainDataFrame", "path"], sep = ";", encoding = "UTF-8", na.strings = "") } ## Check to split select_multiple if data is extracted from ODK ################### @@ -107,11 +107,11 @@ kobo_load_data <- function(form = "form.xls", app = "console") { } path <- configInfoOrigin[configInfoOrigin$name == "weights_info", "path"] - weight <- read.csv(path,stringsAsFactors = F) + weight <- utils::read.csv(path,stringsAsFactors = F) variableName <- configInfoOrigin[configInfoOrigin$name == "variable_name", "value"] - MainDataFrame <- left_join(x = MainDataFrame, y = weight, by = variableName) + MainDataFrame <- plyr::join(x = MainDataFrame, y = weight, by = variableName, type = "left") } @@ -135,7 +135,7 @@ kobo_load_data <- function(form = "form.xls", app = "console") { cat("\n\n Write backup before encoding or indicators calculation..\n") - write.csv(MainDataFrame,paste(mainDir,"/data/MainDataFrame_edited.csv",sep = ""), row.names = FALSE, na = "") + utils::write.csv(MainDataFrame,paste(mainDir,"/data/MainDataFrame_edited.csv",sep = ""), row.names = FALSE, na = "") @@ -170,7 +170,7 @@ kobo_load_data <- function(form = "form.xls", app = "console") { } # dbr <- levelsOfDF$name[1] cat("\n\nloading",dbr,"file ..\n") - dataFrame <- read.csv(configInfoOrigin[configInfoOrigin$name == dbr,"path"], stringsAsFactors = F) + dataFrame <- utils::read.csv(configInfoOrigin[configInfoOrigin$name == dbr,"path"], stringsAsFactors = F) if (app == "shiny") { progress$set(message = paste("Splitting",dbr,"file in progress...")) @@ -197,7 +197,7 @@ kobo_load_data <- function(form = "form.xls", app = "console") { cat("\n\n Saving ",dbr,"file as _edited..\n") - write.csv(dataFrame,paste(mainDir,"/data/",dbr,"_edited.csv",sep = ""), row.names = FALSE, na = "") + utils::write.csv(dataFrame,paste(mainDir,"/data/",dbr,"_edited.csv",sep = ""), row.names = FALSE, na = "") # } # @@ -210,7 +210,7 @@ kobo_load_data <- function(form = "form.xls", app = "console") { # updateProgress() # } # - # dataFrame <- read.csv(paste(mainDir,"/data/",dbr,"_edited.csv",sep = ""),stringsAsFactors = F) + # dataFrame <- utils::read.csv(paste(mainDir,"/data/",dbr,"_edited.csv",sep = ""),stringsAsFactors = F) child <- levelsOfDF[levelsOfDF$name == dbr, "name"] parent <- levelsOfDF[levelsOfDF$name == dbr, "parent"] @@ -222,10 +222,10 @@ kobo_load_data <- function(form = "form.xls", app = "console") { ## Case MainDataFrame called household if (parent %in% c("household", "MainDataFrame")) { - parentDf <- read.csv(paste(mainDir,"/data/",parent,"_edited.csv",sep = ""),stringsAsFactors = F) + parentDf <- utils::read.csv(paste(mainDir,"/data/",parent,"_edited.csv",sep = ""),stringsAsFactors = F) }else{ - parentDf <- read.csv(paste(mainDir,"/data/",parent,"_edited.csv",sep = ""),stringsAsFactors = F) + parentDf <- utils::read.csv(paste(mainDir,"/data/",parent,"_edited.csv",sep = ""),stringsAsFactors = F) } @@ -267,7 +267,7 @@ kobo_load_data <- function(form = "form.xls", app = "console") { } cat("\n\n Saving edited version of ", dbr, " ...\n") - write.csv(dataFrame,paste(mainDir,"/data/",dbr,"_edited.csv",sep = ""), row.names = FALSE, na = "") + utils::write.csv(dataFrame,paste(mainDir,"/data/",dbr,"_edited.csv",sep = ""), row.names = FALSE, na = "") } @@ -290,9 +290,9 @@ kobo_load_data <- function(form = "form.xls", app = "console") { - dico <- read.csv(paste0(mainDir,"/data/dico_",form,".csv"), encoding = "UTF-8", na.strings = "") + dico <- utils::read.csv(paste0(mainDir,"/data/dico_",form,".csv"), encoding = "UTF-8", na.strings = "") - MainDataFrame <- read.csv(paste(mainDir,"/data/MainDataFrame_edited.csv",sep = ""), encoding = "UTF-8", na.strings = "NA") + MainDataFrame <- utils::read.csv(paste(mainDir,"/data/MainDataFrame_edited.csv",sep = ""), encoding = "UTF-8", na.strings = "NA") ## Re-encoding data now based on the dictionnary -- ############################## @@ -309,9 +309,9 @@ kobo_load_data <- function(form = "form.xls", app = "console") { ## loading nested frame for (dbr in levelsOfDF$name) { - dataFrame <- read.csv(paste(mainDir,"/data/",dbr,"_edited.csv",sep = ""),stringsAsFactors = F) + dataFrame <- utils::read.csv(paste(mainDir,"/data/",dbr,"_edited.csv",sep = ""),stringsAsFactors = F) dataFrame <- kobo_encode(dataFrame, dico) - write.csv(dataFrame,paste(mainDir,"/data/",dbr,"_encoded.csv",sep = ""), row.names = FALSE, na = "") + utils::write.csv(dataFrame,paste(mainDir,"/data/",dbr,"_encoded.csv",sep = ""), row.names = FALSE, na = "") cat("\n\nRe-encode",dbr,"..\n") } @@ -319,7 +319,7 @@ kobo_load_data <- function(form = "form.xls", app = "console") { updateProgress() } - write.csv(MainDataFrame,paste(mainDir,"/data/MainDataFrame_encoded.csv",sep = ""), row.names = FALSE, na = "") + utils::write.csv(MainDataFrame,paste(mainDir,"/data/MainDataFrame_encoded.csv",sep = ""), row.names = FALSE, na = "") return(TRUE) }, error = function(err) { diff --git a/R/kobo_prediction_report.R b/R/kobo_prediction_report.R index f77bc7d..bd15095 100644 --- a/R/kobo_prediction_report.R +++ b/R/kobo_prediction_report.R @@ -20,7 +20,9 @@ #' #' #' -#' @param kobo or odk dataset to use +#' @param frame odk dataset to use +#' @param registry file with registration information +#' @param dico generated from kobo_dico) #' #' #' @author Damien Seite, Edouard Legoupil @@ -62,17 +64,17 @@ kobo_prediction_report <- function(dico, frame, registry) { selected.predict <- dico[ which(dico$predict == "yes" & dico$type %in% c("select_one","select_one_d",'integer')), ] - selected.predict <- join(x = selected.predict, y = check, by = "fullname", type = "left") + selected.predict <- plyr::join(x = selected.predict, y = check, by = "fullname", type = "left") selected.predict <- subset(selected.predict, fullname %in% check$fullname) library(stringr) #selected.predict <- selected.predict[!is.na(selected.predict$id), ] selected.predictVars <- as.character(selected.predict[ , c("fullname")]) #selected.clusterVars2 <- as.character(selected.cluster[ , c("name")]) - selected.predictVars2 <- str_replace_all(as.character(selected.predict[ , c("name")]), "_", ".") + selected.predictVars2 <- stringr::str_replace_all(as.character(selected.predict[ , c("name")]), "_", ".") selected.id <- dico[ which(dico$predict == "id"), ] - selected.id <- join(x = selected.id, y = check, by = "fullname", type = "left") + selected.id <- plyr::join(x = selected.id, y = check, by = "fullname", type = "left") selected.id <- selected.id[!is.na(selected.id$id), ] selected.idVars <- as.character(selected.id[ , c("fullname")]) @@ -81,7 +83,7 @@ kobo_prediction_report <- function(dico, frame, registry) { ## Join Survey & Registration ###### survey$demo.reg_question.unhcr_case_number <- as.character(subset(survey, select = selected.idVars)[,1]) - surveypro <- join(x = survey, y = progrescase, by = "demo.reg_question.unhcr_case_number", type = "inner") + surveypro <- plyr::join(x = survey, y = progrescase, by = "demo.reg_question.unhcr_case_number", type = "inner") cat(round(nrow(surveypro)/nrow(progrescase)*100, digits = 1),"%", "of registered people are also in the household survey dataset" ) if (nrow(selected.predict) == 0) { cat("You have not selected variables to predict \n") } diff --git a/R/kobo_prepare_form.R b/R/kobo_prepare_form.R index 5d54b86..517e1f3 100644 --- a/R/kobo_prepare_form.R +++ b/R/kobo_prepare_form.R @@ -47,7 +47,7 @@ kobo_prepare_form <- function(form = "form.xls") { # Survey sheet ###################################### survey <- tryCatch({ - as.data.frame(read_excel(form_tmp, sheet = "survey"), + as.data.frame(readxl::read_excel(form_tmp, sheet = "survey"), stringsAsFactors = FALSE) #read survey sheet from the form }, error = function(err) { data.frame( #if it doesn't exist, we need to create empty dataframe with those fields @@ -279,12 +279,12 @@ kobo_prepare_form <- function(form = "form.xls") { xlsx::Fill(backgroundColor = "GREY_50_PERCENT",foregroundColor = "GREY_50_PERCENT", pattern = "SOLID_FOREGROUND") + xlsx::Border(color = "GREY_80_PERCENT", position = c("TOP", "BOTTOM"), "BORDER_THIN") - cs1 <- CellStyle(wb) + + cs1 <- xlsx::CellStyle(wb) + xlsx::Font(wb, isBold = TRUE, isItalic = FALSE, color = "black") + xlsx::Fill(backgroundColor = "SKY_BLUE", foregroundColor = "SKY_BLUE", pattern = "SOLID_FOREGROUND") + xlsx::Border(color = "SKY_BLUE", position = c("TOP", "BOTTOM"), "BORDER_THIN") - cs2 <- CellStyle(wb) + + cs2 <- xlsx::CellStyle(wb) + xlsx::Font(wb, isBold = TRUE, isItalic = FALSE, color = "white") + xlsx::Fill(backgroundColor = "orange", foregroundColor = "orange", pattern = "SOLID_FOREGROUND") + @@ -349,7 +349,7 @@ kobo_prepare_form <- function(form = "form.xls") { # Choices sheet ###################################### choices <- tryCatch({ - as.data.frame(read_excel(form_tmp, sheet = "choices"), + as.data.frame(readxl::read_excel(form_tmp, sheet = "choices"), stringsAsFactors = FALSE) #read survey sheet from the form }, error = function(err) { data.frame( #if it doesn't exist, we need to create empty dataframe with those fields @@ -446,7 +446,7 @@ kobo_prepare_form <- function(form = "form.xls") { settings <- tryCatch({ - as.data.frame(read_excel(form_tmp, sheet = "settings"), + as.data.frame(readxl::read_excel(form_tmp, sheet = "settings"), stringsAsFactors = FALSE) }, error = function(err) { data.frame( @@ -494,7 +494,7 @@ kobo_prepare_form <- function(form = "form.xls") { cat("############################################ \n\n") analysisSettings <- tryCatch({ - as.data.frame(read_excel(form_tmp, sheet = "analysisSettings"), + as.data.frame(readxl::read_excel(form_tmp, sheet = "analysisSettings"), stringsAsFactors = FALSE) }, error = function(err) { data.frame( @@ -858,7 +858,7 @@ kobo_prepare_form <- function(form = "form.xls") { indicator <- tryCatch({ - as.data.frame(read_excel(form_tmp, sheet = "indicator"),stringsAsFactors = FALSE) + as.data.frame(readxl::read_excel(form_tmp, sheet = "indicator"),stringsAsFactors = FALSE) }, error = function(err) { data.frame( type = character(), diff --git a/R/kobo_projectinit.R b/R/kobo_projectinit.R index 2a39dd5..20e1e9d 100644 --- a/R/kobo_projectinit.R +++ b/R/kobo_projectinit.R @@ -416,52 +416,52 @@ kobo_projectinit <- function() { ## Out subfolder creation #### mainDirectory <- paste0(mainDir,"/out") - subDir <- "/bar_multi" - if (file.exists(paste(mainDirectory, subDir, "/", sep = "/", collapse = "/"))) { - cat("bar_multi directory exists in out directory and is a directory.\n") - } else if (file.exists(paste(mainDirectory, subDir, sep = "/", collapse = "/"))) { - cat("bar_multi directory exists in your out directory.\n") - # you will probably want to handle this separately - } else { - cat("bar_multi directory does not exist in your out directory - creating now!\n ") - dir.create(file.path(mainDirectory, subDir)) - } - - mainDirectory <- paste0(mainDir,"/out") - subDir <- "/disagg_multi" - if (file.exists(paste(mainDirectory, subDir, "/", sep = "/", collapse = "/"))) { - cat("disagg_multi directory exists in out directory and is a directory.\n") - } else if (file.exists(paste(mainDirectory, subDir, sep = "/", collapse = "/"))) { - cat("disagg_multi directory exists in your out directory.\n") - # you will probably want to handle this separately - } else { - cat("disagg_multi directory does not exist in your out directory - creating now!\n ") - dir.create(file.path(mainDirectory, subDir)) - } - - mainDirectory <- paste0(mainDir,"/out") - subDir <- "/bar_one" - if (file.exists(paste(mainDirectory, subDir, "/", sep = "/", collapse = "/"))) { - cat("bar_one directory exists in out directory and is a directory.\n") - } else if (file.exists(paste(mainDirectory, subDir, sep = "/", collapse = "/"))) { - cat("bar_one directory exists in your out directory.\n") - # you will probably want to handle this separately - } else { - cat("bar_one directory does not exist in your out directory - creating now!\n ") - dir.create(file.path(mainDirectory, subDir)) - } - - mainDirectory <- paste0(mainDir,"/out") - subDir <- "/disagg_one" - if (file.exists(paste(mainDirectory, subDir, "/", sep = "/", collapse = "/"))) { - cat("disagg_one directory exists in out directory and is a directory.\n") - } else if (file.exists(paste(mainDirectory, subDir, sep = "/", collapse = "/"))) { - cat("disagg_one directory exists in your out directory.\n") - # you will probably want to handle this separately - } else { - cat("disagg_one directory does not exist in your out directory - creating now!\n ") - dir.create(file.path(mainDirectory, subDir)) - } + # subDir <- "/bar_multi" + # if (file.exists(paste(mainDirectory, subDir, "/", sep = "/", collapse = "/"))) { + # cat("bar_multi directory exists in out directory and is a directory.\n") + # } else if (file.exists(paste(mainDirectory, subDir, sep = "/", collapse = "/"))) { + # cat("bar_multi directory exists in your out directory.\n") + # # you will probably want to handle this separately + # } else { + # cat("bar_multi directory does not exist in your out directory - creating now!\n ") + # dir.create(file.path(mainDirectory, subDir)) + # } + # + # mainDirectory <- paste0(mainDir,"/out") + # subDir <- "/disagg_multi" + # if (file.exists(paste(mainDirectory, subDir, "/", sep = "/", collapse = "/"))) { + # cat("disagg_multi directory exists in out directory and is a directory.\n") + # } else if (file.exists(paste(mainDirectory, subDir, sep = "/", collapse = "/"))) { + # cat("disagg_multi directory exists in your out directory.\n") + # # you will probably want to handle this separately + # } else { + # cat("disagg_multi directory does not exist in your out directory - creating now!\n ") + # dir.create(file.path(mainDirectory, subDir)) + # } + # + # mainDirectory <- paste0(mainDir,"/out") + # subDir <- "/bar_one" + # if (file.exists(paste(mainDirectory, subDir, "/", sep = "/", collapse = "/"))) { + # cat("bar_one directory exists in out directory and is a directory.\n") + # } else if (file.exists(paste(mainDirectory, subDir, sep = "/", collapse = "/"))) { + # cat("bar_one directory exists in your out directory.\n") + # # you will probably want to handle this separately + # } else { + # cat("bar_one directory does not exist in your out directory - creating now!\n ") + # dir.create(file.path(mainDirectory, subDir)) + # } + # + # mainDirectory <- paste0(mainDir,"/out") + # subDir <- "/disagg_one" + # if (file.exists(paste(mainDirectory, subDir, "/", sep = "/", collapse = "/"))) { + # cat("disagg_one directory exists in out directory and is a directory.\n") + # } else if (file.exists(paste(mainDirectory, subDir, sep = "/", collapse = "/"))) { + # cat("disagg_one directory exists in your out directory.\n") + # # you will probably want to handle this separately + # } else { + # cat("disagg_one directory does not exist in your out directory - creating now!\n ") + # dir.create(file.path(mainDirectory, subDir)) + # } mainDirectory <- paste0(mainDir,"/out") diff --git a/R/kobo_question.R b/R/kobo_question.R index 7fc69e2..576799d 100644 --- a/R/kobo_question.R +++ b/R/kobo_question.R @@ -33,7 +33,7 @@ kobo_question <- function(question,mainDir='') { variablename <- as.character(select_question$fullname) - colour_palette <- brewer.pal(n=9,"PuBu")[9:3] + colour_palette <- RColorBrewer::brewer.pal(n=9,"PuBu")[9:3] # select_one, no disaggregation if(select_question$type=="select_one" && is.na(select_question$disaggregation) ){ @@ -43,7 +43,7 @@ kobo_question <- function(question,mainDir='') { check <- as.data.frame(names(data)) names(check)[1] <- "fullname" check$id <- row.names(check) - selectdf2 <- join(x=select_question, y=check, by="fullname", type="left") + selectdf2 <- plyr::join(x=select_question, y=check, by="fullname", type="left") selectdf3 <- selectdf2[!is.na(selectdf2$id), ] selectone <- as.character(selectdf3[, c("fullname")]) @@ -87,7 +87,7 @@ kobo_question <- function(question,mainDir='') { if (usedweight=="sampling_frame" ){ - frequ <- as.data.frame(svytable(as.formula(paste0("~",colnames(data[variablename]))),design)) + frequ <- as.data.frame(svytable(stats::as.formula(paste0("~",colnames(data[variablename]))),design)) frequ[,1] <- selectchoices_questions$labelchoice[match(frequ[,1], selectchoices_questions$name)] frequ[,1] <- factor(frequ[,1]) @@ -149,7 +149,7 @@ kobo_question <- function(question,mainDir='') { check <- as.data.frame(names(data)) names(check)[1] <- "fullname" check$id <- row.names(check) - selectdf2 <- join(x=select_question, y=check, by="fullname", type="left") + selectdf2 <- plyr::join(x=select_question, y=check, by="fullname", type="left") selectdf3 <- selectdf2[!is.na(selectdf2$id), ] selectone <- as.character(selectdf3[, c("fullname")]) @@ -239,7 +239,7 @@ kobo_question <- function(question,mainDir='') { data.singlefacet[,1] <- data.frame(facetchoices[,2][match(data.singlefacet[,1],facetchoices[,1])], stringsAsFactors = FALSE) if (usedweight=="sampling_frame"){ - frequ <- as.data.frame(svytable(as.formula(paste0("~",colnames(data[variablename]),"+",colnames(data[facetname]))),design)) + frequ <- as.data.frame(svytable(stats::as.formula(paste0("~",colnames(data[variablename]),"+",colnames(data[facetname]))),design)) frequ[,1] <- selectchoices_questions$labelchoice[match(frequ[,1], selectchoices_questions$name)] frequ[,1] <- factor(frequ[,1]) frequ[,2] <- factor(frequ[,2]) @@ -328,7 +328,7 @@ kobo_question <- function(question,mainDir='') { check <- as.data.frame(names(data)) names(check)[1] <- "fullname" check$id <- row.names(check) - selectdf <- join(x=selectdf, y=check, by="fullname", type="left") + selectdf <- plyr::join(x=selectdf, y=check, by="fullname", type="left") selectdf <- selectdf[!is.na(selectdf$id), ] if (nrow(select_question)==0){ @@ -344,7 +344,7 @@ kobo_question <- function(question,mainDir='') { names(listmulti)[1] <- "listname" selectdf1 <- as.data.frame(unique(select_question$listname)) names(selectdf1)[1] <- "listname" - listmulti <- join(x=listmulti, y=selectdf1, by="listname", type="left") + listmulti <- plyr::join(x=listmulti, y=selectdf1, by="listname", type="left") listmultichoice <- dico[dico$type=="select_multiple", c("listname","label","name","fullname","disaggregation","labelchoice")] @@ -359,7 +359,7 @@ kobo_question <- function(question,mainDir='') { ## Check that those variable are in the dataset selectdf <- dico[dico$type=="select_multiple" & dico$listname==listloop & dico$qlevel==listfullname , c("fullname","listname","label","name","disaggregation","labelchoice")] - selectdf2 <- join(x=selectdf, y=check, by="fullname", type="left") + selectdf2 <- plyr::join(x=selectdf, y=check, by="fullname", type="left") selectdf2 <- selectdf2[!is.na(selectdf2$id), ] listlabelchoice <- as.character(selectdf2[,"labelchoice"]) @@ -403,7 +403,7 @@ kobo_question <- function(question,mainDir='') { if (usedweight=="sampling_frame"){ data.selectmultilist$weight <- data$weight - meltdata <- melt(data.selectmultilist,id="weight") + meltdata <- reshape2::melt(data.selectmultilist,id="weight") meltdata$value <- as.numeric(meltdata$value) castdata <- as.data.frame(table(meltdata[,c("value","variable","weight")])) @@ -413,7 +413,7 @@ kobo_question <- function(question,mainDir='') { } else{ data.selectmultilist$id <- rownames(data.selectmultilist) - meltdata <- melt(data.selectmultilist,id="id") + meltdata <- reshape2::melt(data.selectmultilist,id="id") castdata <- as.data.frame(table(meltdata[,c("value","variable")])) castdata$Freq <- as.numeric(as.character(castdata$Freq)) @@ -475,7 +475,7 @@ kobo_question <- function(question,mainDir='') { check <- as.data.frame(names(data)) names(check)[1] <- "fullname" check$id <- row.names(check) - selectdf <- join(x=select_question, y=check, by="fullname", type="left") + selectdf <- plyr::join(x=select_question, y=check, by="fullname", type="left") selectdf <- selectdf[!is.na(selectdf$id), ] allvar<-dico[, c("fullname","listname","label","name","disaggregation"), ] @@ -513,7 +513,7 @@ kobo_question <- function(question,mainDir='') { listmulti <- dico[dico$type=="select_multiple_d", c("listname","label","name","fullname","disaggregation")] selectdf1 <- as.data.frame(unique(selectdf$listname)) names(selectdf1)[1] <- "listname" - listmulti <- join(x=listmulti, y=selectdf1, by="listname", type="left") + listmulti <- plyr::join(x=listmulti, y=selectdf1, by="listname", type="left") listmultichoice <- dico[dico$type=="select_multiple_d", c("listname","label","name","fullname","disaggregation","labelchoice")] @@ -526,7 +526,7 @@ kobo_question <- function(question,mainDir='') { ## Check that those variable are in the dataset selectdf <- dico[dico$type=="select_multiple" & dico$listname==listloop & dico$qlevel==variablename , c("fullname","listname","label","name","disaggregation","labelchoice")] - selectdf2 <- join(x=selectdf, y=check, by="fullname", type="left") + selectdf2 <- plyr::join(x=selectdf, y=check, by="fullname", type="left") selectdf2 <- selectdf2[!is.na(selectdf2$id), ] # If no answers to this question, passing to the next select_multiple @@ -588,7 +588,7 @@ kobo_question <- function(question,mainDir='') { if(usedweight=="sampling_frame"){ - meltdata <- melt(data.selectmultilist,id=c("weight","id","facet")) + meltdata <- reshape2::melt(data.selectmultilist,id=c("weight","id","facet")) castdata <- as.data.frame(table(meltdata[,c("value","variable","facet","weight")])) castdata$Freq <- as.numeric(as.character(castdata$Freq)) @@ -601,7 +601,7 @@ kobo_question <- function(question,mainDir='') { } else{ - meltdata <- melt(data.selectmultilist,id=c("id","facet")) + meltdata <- reshape2::melt(data.selectmultilist,id=c("id","facet")) castdata <- as.data.frame(table(meltdata[,c("value","variable","facet")])) freqperfacet <- as.data.frame(table(data.selectmultilist[is.na(data.selectmultilist[,1])==F, c("facet")])) @@ -663,7 +663,7 @@ kobo_question <- function(question,mainDir='') { check <- as.data.frame(names(data)) names(check)[1] <- "fullname" check$id <- row.names(check) - select_question <- join(x=select_question, y=check, by="fullname", type="left") + select_question <- plyr::join(x=select_question, y=check, by="fullname", type="left") select_question <- select_question[!is.na(select_question$id), ] if (nrow(select_question)==0){ diff --git a/R/kobo_registration.R b/R/kobo_registration.R index f29ee79..12cc822 100644 --- a/R/kobo_registration.R +++ b/R/kobo_registration.R @@ -67,7 +67,7 @@ odbcname <- rstudioapi::askForPassword("Give the odbc db name") user <- rstudioapi::askForPassword("Enter the username that can access the database:") passw <- rstudioapi::askForPassword("Database password") -dbhandleprogresv3 <- odbcConnect(odbcname, uid = user, pwd = passw) +dbhandleprogresv3 <- RODBC::odbcConnect(odbcname, uid = user, pwd = passw) rm(user, passw) @@ -254,13 +254,13 @@ as CountSpecificNeeds--Pivot table alias cat("Executing the summary table creation within proGres") -final <- sqlQuery(dbhandleprogresv3,paste(query)) +final <- RODBC::sqlQuery(dbhandleprogresv3,paste(query)) cat("fetching the view containing information") -progres.case <- sqlFetch(dbhandleprogresv3, "caseprofile") +progres.case <- RODBC::sqlFetch(dbhandleprogresv3, "caseprofile") ## With general needs -progres.specificneed <- sqlFetch(dbhandleprogresv3, "caseprofileneeds") +progres.specificneed <- RODBC::sqlFetch(dbhandleprogresv3, "caseprofileneeds") @@ -327,7 +327,7 @@ prop.table(table(progres.case$dem_religionCat, useNA = "ifany")) cat("Recoding case size \n") progres.case$Case.size <- as.factor(progres.case$Num_Inds) -progres.case$Case.size <- recode(progres.case$Case.size,"'1'='Case.size.1'; +progres.case$Case.size <- dplyr::recode(progres.case$Case.size,"'1'='Case.size.1'; '2'='Case.size.2'; '3'='Case.size.3'; '4'='Case.size.4'; @@ -378,7 +378,7 @@ cat("Coding dependency ratio \n") progres.case$dependency <- cut( (progres.case$Child_0_14+progres.case$Eldern_65) / progres.case$Work_15_64, c(0.0001,0.99,1.1,Inf)) progres.case$dependency <- as.character(progres.case$dependency) progres.case$dependency[is.na(progres.case$dependency)] <- "1.no.dependant" -progres.case$dependency <- as.factor(recode(progres.case$dependency,"'(0.0001,0.99]'='2.few.dependant'; +progres.case$dependency <- as.factor(dplyr::recode(progres.case$dependency,"'(0.0001,0.99]'='2.few.dependant'; '(0.99,1.1]'='3.half.dependant'; '(1.1,Inf]'='4.majority.dependant'")) @@ -391,7 +391,7 @@ cat("Coding Youth dependency ratio \n") progres.case$youthdependency <- cut(progres.case$Child_0_14 / progres.case$Work_15_64, c(0.0001,0.99,1.1,Inf)) progres.case$youthdependency <- as.character(progres.case$youthdependency) progres.case$youthdependency[is.na(progres.case$youthdependency)] <- "1.no.dependant" -progres.case$youthdependency <- as.factor(recode(progres.case$youthdependency,"'(0.0001,0.99]'='2.few.dependant'; +progres.case$youthdependency <- as.factor(dplyr::recode(progres.case$youthdependency,"'(0.0001,0.99]'='2.few.dependant'; '(0.99,1.1]'='3.half.dependant'; '(1.1,Inf]'='4.majority.dependant'")) @@ -404,7 +404,7 @@ cat("Coding Eldern dependency ratio \n") progres.case$elederndependency <- cut(progres.case$Eldern_65 / progres.case$Work_15_64, c(0.0001,0.99,1.1,Inf)) progres.case$elederndependency <- as.character(progres.case$elederndependency) progres.case$elederndependency[is.na(progres.case$elederndependency)] <- "1.no.dependant" -progres.case$elederndependency <- as.factor(recode(progres.case$elederndependency,"'(0.0001,0.99]'='2.few.dependant'; +progres.case$elederndependency <- as.factor(dplyr::recode(progres.case$elederndependency,"'(0.0001,0.99]'='2.few.dependant'; '(0.99,1.1]'='3.half.dependant'; '(1.1,Inf]'='4.majority.dependant'")) @@ -417,7 +417,7 @@ progres.case$female.ratio <- cut(progres.case$Female / progres.case$Num_Inds, c( prop.table(table(progres.case$female.ratio, useNA = "ifany")) progres.case$female.ratio <- as.character(progres.case$female.ratio) progres.case$female.ratio[is.na(progres.case$female.ratio)] <- "1.no.female" -progres.case$female.ratio <- as.factor(recode(progres.case$female.ratio,"'(0.0001,0.45]'='2.few.female'; '(0.45,0.55]'='3.half.female'; +progres.case$female.ratio <- as.factor(dplyr::recode(progres.case$female.ratio,"'(0.0001,0.45]'='2.few.female'; '(0.45,0.55]'='3.half.female'; '(0.55,0.99]'='4.most.female'; '(0.99,1.1]'='5.all.female'")) prop.table(table(progres.case$female.ratio, useNA = "ifany")) @@ -485,7 +485,7 @@ progres.case$p.child.grp4 <- as.factor(ifelse(progres.case$Child_0_14/progres.ca # Aggregating arrival year############################## -progres.case$YearArrivalCategory2 <- as.factor(recode(progres.case$YearArrival,"'1899'='1900-1980'; +progres.case$YearArrivalCategory2 <- as.factor(dplyr::recode(progres.case$YearArrival,"'1899'='1900-1980'; '1928'='1900-1980'; '1932'='1900-1980'; '1935'='1900-1980'; @@ -573,7 +573,7 @@ progres.case$YearArrivalCategory2 <- as.factor(recode(progres.case$YearArrival," ''='noData'")) -progres.case$YearArrivalCategory <- as.factor(recode(progres.case$YearArrival,"'1899'='2011.or.before.or.unkown'; +progres.case$YearArrivalCategory <- as.factor(dplyr::recode(progres.case$YearArrival,"'1899'='2011.or.before.or.unkown'; '1900'='2011.or.before.or.unkown'; '1902'='2011.or.before.or.unkown'; '1903'='2011.or.before.or.unkown'; @@ -679,7 +679,7 @@ prop.table(table(progres.case$YearArrivalCategory, useNA = "ifany")) # Aggregating country of Origin############################## -progres.case$CountryOriginCategory <- recode(progres.case$CountryOrigin,"'SYR'='SYR'; +progres.case$CountryOriginCategory <- dplyr::recode(progres.case$CountryOrigin,"'SYR'='SYR'; 'IRQ'='IRQ'; 'SOM'='HORN'; 'AFG'='AFG'; @@ -854,7 +854,7 @@ progres.case <- join(x=progres.case, y=freq2.coo, by="keycool2", type="left") # Aggregating season according to month############################## progres.case$season <- as.character(progres.case$Montharrival) prop.table(table(progres.case$Montharrival, useNA = "ifany")) -progres.case$season <- recode(progres.case$season," 'Jan'='Q1'; 'Feb'='Q1'; 'Mar'='Q1'; +progres.case$season <- dplyr::recode(progres.case$season," 'Jan'='Q1'; 'Feb'='Q1'; 'Mar'='Q1'; 'Apr'='Q2'; 'May'='Q2'; 'Jun'='Q2'; 'Jul'='Q3'; 'Aug'='Q3'; 'Sept'='Q3'; 'Oct'='Q4'; 'Nov'='Q4'; 'Dec'='Q4' ") @@ -864,7 +864,7 @@ progres.case$season <- factor(progres.case$season, levels = c("Q1", "Q2", "Q3", progres.case$season1 <- as.character(progres.case$Montharrival) #levels(progres.case$Montharrival) -progres.case$season1 <- recode(progres.case$season1,"'Mar'='Spring'; 'Apr'='Spring'; 'May'='Spring'; +progres.case$season1 <- dplyr::recode(progres.case$season1,"'Mar'='Spring'; 'Apr'='Spring'; 'May'='Spring'; 'Jun'='Summer'; 'Jul'='Summer'; 'Aug'='Summer'; 'Sep'='Autumn'; 'Oct'='Autumn'; 'Nov'='Autumn'; 'Jan'='Winter'; 'Feb'='Winter'; 'Dec'='Winter' ") @@ -872,7 +872,7 @@ progres.case$season1 <- factor(progres.case$season1, levels = c("Spring", "Summe prop.table(table(progres.case$season1, useNA = "ifany")) # Month of arrival ordinal ############################## -progres.case$Montharrival <- recode(progres.case$Montharrival,"'January'='Jan'; 'February'='Febr';'March'='Mar'; +progres.case$Montharrival <- dplyr::recode(progres.case$Montharrival,"'January'='Jan'; 'February'='Febr';'March'='Mar'; 'April'='Apr'; 'May'='May'; 'June'='Jun'; 'July'='Jul'; 'August'='Aug'; 'September'='Sept'; 'October'='Oct'; 'November'='Nov'; 'December'='Dec' ") progres.case$Montharrival <- factor(progres.case$Montharrival, levels = c("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sept","Oct","Nov","Dec")) @@ -882,7 +882,7 @@ progres.case$Montharrival <- factor(progres.case$Montharrival, levels = c("Jan", progres.case$edu_highest_t <- progres.case$edu_highest prop.table(table(progres.case$edu_highest, useNA = "ifany")) #table(progres.case$edu_highest, useNA="always") -progres.case$edu_highest_t <- recode(progres.case$edu_highest_t,"'01' = 'Grade 1'; '02' = 'Grade 2'; +progres.case$edu_highest_t <- dplyr::recode(progres.case$edu_highest_t,"'01' = 'Grade 1'; '02' = 'Grade 2'; '03' = 'Grade 3'; '04' = 'Grade 4'; '05' = 'Grade 5'; '06' = 'Grade 6'; '07' = 'Grade 7'; '08' = 'Grade 8'; '09' = 'Grade 9'; '10' = 'Grade 10'; '11' = 'Grade 11'; @@ -891,7 +891,7 @@ progres.case$edu_highest_t <- recode(progres.case$edu_highest_t,"'01' = 'Grade 1 'TC' = 'Techn Vocational'; 'UG' = 'University level'; 'PG' = 'Post university level'; 'KG' = 'Kindergarten'") -#progres.case$edu_highest_t <- recode(progres.case$edu_highest_t,"'1 year (or Grade 1)' = 'Grade 1'; '2 year (or Grade 2)' = 'Grade 2'; +#progres.case$edu_highest_t <- dplyr::recode(progres.case$edu_highest_t,"'1 year (or Grade 1)' = 'Grade 1'; '2 year (or Grade 2)' = 'Grade 2'; # '3 year (or Grade 3)' = 'Grade 3'; '04' = '4 year (or Grade 4)'; # '5 year (or Grade 5)' = 'Grade 5'; # '6 year (or Grade 6)' = 'Grade 6'; @@ -914,7 +914,7 @@ progres.case$edu_highest_t <- factor(progres.case$edu_highest_t, levels = c("Unk "Grade 11", "Grade 12", "Grade 13", "Grade 14", "Techn Vocational", "University level", "Post university level")) prop.table(table(progres.case$edu_highest_t, useNA = "ifany")) -progres.case$edu_highestcat <- recode(progres.case$edu_highest_t,"'Unknown'='Unknown'; +progres.case$edu_highestcat <- dplyr::recode(progres.case$edu_highest_t,"'Unknown'='Unknown'; 'Informal Education'='Other'; 'Techn Vocational'='Other'; 'No education'='No education'; @@ -940,7 +940,7 @@ progres.case$edu_highestcat <- as.character(progres.case$edu_highestcat) table(progres.case$edu_highestcat, useNA="always") -progres.case$edu_highestcat <- recode(progres.case$edu_highest_t,"'Unknown'='Informal.Voca.or.Unknown'; +progres.case$edu_highestcat <- dplyr::recode(progres.case$edu_highest_t,"'Unknown'='Informal.Voca.or.Unknown'; 'Informal Education'='Informal.Voca.or.Unknown'; 'Techn Vocational'='Informal.Voca.or.Unknown'; 'No education'='No education'; @@ -1033,13 +1033,13 @@ prop.table(table(progres.case$occupationcat, useNA = "ifany")) #corrtab88.08 <- read.csv("data/corrtab88-08.csv") #names(corrtab88.08) #isco <- merge(x=ISCO.08, y=corrtab88.08, by.x="ISCO08Code", by.y="ISCO.08.Code") -#write.csv(isco, "out/isco.csv") +#utils::write.csv(isco, "out/isco.csv") #names(isco) # Marital status############################## -progres.case$dem_marriagecat <- recode(progres.case$dem_marriage,"'WD'='Widowed'; +progres.case$dem_marriagecat <- dplyr::recode(progres.case$dem_marriage,"'WD'='Widowed'; 'MA'='Married'; 'CL'='Married'; 'SN'='Single-Engaged'; @@ -1066,7 +1066,7 @@ progres.case$bir_syria <- as.factor(ifelse(progres.case$dem_birth_country == "SY # Gender PA############################## -progres.case$dem_sex <- recode(progres.case$dem_sex,"'M'='Male'; 'F'='Female';'U'='Unknown'") +progres.case$dem_sex <- dplyr::recode(progres.case$dem_sex,"'M'='Male'; 'F'='Female';'U'='Unknown'") progres.case$gender.male <- ifelse(progres.case$dem_sex == "Male", 1, 0) progres.case$gender.female <- ifelse(progres.case$dem_sex == "Female", 1, 0) # Removing record when no gender.. ############################## @@ -1076,7 +1076,7 @@ progres.case <- progres.case[progres.case$dem_sex %in% c("Male","Female"), ] ### load re-encoding file for specific needs library(readxl) -SpecificNeedsCodesV2 <- read_excel("/home/edouard/R-project/proGres-analysis/data/SpecificNeedsCodesV2.xlsx", +SpecificNeedsCodesV2 <- readxl::read_excel("/home/edouard/R-project/proGres-analysis/data/SpecificNeedsCodesV2.xlsx", sheet = "Revised") @@ -1086,7 +1086,7 @@ progres.specificneed.case <- merge(x = progres.specificneed, y = SpecificNeedsCo # variable.name = "VulnerabilityText", # value.name = "value", na.rm = TRUE) -progres.specificneed.case2 <- dcast(progres.specificneed.case, CaseNo ~ newcat) +progres.specificneed.case2 <- reshape2::dcast(progres.specificneed.case, CaseNo ~ newcat) #names(progres.specificneed.case2) #str(progres.specificneed.case2) rm(progres.specificneed) @@ -1207,6 +1207,6 @@ prop.table(table(progres.case.sp$Victim.of.Violence, useNA = "ifany")) prop.table(table(progres.case.sp$Woman.at.Risk, useNA = "ifany")) -write.csv(progres.case.sp, file = "data/progrescase-1.csv", na = "", row.names = FALSE) +utils::write.csv(progres.case.sp, file = "data/progrescase-1.csv", na = "", row.names = FALSE) } diff --git a/R/kobo_samplingframe.R b/R/kobo_samplingframe.R index 63bd770..db67cf1 100644 --- a/R/kobo_samplingframe.R +++ b/R/kobo_samplingframe.R @@ -2,11 +2,14 @@ #' @rdname kobo_samplingframe #' @title Sample a dataframe #' -#' @description Do basic simple random samples based on a provided dataframe. Takes 3 types of sampling strategies: +#' @description Do basic simple random samples based on a provided dataframe. +#' +#' Takes 3 types of sampling strategies: #' - Simple random #' - Stratified 2-stages #' - Cluster sampling -#' All are based on a random selection of primary survey units (PSU) according to confidence level, margin of error, proportion and survey buffer provided. +#' All are based on a random selection of primary survey units (PSU) according to confidence level, +#' margin of error, proportion and survey buffer provided. #' #' @param data Data frame containing the population informations #' @param strata Column name of the data frame to serve as PSU (as character) @@ -24,12 +27,16 @@ #' @author Elliott Messeiller #' @examples #' \dontrun{ -#' kobo_samplingframe(data=SamplingFrame, strata="Province", pop_col="Households",confidence_level=0.95,margin_error=0.05,proportion=0.5,method="strat2st") +#' kobo_samplingframe(data=SamplingFrame, strata="Province", pop_col = "Households", +#' confidence_level = 0.95, margin_error = 0.05, proportion = 0.5, +#' method = "strat2st") #' } #' -kobo_samplingframe <- function(data, strata, pop_col, confidence_level=0.95, margin_error=0.05, proportion=0.5, method, buffer=0.05){ +kobo_samplingframe <- function(data, strata, pop_col, confidence_level = 0.95, margin_error = 0.05, + proportion = 0.5, + method, buffer = 0.05){ ## sampling frame if (method == "strat2st") { SamplingFrame <- data.frame(data) @@ -47,7 +54,10 @@ kobo_samplingframe <- function(data, strata, pop_col, confidence_level=0.95, mar strata_population <- data.frame(table(SamplingFrame_extended[,c(strata)])) strata_population$sample_target <- "" for (i in 1:nrow(strata_population)) { - strata_population[i,"sample_target"] <- as.numeric(round(strata_population[i,"Freq"]/(1 + 1/(proportion*(1-proportion))*(margin_error/qnorm(1 - (1 - confidence_level)/2))^2*(strata_population[i,"Freq"] - 1)),0)) + strata_population[i,"sample_target"] <- as.numeric( + round(strata_population[i,"Freq"]/(1 + 1/(proportion * (1 - proportion)) * + (margin_error/stats::qnorm(1 - (1 - confidence_level)/2))^2 * + (strata_population[i,"Freq"] - 1)),0)) strata_population$sample_target <- as.numeric(strata_population$sample_target) } strata_s <- as.numeric(as.vector(SamplingFrame_extended$strata)) diff --git a/R/kobo_shiny.R b/R/kobo_shiny.R index 9c88333..e41e652 100644 --- a/R/kobo_shiny.R +++ b/R/kobo_shiny.R @@ -5,7 +5,7 @@ #' @description A function to launch shiny apps #' #' -#' @param app +#' @param app script where shyni app is located #' #' @author Elliott Messeiller #' @@ -19,7 +19,7 @@ #' } #' #' -kobo_shiny <- function(app="") { +kobo_shiny <- function(app = "") { mainDir <- kobo_getMainDirectory() validApps <- list.files(system.file("shiny_app", package = "koboloadeR")) diff --git a/R/kobo_split_multiple.R b/R/kobo_split_multiple.R index f672691..118fd8f 100644 --- a/R/kobo_split_multiple.R +++ b/R/kobo_split_multiple.R @@ -74,9 +74,9 @@ kobo_split_multiple <- function(data, dico) { ## thanks to: https://stackoverflow.com/questions/44232180/list-to-dataframe tosplitlist <- strsplit(as.character(data[ , id]), " ") - tosplitlist <- setNames(tosplitlist, seq_along(tosplitlist)) + tosplitlist <- stats::setNames(tosplitlist, seq_along(tosplitlist)) tosplitlist2 <- utils::stack(tosplitlist) - tosplitframe <- dcast(tosplitlist2, ind ~ values, value.var = "ind", fun.aggregate = length) + tosplitframe <- reshape2::dcast(tosplitlist2, ind ~ values, value.var = "ind", fun.aggregate = length) if (ncol(tosplitframe) == 3 ) { cat(paste0("There was only one modality selected for this select_multiple question in the whole dataset. \n")) diff --git a/R/kobo_surveyname.R b/R/kobo_surveyname.R deleted file mode 100644 index ae62894..0000000 --- a/R/kobo_surveyname.R +++ /dev/null @@ -1,34 +0,0 @@ -#' @name kobo_surveyname -#' @rdname kobo_surveyname -#' @title Extract Survey name from XlsForm -#' -#' @description parse xlsfrom -#' -#' @param form -#' -#' @author Edouard Legoupil -#' -#' @examples -#' kobo_surveyname() -#' -#' @export kobo_surveyname -#' @examples -#' \dontrun{r -#' kobo_surveyname(form) -#' } -#' -#' - -kobo_surveyname <- function(form) { - - # read the survey tab of ODK from - form_tmp <- paste0("data/",form) - - ############################################################################################### - ### First review all questions first - settings <- read_excel(form_tmp, sheet = "settings") - form_title <- as.chartecter(settings$form_title) - - return(form_title) -} -NULL diff --git a/R/kobo_text_cloud.R b/R/kobo_text_cloud.R deleted file mode 100644 index ce10437..0000000 --- a/R/kobo_text_cloud.R +++ /dev/null @@ -1,31 +0,0 @@ -#' @name kobo_text_cloud -#' @rdname kobo_text_cloud -#' @title text Could -#' -#' @description Produce word cloud visualisation for the text questions. Can be also effective to see the results of or_other questions. -#' -#' @param form The full filename of the form to be accessed (xls or xlsx file). -#' It is assumed that the form is stored in the data folder. -#' -#' -#' @return A "data.table" with the full data dictionnary. To be used in the rest of the analysis. -#' -#' @author Edouard Legoupil -#' -#' @examples -#' kobo_text_cloud() -#' -#' @export kobo_text_cloud -#' @examples -#' \dontrun{ -#' kobo_text_cloud("myform.xls") -#' } -#' -#' @export kobo_text_cloud -#' - -kobo_text_cloud <- function(data, dico) { - - -} -NULL diff --git a/R/kobo_to_xlsform.R b/R/kobo_to_xlsform.R index 28d1fc3..d67d58b 100644 --- a/R/kobo_to_xlsform.R +++ b/R/kobo_to_xlsform.R @@ -8,7 +8,7 @@ #' #' Note that this function only works with \code{data.frames}. The function #' will throw an error for any other object types. -#' +#' @param df dataset to use #' @param form The full filename of the form to be accessed (xls or xlsx file). #' It is assumed that the form is stored in the data folder. #' @param n number of levels for a factor to be considered as a text @@ -22,13 +22,13 @@ #' kobo_to_xlsform(iris) #' #' @export kobo_to_xlsform -#' -#' -#' +#' +#' +#' kobo_to_xlsform <- function(df,form = "form.xls", n=100) { - + stopifnot(is.data.frame(df)) # df <- data.df ## str(df) @@ -45,12 +45,12 @@ kobo_to_xlsform <- function(df,form = "form.xls", sensitive = rep(as.character(NA), ncol(df)), anonymise = rep(as.character(NA), ncol(df)), stringsAsFactors = FALSE) - + ## Fill survey type - for(i in seq_along(df)) { + for (i in seq_along(df)) { #i <-12 #cat(i) - if(is.factor(df[,i])) { + if (is.factor(df[,i])) { survey[i,]$type <- paste0('select_one ', as.character(names(df[i])), '_choices') } else { survey[i,]$type <- class(df[,i])[1] @@ -62,23 +62,23 @@ kobo_to_xlsform <- function(df,form = "form.xls", label = as.character(NA), order = as.integer(NA), stringsAsFactors = FALSE) - + ## Loop around variables to build choices based on factor levels - for(i in seq_along(df)) { + for (i in seq_along(df)) { #i <-2 - if(is.factor(df[,i])) { - + if (is.factor(df[,i])) { + cat(paste0("Factor: ",i,"\n")) frame <- as.data.frame((levels(df[,i]))) - if (nrow(frame)!=0 & nrow(frame)<100 ){ - for(j in 1:nrow(frame)) { + if (nrow(frame)!= 0 & nrow(frame) < 100 ) { + for (j in 1:nrow(frame)) { # j <- 1 choices1 <- data.frame(list_name = as.character(NA), name = as.character(NA), label = as.character(NA), order = as.integer(NA), stringsAsFactors = FALSE) - + cat(paste0("Inserting level: ",j,"\n")) choices1[j,]$list_name <- paste0( as.character(names(df[i])), '_choices') choices1[j,]$name <- as.character(frame[j, ]) @@ -92,21 +92,21 @@ kobo_to_xlsform <- function(df,form = "form.xls", } else {cat("This is not a factor \n")} } - wb <- createWorkbook(type = "xls") + wb <- xlsx::createWorkbook(type = "xls") sheetname <- "survey" - surveySheet <- createSheet(wb, sheetname) - addDataFrame(survey, surveySheet, col.names=TRUE, row.names=FALSE) - + surveySheet <- xlsx::createSheet(wb, sheetname) + xlsx::addDataFrame(survey, surveySheet, col.names = TRUE, row.names = FALSE) + sheetname <- "choices" - choicesSheet <- createSheet(wb, sheetName=sheetname) - addDataFrame(choices, choicesSheet, col.names=TRUE, row.names=FALSE) - - + choicesSheet <- xlsx::createSheet(wb, sheetName = sheetname) + xlsx::addDataFrame(choices, choicesSheet, col.names = TRUE, row.names = FALSE) + + mainDir <- kobo_getMainDirectory() form_tmp <- paste(mainDir, "data", form, sep = "/", collapse = "/") - + if (file.exists(form_tmp)) file.remove(form_tmp) - saveWorkbook(wb, form_tmp) + xlsx::saveWorkbook(wb, form_tmp) cat("XLS form has been successfully generated") } -NULL \ No newline at end of file +NULL diff --git a/R/kobo_trend.R b/R/kobo_trend.R deleted file mode 100644 index a802f91..0000000 --- a/R/kobo_trend.R +++ /dev/null @@ -1,99 +0,0 @@ -#' @name kobo_trend -#' @rdname kobo_trend -#' @title Generate histogramm plots based on dates -#' -#' @description Automatically generate histogramm for all nominal & ordinal variables based on dates. ggplot2 is used. -#' -#' -#' @param data kobodatset to use -#' @param date field of date type used to generare trends -#' @param duration number of days in the past -#' @param dico ( generated from kobo_dico) -#' -#' @author Edouard Legoupil -#' -#' @examples -#' kobo_bar_trend() -#' -#' @export kobo_trend -#' -#' @examples -#' \dontrun{ -#' kobo_trend(data, date, dico) -#' } -#' -#' - -kobo_trend <- function(data, date, dico) { - - mainDir <- "out" - subDir <- "trend" - if (file.exists(paste(mainDir, subDir, "/", sep = "/", collapse = "/"))) { - cat("trend directory exists in out directory and is a directory.\n") - } else if (file.exists(paste(mainDir, subDir, sep = "/", collapse = "/"))) { - cat("trend directory exists in your out directory.\n") - # you will probably want to handle this separately - } else { - cat("trend directory does not exist in your out directory - creating now!\n ") - dir.create(file.path(mainDir, subDir)) - } - - - selectallt <- as.data.frame(dico[dico$type %in% c("select_one"), c("fullname","listname","label","name")]) - ### Verify that those variable are actually in the original dataframe - check <- as.data.frame(names(data)) - names(check)[1] <- "fullname" - check$id <- row.names(check) - selectallt <- join(x=selectallt, y=check, by="fullname", type="left") - selectallt <- selectallt[!is.na(selectallt$id), ] - - selectall <- as.character(selectallt[, c("fullname")]) - data.date <- as.data.frame(data [, date ]) - names(data.date)[1] <- "date" - - #str(data.date$date) - if(!inherits(data.date$date, 'Date')) { - cat("conversion to date format\n") - data.date$date <- as.Date(as.character(data.date$date), format = "%d-%m-%Y %H:%M:%S") - } else { cat("Already date format\n") } - - #data.date$month <- format(data.date$date,"%B-%Y") - #str(data.date$month) - - data.selectall <- cbind(data.date,data [ , selectall ]) - data.selectall <- kobo_label(data.selectall, dico) - - ## histogramme to display event occurence over time - startting faceting - for (i in 1:nrow(selectallt) ) { - #i<- 1 - #rm(variablename) - variablename <- names(data.selectall)[i+1] - title <- attributes(data.selectall)$variable.labels[i+1] - - data.trend2 <- as.data.frame(prop.table(table(format(data.selectall$date,"%B-%Y"), data.selectall[ , i+1]), 1)) - data.trend2 <- data.trend2[data.trend2$Freq>0, ] - data.trend2$date <- as.Date(as.character(paste('01-', data.trend2$Var1, sep = '')), format = "%d-%B-%Y") - data.trend2$Var1 <- factor(data.trend2$Var1, levels=data.trend2[order(data.trend2$date), c("Var1")]) - #levels(data.trend2$Var1) - - - ggplot(data.trend2, aes(x=Var1, y=Freq, group=as.factor(data.trend2$Var2), fill=as.factor(data.trend2$Var2))) + - #geom_line( aes(color=as.factor(data.trend2$Var2), size=2 ))+ - #geom_smooth(aes(color=as.factor(data.trend2$Var2), size=2 )) + - geom_bar( stat = "identity",position = "dodge") + - # fill="#2a87c8",colour="#2a87c8", - xlab("") + ylab("")+ - scale_y_continuous(labels=percent)+ - ggtitle(title)+ - theme(plot.title=element_text(face="bold", size=9), - plot.background = element_rect(fill = "transparent",colour = NA), - legend.title = element_blank(), - legend.position="bottom") - ggsave(filename=paste("out/trend/trend_",variablename,".png",sep=""), width=10, height=8,units="in", dpi=300) - cat(paste0("Generated Trend graph for question: ", title , "\n")) - - } - - -} -NULL diff --git a/R/kobo_trend_report.R b/R/kobo_trend_report.R deleted file mode 100644 index 747dee2..0000000 --- a/R/kobo_trend_report.R +++ /dev/null @@ -1,32 +0,0 @@ -#' @name kobo_trend_report -#' @rdname kobo_trend_report -#' @title Generate trend report -#' -#' @description Generate report with data aggregated by location & time -#' -#' -#' -#' -#' @param kobo or odk dataset to use -#' @param dico Generated from kobo_dico function -#' -#' @author Edouard Legoupil -#' -#' @examples -#' kobo_trend_report(frame, dico) -#' -#' @export kobo_trend_report -#' -#' @examples -#' \dontrun{ -#' kobo_trend_report(frame, dico) -#' } -#' - -kobo_trend_report <- function(frame, dico) { - - -} -NULL - - diff --git a/R/kobo_weight.R b/R/kobo_weight.R index f6253df..b4382f0 100644 --- a/R/kobo_weight.R +++ b/R/kobo_weight.R @@ -24,7 +24,7 @@ kobo_weight <- function(mainDir = '') { source(paste0(mainDir, "/code/0-config.R"), local = TRUE) - sampling <- read_excel(path.to.form, sheet = "sampling_frame") + sampling <- readxl::read_excel(path.to.form, sheet = "sampling_frame") data$weight <- "" @@ -108,13 +108,13 @@ kobo_weight <- function(mainDir = '') { data$weight <- as.numeric(data$weight) - surveydesign <- svydesign( + surveydesign <- survey::svydesign( ids = ~ 1, strata = data[[fullname_strata]], weights = ~ weight, data = data ) - pastedesign <- paste0("svydesign(ids=~1, + pastedesign <- paste0("survey::svydesign(ids=~1, strata= data[[strata1]], weights= ~weight, data=data)") diff --git a/R/shortcuts.R b/R/shortcuts.R index e82e794..bb237c5 100644 --- a/R/shortcuts.R +++ b/R/shortcuts.R @@ -1,31 +1,14 @@ -#' @import httr -NULL - -#' @import data.table -NULL - -#' @import bit64 -NULL - -#' @import readr -NULL - -#' @import RCurl -NULL - -#' @import DT -NULL - -#' @import plyr -NULL - -#' @import dplyr -NULL - -#' @import tidyr -NULL - -#' @import readxl -NULL - -f_csv <- function(x) setDT(read_csv(content(x, "raw")))[] +#' @import httr +NULL + + +#' @import RCurl +NULL + +#' @import plyr +NULL + +#' @import readxl +NULL + +f_csv <- function(x) setDT(read_csv(content(x, "raw")))[] diff --git a/R/utils.R b/R/utils.R index 36c4fc6..ab6669b 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,116 +1,94 @@ -#' @name get_me -#' @rdname get_me -#' @title Authentify in Kobo Server -#' -#' @description Helper Function for GET, Depending on Whether Authentication is Required -#' -#' Adds basic level authentication if provided. -#' -#' @param user string of length 1 or 2 with user details -#' @param URL The URL to be passed to curl -#' @note This function is not intended to be called directly. -#' It is used in other functions. -#' @author Ananda Mahto -#' -get_me <- function(user, URL) { - if (is.null(user)) { - GET(URL, progress()) - } else { - u <- pwd_parse(user) - GET(URL, authenticate(u$username, u$password), progress()) - } -} -NULL - -#' @name pwd_parse -#' @rdname pwd_parse -#' @title Parse Kobo Password -#' -#' @description Helper Function to Parse a String to be Used as a Username/Password Combination -#' -#' Converts a string of length 1 or of length 2 into a list that can then be -#' passed on to the \code{authenticate} function from the "httr" package. -#' -#' @param \dots A single string, character vetor, or list containing the -#' username and password that should be used. If it is a single string, it -#' should be in the form of "username:password". -#' @note This function is not intended to be called directly. -#' It is used in other functions. -#' -#' @examples -#' \dontrun{ -#' pwd_parse("username", "password") -#' pwd_parse("username:password") -#' pwd_parse(c("username", "password")) -#' } -#' @author Ananda Mahto -#' -pwd_parse <- function(...) { - upw <- unlist(list(...)) - nam <- c("username", "password") - auth <- { - if (length(upw) == 1) { - unlist(strsplit(upw, ":", TRUE)) - } else { - if (length(upw) > 2) { - message("More than two values supplied. Using only first two values.") - upw[1:2] - } else { - upw - } - } - } - setNames(as.list(auth), nam) -} -NULL - -#' @name kobo_time_parser_UTC -#' @rdname kobo_time_parser_UTC -#' @title Parses Dates from KoBo Into a More Usable Format -#' -#' @description The date/time values in KoBo usually get stored in a format -#' like the following: "2015-08-27T13:28:29.000+06:30". These functions -#' process these date/times into more usable formats. -#' -#' @param instring A date/time format coming from KoBo. -#' @param timezone A valid timezone, available in the list available -#' from \code{\link[base:OlsonNames]{OlsonNames}}. -#' @return The \code{kobo_time_parser_UTC} function returns a POSIXct object, -#' while the \code{kobo_time_parser} function returns a formatted character -#' string that can be easily parsed as a date/time object. -#' @author Ananda Mahto -#' @examples -#' TIME <- "2015-08-27T13:28:29.000+06:30" -#' kobo_time_parser_UTC(TIME) -#' -#' @export kobo_time_parser_UTC -#' @aliases kobo_time_parser_UTC -kobo_time_parser_UTC <- function(instring) { - tmp <- gsub("\\.\\d{3}|:", "", instring) - tmp <- chartr(" ", "0", format(tmp, justify = "left", width = 22)) - as.POSIXct(strptime(tmp, format = "%Y-%m-%dT%H%M%S%z", tz = "UTC")) -} -NULL - -#' @name kobo_time_parser -#' @rdname kobo_time_parser -#' @title Parses Dates from KoBo Into a More Usable Format -#' -#' @description The date/time values in KoBo usually get stored in a format -#' like the following: "2015-08-27T13:28:29.000+06:30". These functions -#' process these date/times into more usable formats. -#' -#' @return The \code{kobo_time_parser} function returns a formatted character -#' string that can be easily parsed as a date/time object. -#' @author Ananda Mahto -#' @examples -#' kobo_time_parser(TIME) -#' kobo_time_parser(TIME, timezone = "Asia/Rangoon") -#' kobo_time_parser(TIME, timezone = "America/Los_Angeles") -#' -#' @aliases kobo_time_parser -#' @export kobo_time_parser -kobo_time_parser <- function(instring, timezone = Sys.timezone()) { - format(kobo_time_parser_UTC(instring), tz = timezone, usetz = TRUE) -} -NULL +#' @name get_me +#' @rdname get_me +#' @title Authentify in Kobo Server +#' +#' @description Helper Function for GET, Depending on Whether Authentication is Required +#' +#' Adds basic level authentication if provided. +#' +#' @param user string of length 1 or 2 with user details +#' @param URL The URL to be passed to curl +#' @note This function is not intended to be called directly. +#' It is used in other functions. +#' @author Ananda Mahto +#' +get_me <- function(user, URL) { + if (is.null(user)) { + get(URL, progress()) + } else { + u <- pwd_parse(user) + get(URL, httr::authenticate(u$username, u$password), progress()) + } +} +NULL + +#' @name pwd_parse +#' @rdname pwd_parse +#' @title Parse Kobo Password +#' +#' @description Helper Function to Parse a String to be Used as a Username/Password Combination +#' +#' Converts a string of length 1 or of length 2 into a list that can then be +#' passed on to the \code{authenticate} function from the "httr" package. +#' +#' @param \dots A single string, character vetor, or list containing the +#' username and password that should be used. If it is a single string, it +#' should be in the form of "username:password". +#' @note This function is not intended to be called directly. +#' It is used in other functions. +#' +#' @examples +#' \dontrun{ +#' pwd_parse("username", "password") +#' pwd_parse("username:password") +#' pwd_parse(c("username", "password")) +#' } +#' @author Ananda Mahto +#' +pwd_parse <- function(...) { + upw <- unlist(list(...)) + nam <- c("username", "password") + auth <- { + if (length(upw) == 1) { + unlist(strsplit(upw, ":", TRUE)) + } else { + if (length(upw) > 2) { + message("More than two values supplied. Using only first two values.") + upw[1:2] + } else { + upw + } + } + } + setNames(as.list(auth), nam) +} +NULL + +#' @name kobo_time_parser_UTC +#' @rdname kobo_time_parser_UTC +#' @title Parses Dates from KoBo Into a More Usable Format +#' +#' @description The date/time values in KoBo usually get stored in a format +#' like the following: "2015-08-27T13:28:29.000+06:30". These functions +#' process these date/times into more usable formats. +#' +#' @param instring A date/time format coming from KoBo. +#' +#' @return The \code{kobo_time_parser_UTC} function returns a POSIXct object, +#' while the \code{kobo_time_parser} function returns a formatted character +#' string that can be easily parsed as a date/time object. +#' +#' @author Ananda Mahto +#' @examples +#' TIME <- "2015-08-27T13:28:29.000+06:30" +#' kobo_time_parser_UTC(TIME) +#' +#' @export kobo_time_parser_UTC +#' @aliases kobo_time_parser_UTC +kobo_time_parser_UTC <- function(instring) { + tmp <- gsub("\\.\\d{3}|:", "", instring) + tmp <- chartr(" ", "0", format(tmp, justify = "left", width = 22)) + as.POSIXct(strptime(tmp, format = "%Y-%m-%dT%H%M%S%z", tz = "UTC")) +} +NULL + diff --git a/R/utils2.R b/R/utils2.R index ddfeb84..752f345 100644 --- a/R/utils2.R +++ b/R/utils2.R @@ -1,97 +1,98 @@ -#' @name psum -#' @rdname psum -#' @title Sum with NA -#' @description Helper function that will sum values even if we have NA -#' -#' @param \dots List of integer or numeric -#' -#' @return Integer or numeric. -#' -#' @author Someone -#' -#' @examples -#' psum() -#' -#' @export psum -#' -psum <- function(..., na.rm=FALSE) { - x <- list(...) - rowSums(matrix(unlist(x), ncol=length(x)), na.rm=na.rm) -} - - - -#' @name round2 -#' @rdname round2 -#' @title Create roundup function -#' -#' -#' @param List of integer or numeric to be rounded -#' @param Rounding level -#' -#' @return rounded figure. -#' -#' @author Someone -#' -#' @examples -#' round2(x, n) -#' -#' @export round2 -#' -round2 = function(x, n) { - posneg = sign(x) - z = abs(x)*10^n - z = z + 0.5 - z = trunc(z) - z = z/10^n - z*posneg -} - -#' @name ltbl -#' @rdname ltbl -#' @title Helper function to extract the last part of question headings -#' -#' @param x = database name -#' @param y = column index group -#' @param z = column index -#' -#' @return last part of question headings -#' -#' @author Someone -#' -#' @examples -#' ltbl(x,y,z) -#' -#' @export ltbl -#' -ltbl <-function(x,y,z){ gsub("\"","",tail(strsplit(names(x)[y][z],split="/")[[1]],1))} - - -#' @name multresponse -#' @rdname multresponse -#' @title Helper function to concatenate multiple choices (select_mutiple type question) formatted TRUE / FALSE -#' -#' -#' @param x String -#' @return last part of question headings -#' -#' @author Someone -#' -#' @examples -#' multresponse(x) -#' -#' @export multresponse -#' -multresponse <-function (x){ - y<-which(x=="TRUE") - if(length(y)!=0){ - for (tu in 1:length(y)){ - if(tu==1){ - value<-ltbl(x,y[tu],1) - } else { - value<-c(value,ltbl(x,y[tu],1)) - } - } - }else{value<-NA} - paste(value,collapse=" / ") -} +#' @name psum +#' @rdname psum +#' @title Sum with NA +#' @description Helper function that will sum values even if we have NA +#' +#' @param \dots List of integer or numeric +#' @param na.rm Bolean indicating if NA shall be removed +#' +#' @return Integer or numeric. +#' +#' @author Someone +#' +#' @examples +#' psum() +#' +#' @export psum +#' +psum <- function(..., na.rm = FALSE) { + x <- list(...) + rowSums(matrix(unlist(x), ncol = length(x)), na.rm = na.rm) +} + + + +#' @name round2 +#' @rdname round2 +#' @title Create roundup function +#' +#' +#' @param x List of integer or numeric to be rounded +#' @param n Rounding level +#' +#' @return rounded figure. +#' +#' @author Someone +#' +#' @examples +#' round2(x, n) +#' +#' @export round2 +#' +round2 = function(x, n) { + posneg = sign(x) + z = abs(x)*10^n + z = z + 0.5 + z = trunc(z) + z = z/10^n + z*posneg +} + +#' @name ltbl +#' @rdname ltbl +#' @title Helper function to extract the last part of question headings +#' +#' @param x = database name +#' @param y = column index group +#' @param z = column index +#' +#' @return last part of question headings +#' +#' @author Someone +#' +#' @examples +#' ltbl(x,y,z) +#' +#' @export ltbl +#' +ltbl <-function(x,y,z){ gsub("\"","",tail(strsplit(names(x)[y][z],split="/")[[1]],1))} + + +#' @name multresponse +#' @rdname multresponse +#' @title Helper function to concatenate multiple choices (select_mutiple type question) formatted TRUE / FALSE +#' +#' +#' @param x String +#' @return last part of question headings +#' +#' @author Someone +#' +#' @examples +#' multresponse(x) +#' +#' @export multresponse +#' +multresponse <-function (x){ + y<-which(x=="TRUE") + if(length(y)!=0){ + for (tu in 1:length(y)){ + if(tu==1){ + value<-ltbl(x,y[tu],1) + } else { + value<-c(value,ltbl(x,y[tu],1)) + } + } + }else{value<-NA} + paste(value,collapse=" / ") +} diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 0000000..96ff29c --- /dev/null +++ b/R/zzz.R @@ -0,0 +1,31 @@ +.onLoad <- function(libname = find.package("koboloadeR"), pkgname = "koboloadeR") { + + + # CRAN Note avoidance + if (getRversion() >= "2.15.1") + utils::globalVariables( + # used to remove note when doing devtools::check(document = FALSE, args = c('--as-cran')) + c("..density..", "CellStyle", "Var1", "addDataFrame", "aes", "alpha", "analysis_plan", + "as.charater", "as.formula", "brewer.pal", "chisq.test", "complete.cases", + "coord_equal", "coord_flip", "createSheet", "createWorkbook", "data", "design", "dico", + "element_blank", "element_line", "element_rect", "element_text", "exportDDI", "facet", + "form", "formula", "freqper", "fullname", "geom_bar", "geom_density", "geom_histogram", + "geom_text", "getSheets", "get_map", "ggmap", "ggplot", "ggsave", "ggtitle", "guide_legend", + "household", "installed.packages", "is.labelled", "kable", "labs", "lat", "loadWorkbook", + "long", "margin", "na.omit", "odbcConnect", "packageDescription", "path.to.data", + "path.to.form", "percent", "position_dodge", "qnorm", "randomSentences", "read.csv", + "removeSheet", "render", "reorder.factor", "rtruncnorm", "saveWorkbook", + "scale_fill_brewer", "scale_fill_gradient", "scale_fill_manual", + "scale_x_continuous", "scale_y_continuous", "setInternet2", "setNames", "sheet", + "spsample", "sqlFetch", "sqlQuery", "stat_summary_hex", "str", "str_length", "str_locate", + "str_replace", "str_replace_all", "str_wrap", "stri_rand_strings", "svydesign", + "svytable", "tail", "theme", "theme.porttheme", "theme_gray", "theme_map", + "theme_minimal", "theme_set", "trim", "type", "unit", "usedsampling", "usedweight", + "variable", "write.csv", "xlab", "ylab", "content", "progress", "setDT", "%>%" + ) + ) + + +} + + diff --git a/README.md b/README.md index 5ddd253..0b604ee 100644 --- a/README.md +++ b/README.md @@ -185,5 +185,10 @@ To go in more details, the suggested workflow is presented below (note that all +CRAN Notes +========== + +Test results +------------ diff --git a/_pkgdown.yml b/_pkgdown.yml index 6336921..4a59693 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -42,6 +42,7 @@ reference: - kobo_load_data - title: Reports Generation contents: + - kobo_question - kobo_crunching_report - kobo_cluster_report - kobo_anonymisation_report @@ -83,25 +84,6 @@ reference: - kobo_submission_count - kobo_surveyname - pwd_parse - - title: Utilities for batch Chart & Graph Generation - contents: - - kobo_bar_multi - - kobo_bar_multi_facet - - kobo_bar_multi_print - - kobo_bar_one - - kobo_bar_one_facet - - kobo_bar_one_facet_print - - kobo_bar_one_print - - kobo_boxplot_facet - - kobo_correlation - - kobo_corrplot - - kobo_histo - - kobo_histo_print - - kobo_map_cat - - kobo_map_int - - kobo_question - - kobo_text_cloud - - kobo_trend - title: Shiny Apps contents: - kobo_apps diff --git a/docs/articles/Anonymisation.html b/docs/articles/Anonymisation.html index 749dd53..046dd5d 100644 --- a/docs/articles/Anonymisation.html +++ b/docs/articles/Anonymisation.html @@ -107,7 +107,7 @@

Data Anonymisation and disclosure risk measurement

Edouard Legoupil

-

2019-07-03

+

2019-07-15

Source: vignettes/Anonymisation.Rmd diff --git a/docs/articles/Cleaning.html b/docs/articles/Cleaning.html index f9ed930..d84ba35 100644 --- a/docs/articles/Cleaning.html +++ b/docs/articles/Cleaning.html @@ -107,7 +107,7 @@

Data Cleaning

Edouard Legoupil

-

2019-07-03

+

2019-07-15

Source: vignettes/Cleaning.Rmd diff --git a/docs/articles/Console.html b/docs/articles/Console.html index c213932..b70dfbe 100644 --- a/docs/articles/Console.html +++ b/docs/articles/Console.html @@ -107,7 +107,7 @@

Using console script

Edouard Legoupil

-

2019-07-03

+

2019-07-15

Source: vignettes/Console.Rmd diff --git a/docs/articles/Crunching.html b/docs/articles/Crunching.html index 939a831..d26a945 100644 --- a/docs/articles/Crunching.html +++ b/docs/articles/Crunching.html @@ -107,7 +107,7 @@

Data Crunching

Edouard Legoupil

-

2019-07-03

+

2019-07-15

Source: vignettes/Crunching.Rmd diff --git a/docs/articles/Dissiminating.html b/docs/articles/Dissiminating.html index fd9a98c..02c8007 100644 --- a/docs/articles/Dissiminating.html +++ b/docs/articles/Dissiminating.html @@ -107,7 +107,7 @@

Dissiminating

Edouard Legoupil

-

2019-07-03

+

2019-07-15

Source: vignettes/Dissiminating.Rmd diff --git a/docs/articles/Getting_data.html b/docs/articles/Getting_data.html index 28ee324..2963571 100644 --- a/docs/articles/Getting_data.html +++ b/docs/articles/Getting_data.html @@ -107,7 +107,7 @@

Getting data from server

Edouard Legoupil

-

2019-07-03

+

2019-07-15

Source: vignettes/Getting_data.Rmd diff --git a/docs/articles/Predicting_Scoring.html b/docs/articles/Predicting_Scoring.html index cf7393c..6660dbb 100644 --- a/docs/articles/Predicting_Scoring.html +++ b/docs/articles/Predicting_Scoring.html @@ -107,7 +107,7 @@

Predicting and Scoring

Edouard Legoupil

-

2019-07-03

+

2019-07-15

Source: vignettes/Predicting_Scoring.Rmd diff --git a/docs/articles/Sampling.html b/docs/articles/Sampling.html index fdbc899..c7077ed 100644 --- a/docs/articles/Sampling.html +++ b/docs/articles/Sampling.html @@ -107,7 +107,7 @@

Sampling

Edouard Legoupil

-

2019-07-03

+

2019-07-15

Source: vignettes/Sampling.Rmd diff --git a/docs/articles/Troubleshooting.html b/docs/articles/Troubleshooting.html index dcf0b19..5618828 100644 --- a/docs/articles/Troubleshooting.html +++ b/docs/articles/Troubleshooting.html @@ -107,7 +107,7 @@

Common Troubleshooting

Edouard Legoupil

-

2019-07-03

+

2019-07-15

Source: vignettes/Troubleshooting.Rmd diff --git a/docs/articles/xlsform.html b/docs/articles/xlsform.html index ea8ad26..9316bcd 100644 --- a/docs/articles/xlsform.html +++ b/docs/articles/xlsform.html @@ -108,7 +108,7 @@

Data Analysis Plan within your xlsfrom

Edouard Legoupil

-

2019-07-03

+

2019-07-15

Source: vignettes/xlsform.Rmd diff --git a/docs/index.html b/docs/index.html index a30491c..149e6f4 100644 --- a/docs/index.html +++ b/docs/index.html @@ -231,6 +231,14 @@

Contributions to the packages are welcome. Please read first the contribution guidelines, follow the code of conduct and use the issue template.

To go in more details, the suggested workflow is presented below (note that all of it is not yet fully implented - see issue tracking for more details). You can read the function documentations directly.

alt text

+ +
+

+CRAN Notes

+
+

+Test results

+
diff --git a/docs/reference/code/run-analysis.R b/docs/reference/code/run-analysis.R index 67a231e..3e8ae8e 100644 --- a/docs/reference/code/run-analysis.R +++ b/docs/reference/code/run-analysis.R @@ -8,28 +8,18 @@ library(koboloadeR) ## Configure name of the xlsform that exist under data folder # - Change if required but better to keep the defautl one form <- "form.xls" + ## Extend xlsform with necessary column kobo_prepare_form(form) ### Eventually Generate dummy data (uncomment below if required) - # kobo_dummy(form) +# kobo_dummy(form) ###################################################################################### ### At this stage you can start working on your xlsform and fill it accordingly!!! ### ###################################################################################### -## Rename xlsform and Dataframes -## Please make sure in the settings sheet that you mentioned the main data frame and all sub dataframes -## The name field must be filled with the same name of begin-repeat name. -## The name of the Main Data Frame must be always "MainDataFrame", just to indicate that is the main one -## ex: -# name | label | value | path -# 1 MainDataFrame | NA | mainDataFrame.csv | current-working-directory/data/mainDataFrame.csv -# 2 br1 | NA | begin-repeat1.csv | current-working-directory/data/begin-repeat1.csv -kobo_rename_xlsform_dataframes(form) - - #### Phase 2: Analysis Plan ############################### kobo_check_analysis_plan(form) @@ -45,8 +35,8 @@ kobo_load_data(form) kobo_crunching_report(form) ## Generate Cluster Report --> Discover -household <- read.csv(paste(mainDir, "data", "/MainDataFrame.csv", sep = "/", collapse = "/"), stringsAsFactors = F) ## This dataset will be generated by kobo_load_data -kobo_cluster_report(frame = household, form) +MainDataFrame <- read.csv(paste(mainDir, "data", "/MainDataFrame.csv", sep = "/", collapse = "/"), stringsAsFactors = F) ## This dataset will be generated by kobo_load_data +kobo_cluster_report(frame = MainDataFrame, form) ## Generate Prediction Report --> Predict @@ -55,6 +45,6 @@ kobo_cluster_report(frame = household, form) #### Phase 5: Statistical Disclosure control & Indicator sharing ############################### ## Generate Anonymisation Report -household <- read.csv(paste(mainDir, "data", "/MainDataFrame.csv", sep = "/", collapse = "/"), stringsAsFactors = F) ## This dataset will be generated by kobo_load_data -kobo_anonymisation_report(frame = household, form) +MainDataFrame <- read.csv(paste(mainDir, "data", "/MainDataFrame.csv", sep = "/", collapse = "/"), stringsAsFactors = F) ## This dataset will be generated by kobo_load_data +kobo_anonymisation_report(frame = MainDataFrame, form) diff --git a/docs/reference/code/shiny_app/app_main_koboloadeR.R b/docs/reference/code/shiny_app/app_main_koboloadeR.R index d3806ec..025230c 100644 --- a/docs/reference/code/shiny_app/app_main_koboloadeR.R +++ b/docs/reference/code/shiny_app/app_main_koboloadeR.R @@ -91,7 +91,7 @@ server <- shinyServer(function(input, output, session) { projectConfigurationInfo$log[["isAnalysisPlanCompleted"]] <- FALSE projectConfigurationInfo$log[["isDataProcessingCompleted"]] <- FALSE if(file.exists(paste(mainDir(), "data", "/form.xls", sep = "/", collapse = "/")) ){ - projectConfigurationInfo$log[["xlsForm"]] <- TRUE + #projectConfigurationInfo$log[["xlsForm"]] <- TRUE result <- kobo_get_begin_repeat() projectConfigurationInfo$data[["beginRepeatList"]] = c("MainDataFrame",result$names) projectConfigurationInfo$log[["beginRepeatList"]] = TRUE @@ -154,8 +154,741 @@ server <- shinyServer(function(input, output, session) { }) ####################################### Project Configuration page ############################################ - output$projectConfiguration <- renderUI({ + s <- "" + cpg <- kobo_check_project_configuration() + if(cpg$flag){ + return( + fluidRow( + box(id="doYouWantUseExProjectBox", + width=12,status="primary", solidHeader = FALSE, collapsible = FALSE, + column(width = projectConfigurationTheme$questionsWidth, style = "margin-bottom: 10px; border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Do you want to use the existing project?") + ), + column(width = projectConfigurationTheme$yesNoInputWidth, offset = 0, + selectInput("doYouWantUseExProjectSelectInput", label = NULL,choices = c("-- select --","Yes","No")) + ) + ), + conditionalPanel( + condition = "input.doYouWantUseExProjectSelectInput == 'Yes'", + infoBox( + width = 12,strong("Done!"),h4("You can start the Analysis Plan Configuration...", align = "center") + ,icon = icon("check-circle"), + color = "green" + ) + ), + conditionalPanel( + condition = "input.doYouWantUseExProjectSelectInput == 'No'", + box(id="doYouHaveFormBox", + width=12,status="primary", solidHeader = FALSE, collapsible = FALSE, + column(width = projectConfigurationTheme$questionsWidth, style = "margin-bottom: 10px; border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Do you have the xlsform?") + ), + column(width = projectConfigurationTheme$yesNoInputWidth, offset = 0, + selectInput("doYouHaveFormSelectInput", label = NULL,choices = c("-- select --","Yes","No")) + ), + column(width = projectConfigurationTheme$warningBlockWidth, offset = 0, + if(file.exists(paste(mainDir(), "data", "/form.xls", sep = "/", collapse = "/"))){ + div(class = "warningBlock", + span(class = "warningTitle","WARNING!"), + span(class = "warningBody","Be careful, there is already xlsform file (form.xls) in the data directory, once you upload the new file, it will be overridden.") + ) + } + + ), + column(width = 9, + conditionalPanel( + condition = "input.doYouHaveFormSelectInput == 'Yes'", + fileInput('xlsFormUploadedFile', 'Choose your xls form', + accept=c('.xls')) + ) + ), + column(width = 3, + conditionalPanel( + condition = "input.doYouHaveFormSelectInput == 'Yes'", + actionButton("uploadxlsButton", "Upload xlsform", icon("upload"), + style="width:100%; margin-top: 25px;", class = "uploadButton" ) + ) + ) + ) + ), + conditionalPanel( + condition = "input.doYouHaveFormSelectInput == 'Yes' & input.doYouWantUseExProjectSelectInput == 'No'", + uiOutput("dataDDISamplingUI") + ) + ) + ) + + }else{ + return( + fluidRow( + box(id="doYouHaveFormBox", + width=12,status="primary", solidHeader = FALSE, collapsible = FALSE, + column(width = projectConfigurationTheme$questionsWidth, style = "margin-bottom: 10px; border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Do you have the xlsform?") + ), + column(width = projectConfigurationTheme$yesNoInputWidth, offset = 0, + selectInput("doYouHaveFormSelectInput", label = NULL,choices = c("-- select --","Yes","No")) + ), + column(width = projectConfigurationTheme$warningBlockWidth, offset = 0, + if(file.exists(paste(mainDir(), "data", "/form.xls", sep = "/", collapse = "/"))){ + div(class = "warningBlock", + span(class = "warningTitle","WARNING!"), + span(class = "warningBody","Be careful, there is already xlsform file (form.xls) in the data directory, once you upload the new file, it will be overridden.") + ) + } + + ), + column(width = 9, + conditionalPanel( + condition = "input.doYouHaveFormSelectInput == 'Yes'", + fileInput('xlsFormUploadedFile', 'Choose your xls form', + accept=c('.xls')) + ) + ), + column(width = 3, + conditionalPanel( + condition = "input.doYouHaveFormSelectInput == 'Yes'", + actionButton("uploadxlsButton", "Upload xlsform", icon("upload"), + style="width:100%; margin-top: 25px;", class = "uploadButton" ) + ) + ) + ), + conditionalPanel( + condition = "input.doYouHaveFormSelectInput == 'Yes'", + uiOutput("dataDDISamplingUI") + ) + + ) + ) + } + + }) + + + output$dataDDISamplingUI <- renderText({ + if(projectConfigurationInfo$log[["xlsForm"]]){ + return( + paste0("", + box(id="doYouHaveDatasetsBox", title = "File(s) related to project (Mandatory)", status = "danger", + width=12, solidHeader = TRUE, collapsible = TRUE, + column(width = projectConfigurationTheme$questionsWidth, style = "margin-bottom: 10px; border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Do you have the Data file(s)?") + ), + column(width = projectConfigurationTheme$yesNoInputWidth, offset = 0, + selectInput("doYouHaveDatasetsSelectInput", label = NULL,choices = c("-- select --","Yes","No")) + ), + + column(width = 12, + conditionalPanel( + condition = "input.doYouHaveDatasetsSelectInput == 'Yes'", + column(width = 12, + uiOutput("dataInputsUI") + ), + column(width = 3, + actionButton("saveDataFilesButton", "Upload and Save files", icon("upload"), class = "uploadButton", style="margin: 15px 0px; height:45px; width:100%;") + ) + + ) + ), + conditionalPanel( + condition = "input.doYouHaveDatasetsSelectInput == 'No'", + column(width = projectConfigurationTheme$questionsWidth, style = "margin-bottom: 10px; border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Do you want to generate Data?") + ), + column(width = projectConfigurationTheme$yesNoInputWidth, offset = 0, + selectInput("doYouWantGenerateDataSelectInput", label = NULL,choices = c("-- select --","Yes","No")) + ) + ) + + ), + box(id="recordSettingsBox", title = "Record Settings Configuration (Optional)", status = "primary", + width=12, solidHeader = TRUE, collapsible = TRUE, collapsed = TRUE, + column(width = 12, align="left", + uiOutput("recordSettingsUI") + ) + ), + box(id="ddiBox", title = "DDI informations (Optional)", status = "primary", + width=12, solidHeader = TRUE, collapsible = TRUE, collapsed = TRUE, + column(width = 12, align="left", + uiOutput("ddiUI") + ) + ) + ) + ) + } + }) + + output$dataInputsUI <- renderText({ + s <- "" + for(i in 1:(length(projectConfigurationInfo$data[["beginRepeatList"]]))){ + s <- paste(s , box(class = "uploadFilesBox",title = projectConfigurationInfo$data[["beginRepeatList"]][i], status = "danger", + fluidRow( + column(10, offset = 1, + fileInput(inputId=paste("fileInput",projectConfigurationInfo$data[["beginRepeatList"]][i],sep = ""), NULL, + accept=c('text/csv', + 'text/comma-separated-values,text/plain', + '.csv')) + ), + column(width = 10, offset = 1, style = "border-top: 1px solid lightgray; margin-top: 10px; padding-top: 15px", + radioButtons(inputId=paste("separator",projectConfigurationInfo$data[["beginRepeatList"]][i],sep = ""), 'Separator', + c(Comma=',', + Semicolon=';', + Tab='\t'), + ',', inline =TRUE) + ) + ) + ,collapsible = FALSE ,width = 3),sep="" ) + } + + return(s) + }) + + output$recordSettingsUI <- renderUI({ + fluidRow( + column(12, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px; margin-bottom: 20px; background-color: ghostwhite; padding-top: 20px;", + column(width = projectConfigurationTheme$questionsWidth, style = "margin-bottom: 10px; border-bottom: 1px dotted lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("What sampling do you have?") + ), + column(width = projectConfigurationTheme$yesNoInputWidth, offset = 0, + selectInput("samplingSelectInput", label = NULL,choices = c("-- select --", + "No sampling (type 1)", + "Cluster sample (type 2)", + "Stratified sample (type 3)" + )) + + ), + conditionalPanel( + condition = "input.samplingSelectInput == 'Cluster sample (type 2)'", + column(width = 12, style="margin: 15px 0px 15px; border-top: 1px solid lightgray; padding: 20px 10px 0px;", + column(width = 4, + selectizeInput("variableNameCluster", label = "Select the name of cluster variable",choices = projectConfigurationInfo$data[["xlsFormFields"]] + ,options = list(placeholder = '-- select --', onInitialize = I('function() { this.setValue(""); }')) + ) + ), + column(width = 8, + column(width = 9, style = "padding-left: 0px;", + fileInput('weightsClusterFileInput', 'Choose weights file for Cluster sample', + accept=c('text/csv', + 'text/comma-separated-values,text/plain', + '.csv'))), + column(width = 3, style = "border-left: 1px solid lightgray; margin-top: 10px;", + radioButtons('weightsClusterSep', 'Separator', + c(Comma=',', + Semicolon=';', + Tab='\t'), + ',', inline =TRUE)), + column(width = 3, offset = 9, + if(file.exists(paste(mainDir(), "data", "/weightsCluster.csv", sep = "/", collapse = "/"))){ + div(class = "warningBlock", + span(class = "warningTitle","WARNING!"), + span(class = "warningBody","Be careful, there is already weightsCluster.csv file in the data directory, once you upload the new file, it will be overridden.") + ) + } + + ) + ) + ) + + ), + conditionalPanel( + condition = "input.samplingSelectInput == 'Stratified sample (type 3)'", + column(width = 12, style="margin: 15px 0px 15px; border-top: 1px solid lightgray; padding: 20px 10px 0px;", + column(width = 4, + selectizeInput("variableNameStratified", label = "Select the name of stratified variable",choices = projectConfigurationInfo$data[["xlsFormFields"]] + ,options = list(placeholder = '-- select --', onInitialize = I('function() { this.setValue(""); }')) + ) + ), + column(width = 8, + column(width = 9, style = "padding-left: 0px;", + fileInput('weightsStratifiedFileInput', 'Choose weights file for Stratified sample', + accept=c('text/csv', + 'text/comma-separated-values,text/plain', + '.csv'))), + column(width = 3, style = "border-left: 1px solid lightgray; margin-top: 10px;", + radioButtons('weightsStratifiedSep', 'Separator', + c(Comma=',', + Semicolon=';', + Tab='\t'), + ',', inline =TRUE)), + column(width = 3, offset = 9, + if(file.exists(paste(mainDir(), "data", "/weightsStratified.csv", sep = "/", collapse = "/"))){ + div(class = "warningBlock", + span(class = "warningTitle","WARNING!"), + span(class = "warningBody","Be careful, there is already weightsStratified.csv file in the data directory, once you upload the new file, it will be overridden.") + ) + } + + ) + ) + ) + + ) + ), + + column(12, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px; margin-bottom: 20px;", + column(width = projectConfigurationTheme$questionsWidth, style = "margin-bottom: 10px; border-bottom: 1px dotted lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Do you have data cleaning log?") + ), + column(width = projectConfigurationTheme$yesNoInputWidth, offset = 0, + selectInput("cleaningLogSelectInput", label = NULL,choices = c("-- select --","Yes","No")) + ), + column(width = projectConfigurationTheme$warningBlockWidth, offset = 0, + if(file.exists(paste(mainDir(), "data", "/cleaningLog.csv", sep = "/", collapse = "/"))){ + div(class = "warningBlock", + span(class = "warningTitle","WARNING!"), + span(class = "warningBody","Be careful, there is already cleaningLog.csv file in the data directory, once you upload the new file, it will be overridden.") + ) + } + + ), + conditionalPanel( + condition = "input.cleaningLogSelectInput == 'Yes'", + column(width = 12, style="margin: 15px 0px 15px; border-top: 1px solid lightgray; padding: 20px 10px 0px;", + column(width = 9, style = "padding-left: 0px;", + fileInput('cleaningLogFileInput', 'Choose cleaning Log file', + accept=c('text/csv', + 'text/comma-separated-values,text/plain', + '.csv'))), + column(width = 3, style = "border-left: 1px solid lightgray; margin-top: 10px;", + radioButtons('cleaningLogSep', 'Separator', + c(Comma=',', + Semicolon=';', + Tab='\t'), + ',', inline =TRUE)) + ) + ) + + ), + column(3, style = "margin-bottom: 20px; padding-top: 0px;", + actionButton("saveRecordSettingsConfigurationButton", "Save Settings", icon("save"), class = "uploadButton", style="margin: 15px 0px; height:45px; width:100%;") + ) + + ) + }) + + output$ddiUI <- renderUI({ + fluidRow( + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Title of the study:") + ), + column(width = 6, offset = 0, + textInput("titlDDIInput", label = NULL, width = "100%", placeholder = "Free Text", value = "Refugee Survey in Country x") + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Abstract:") + ), + column(width = 6, offset = 0, + textInput("abstractDDIInput", label = NULL, width = "100%", placeholder = "Free Text", value="Blablablablablabla") + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Rights & Disclaimer:") + ), + column(width = 6, offset = 0, + textInput("disclaimerDDIInput", label = NULL, width = "100%", placeholder = "Free Text - adjust if necessary", value="UNHCR does not warrant in any way the accuracy of the information and data contained in the datasets and shall not be held liable for any loss caused by reliance on the accuracy or reliability thereof.") + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Country where the study took place:") + ), + column(width = 6, offset = 0, + selectizeInput("countryDDIInput", label = NULL, + choices = c("Afghanistan" = "AFG", "Albania" = "ALB", "Algeria" = "DZA", "American Samoa" = "ASM", "Andorra" = "AND", "Angola" = "AGO", "Anguilla" = "AIA", "Antarctica" = "ATA", "Antigua and Barbuda" = "ATG", "Argentina" = "ARG", "Armenia" = "ARM", "Aruba" = "ABW", "Australia" = "AUS", "Austria" = "AUT", "Azerbaijan" = "AZE", "Bahamas (the)" = "BHS", "Bahrain" = "BHR", "Bangladesh" = "BGD", "Barbados" = "BRB", "Belarus" = "BLR", "Belgium" = "BEL", "Belize" = "BLZ", "Benin" = "BEN", "Bermuda" = "BMU", "Bhutan" = "BTN", "Bolivia (Plurinational State of)" = "BOL", "Bonaire, Sint Eustatius and Saba" = "BES", "Bosnia and Herzegovina" = "BIH", "Botswana" = "BWA", "Bouvet Island" = "BVT", "Brazil" = "BRA", "British Indian Ocean Territory (the)" = "IOT", "Brunei Darussalam" = "BRN", "Bulgaria" = "BGR", "Burkina Faso" = "BFA", "Burundi" = "BDI", "Cabo Verde" = "CPV", "Cambodia" = "KHM", "Cameroon" = "CMR", "Canada" = "CAN", "Cayman Islands (the)" = "CYM", "Central African Republic (the)" = "CAF", "Chad" = "TCD", "Chile" = "CHL", "China" = "CHN", "Christmas Island" = "CXR", "Cocos (Keeling) Islands (the)" = "CCK", "Colombia" = "COL", "Comoros (the)" = "COM", "Congo (the Democratic Republic of the)" = "COD", "Congo (the)" = "COG", "Cook Islands (the)" = "COK", "Costa Rica" = "CRI", "Croatia" = "HRV", "Cuba" = "CUB", "Curaçao" = "CUW", "Cyprus" = "CYP", "Czechia" = "CZE", "Côte d'Ivoire" = "CIV", "Denmark" = "DNK", "Djibouti" = "DJI", "Dominica" = "DMA", "Dominican Republic (the)" = "DOM", "Ecuador" = "ECU", "Egypt" = "EGY", "El Salvador" = "SLV", "Equatorial Guinea" = "GNQ", "Eritrea" = "ERI", "Estonia" = "EST", "Eswatini" = "SWZ", "Ethiopia" = "ETH", "Falkland Islands (the) [Malvinas]" = "FLK", "Faroe Islands (the)" = "FRO", "Fiji" = "FJI", "Finland" = "FIN", "France" = "FRA", "French Guiana" = "GUF", "French Polynesia" = "PYF", "French Southern Territories (the)" = "ATF", "Gabon" = "GAB", "Gambia (the)" = "GMB", "Georgia" = "GEO", "Germany" = "DEU", "Ghana" = "GHA", "Gibraltar" = "GIB", "Greece" = "GRC", "Greenland" = "GRL", "Grenada" = "GRD", "Guadeloupe" = "GLP", "Guam" = "GUM", "Guatemala" = "GTM", "Guernsey" = "GGY", "Guinea" = "GIN", "Guinea-Bissau" = "GNB", "Guyana" = "GUY", "Haiti" = "HTI", "Heard Island and McDonald Islands" = "HMD", "Holy See (the)" = "VAT", "Honduras" = "HND", "Hong Kong" = "HKG", "Hungary" = "HUN", "Iceland" = "ISL", "India" = "IND", "Indonesia" = "IDN", "Iran (Islamic Republic of)" = "IRN", "Iraq" = "IRQ", "Ireland" = "IRL", "Isle of Man" = "IMN", "Israel" = "ISR", "Italy" = "ITA", "Jamaica" = "JAM", "Japan" = "JPN", "Jersey" = "JEY", "Jordan" = "JOR", "Kazakhstan" = "KAZ", "Kenya" = "KEN", "Kiribati" = "KIR", "Korea (the Democratic People's Republic of)" = "PRK", "Korea (the Republic of)" = "KOR", "Kuwait" = "KWT", "Kyrgyzstan" = "KGZ", "Lao People's Democratic Republic (the)" = "LAO", "Latvia" = "LVA", "Lebanon" = "LBN", "Lesotho" = "LSO", "Liberia" = "LBR", "Libya" = "LBY", "Liechtenstein" = "LIE", "Lithuania" = "LTU", "Luxembourg" = "LUX", "Macao" = "MAC", "Macedonia (the former Yugoslav Republic of)" = "MKD", "Madagascar" = "MDG", "Malawi" = "MWI", "Malaysia" = "MYS", "Maldives" = "MDV", "Mali" = "MLI", "Malta" = "MLT", "Marshall Islands (the)" = "MHL", "Martinique" = "MTQ", "Mauritania" = "MRT", "Mauritius" = "MUS", "Mayotte" = "MYT", "Mexico" = "MEX", "Micronesia (Federated States of)" = "FSM", "Moldova (the Republic of)" = "MDA", "Monaco" = "MCO", "Mongolia" = "MNG", "Montenegro" = "MNE", "Montserrat" = "MSR", "Morocco" = "MAR", "Mozambique" = "MOZ", "Myanmar" = "MMR", "Namibia" = "NAM", "Nauru" = "NRU", "Nepal" = "NPL", "Netherlands (the)" = "NLD", "New Caledonia" = "NCL", "New Zealand" = "NZL", "Nicaragua" = "NIC", "Niger (the)" = "NER", "Nigeria" = "NGA", "Niue" = "NIU", "Norfolk Island" = "NFK", "Northern Mariana Islands (the)" = "MNP", "Norway" = "NOR", "Oman" = "OMN", "Pakistan" = "PAK", "Palau" = "PLW", "Palestine, State of" = "PSE", "Panama" = "PAN", "Papua New Guinea" = "PNG", "Paraguay" = "PRY", "Peru" = "PER", "Philippines (the)" = "PHL", "Pitcairn" = "PCN", "Poland" = "POL", "Portugal" = "PRT", "Puerto Rico" = "PRI", "Qatar" = "QAT", "Romania" = "ROU", "Russian Federation (the)" = "RUS", "Rwanda" = "RWA", "Réunion" = "REU", "Saint Barthélemy" = "BLM", "Saint Helena, Ascension and Tristan da Cunha" = "SHN", "Saint Kitts and Nevis" = "KNA", "Saint Lucia" = "LCA", "Saint Martin (French part)" = "MAF", "Saint Pierre and Miquelon" = "SPM", "Saint Vincent and the Grenadines" = "VCT", "Samoa" = "WSM", "San Marino" = "SMR", "Sao Tome and Principe" = "STP", "Saudi Arabia" = "SAU", "Senegal" = "SEN", "Serbia" = "SRB", "Seychelles" = "SYC", "Sierra Leone" = "SLE", "Singapore" = "SGP", "Sint Maarten (Dutch part)" = "SXM", "Slovakia" = "SVK", "Slovenia" = "SVN", "Solomon Islands" = "SLB", "Somalia" = "SOM", "South Africa" = "ZAF", "South Georgia and the South Sandwich Islands" = "SGS", "South Sudan" = "SSD", "Spain" = "ESP", "Sri Lanka" = "LKA", "Sudan (the)" = "SDN", "Suriname" = "SUR", "Svalbard and Jan Mayen" = "SJM", "Sweden" = "SWE", "Switzerland" = "CHE", "Syrian Arab Republic" = "SYR", "Taiwan (Province of China)" = "TWN", "Tajikistan" = "TJK", "Tanzania, United Republic of" = "TZA", "Thailand" = "THA", "Timor-Leste" = "TLS", "Togo" = "TGO", "Tokelau" = "TKL", "Tonga" = "TON", "Trinidad and Tobago" = "TTO", "Tunisia" = "TUN", "Turkey" = "TUR", "Turkmenistan" = "TKM", "Turks and Caicos Islands (the)" = "TCA", "Tuvalu" = "TUV", "Uganda" = "UGA", "Ukraine" = "UKR", "United Arab Emirates (the)" = "ARE", "United Kingdom of Great Britain and Northern Ireland (the)" = "GBR", "United States Minor Outlying Islands (the)" = "UMI", "United States of America (the)" = "USA", "Uruguay" = "URY", "Uzbekistan" = "UZB", "Vanuatu" = "VUT", "Venezuela (Bolivarian Republic of)" = "VEN", "Viet Nam" = "VNM", "Virgin Islands (British)" = "VGB", "Virgin Islands (U.S.)" = "VIR", "Wallis and Futuna" = "WLF", "Western Sahara" = "ESH", "Yemen" = "YEM", "Zambia" = "ZMB", "Zimbabwe" = "ZWE", "Åland Islands" = "ALA" )) + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Geographic Coverage for the study within the country:") + ), + column(width = 6, offset = 0, + textInput("geogCoverDDIInput", label = NULL, width = "100%", placeholder = "Free Text", value="Blablablablablabla") + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Kind of Data: Sample survey data [ssd] or Census/enumeration data [cen]") + ), + column(width = 6, offset = 0, + selectInput("analysisUnitDDIInput", label = NULL,choices = c("ssd", "cen")) + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Describes the entity being analyzed in the study or in the variable:") + ), + column(width = 6, offset = 0, + selectInput("analysisUnitDDIInput", label = NULL,choices = c("HousingUnit", "GeographicUnit"))) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("The procedure, technique, or mode of inquiry used to attain the data:") + ), + column(width = 6, offset = 0, + selectInput("modeOfCollectionDDIInput", label = NULL,choices = c("Interview.FaceToFace.CAP", "Interview.Telephone.CATI", "SelfAdministeredQuestionnaire.FixedForm.WebBased", "FocusGroup.FaceToFace", "Observation")) + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Description of the study Universe: The group of persons or other elements that are the object of research and to which any analytic results refer:") + ), + column(width = 6, offset = 0, + textInput("universeDDIInput", label = NULL, width = "100%", placeholder = "Free Text", value="Refugee Survey in Country x") + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Do you have a file describing the universe that can be joined to the survey (for instance registration data)?") + ), + column(width = 6, offset = 0, + selectInput("universeyesDDIInput", label = NULL,choices = c("No","Yes")) + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Name of the csv file with universe data:") + ), + column(width = 6, offset = 0, + textInput("universefileDDIInput", label = NULL, width = "100%", placeholder = "Free Text", value="universe.csv") + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Name of the variable within universe to do the join with the survey:") + ), + column(width = 6, offset = 0, + textInput("universeidDDIInput", label = NULL, width = "100%", placeholder = "Free Text", value="progres.id") + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Name of the variable within survey to do the join with the universe:") + ), + column(width = 6, offset = 0, + textInput("universesurveyidDDIInput", label = NULL, width = "100%", placeholder = "Free Text", value="progres.id") + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Description of the Sampling Procedure in the context of the study:") + ), + column(width = 6, offset = 0, + textInput("sampProcDDIInput", label = NULL, width = "100%", placeholder = "Free Text", value="Blablablablablabla") + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Description of the generation of the final weight - for instance usage of post-stratification and other calibration:") + ), + column(width = 6, offset = 0, + textInput("weightDDIInput", label = NULL, width = "100%", placeholder = "Free Text", value="Blablablablablabla") + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Data Editing and Cleaning Operation: Description of the cleaning procedure:") + ), + column(width = 6, offset = 0, + textInput("cleanOpsDDIInput", label = NULL, width = "100%", placeholder = "Free Text", value="Blablablablablabla") + ) + ), + column(3, style = "margin-bottom: 20px; padding-top: 0px;", + actionButton("saveDDIButton", "Save DDI information", icon("save"), class = "uploadButton", style="margin: 15px 0px; height:45px; width:100%;") + ) + + ) + }) + + observeEvent(input$saveDDIButton,{ + tryCatch({ + progress <- shiny::Progress$new() + progress$set(message = "Saving DDI's info in progress...", value = 0) + on.exit(progress$close()) + updateProgress <- function(value = NULL, detail = NULL) { + if (is.null(value)) { + value <- progress$getValue() + value <- value + (progress$getMax() - value) / 5 + } + progress$set(value = value, detail = detail) + } + updateProgress() + if(sum(trimws(input$titlDDIInput) == "")){ + print("titlDDIInputEmpty") + shinyalert("Title is required", + "'Title' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + if(sum(trimws(input$abstractDDIInput) == "")){ + print("abstractDDIInputEmpty") + shinyalert("Abstract is required", + "'Abstract' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + updateProgress() + if(sum(trimws(input$disclaimerDDIInput) == "")){ + print("disclaimerDDIInputEmpty") + shinyalert("Rights & Disclaimer is required", + "'Rights & Disclaimer' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + if(sum(trimws(input$countryDDIInput) == "")){ + print("countryDDIInputEmpty") + shinyalert("Country is required", + "'Country' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + updateProgress() + if(sum(trimws(input$geogCoverDDIInput) == "")){ + print("geogCoverDDIInputEmpty") + shinyalert("Geographic Coverage is required", + "'Geographic Coverage' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + updateProgress() + if(sum(trimws(input$dataKindDDIInput) == "")){ + print("dataKindDDIInputEmpty") + shinyalert("Kind of Data is required", + "'Kind of Data' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + updateProgress() + if(sum(trimws(input$analysisUnitDDIInput) == "")){ + print("analysisUnitDDIInputEmpty") + shinyalert("analysisUnit is required", + "'Describes the entity being analyzed in the study or in the variable' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + if(sum(trimws(input$modeOfCollectionDDIInput) == "")){ + print("modeOfCollectionDDIInputEmpty") + shinyalert("modeOfCollection is required", + "'The procedure, technique, or mode of inquiry used to attain the data' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + updateProgress() + if(sum(trimws(input$universeDDIInput) == "")){ + print("universeDDIInputEmpty") + shinyalert("universe is required", + "'Description of the study Universe' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + updateProgress() + if(sum(trimws(input$universeyesDDIInput) == "")){ + print("universeyesDDIInputEmpty") + shinyalert("universeyes is required", + "'Do you have a file describing the universe that can be joined to the survey (for instance registration data)' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + + if(sum(trimws(input$universefileDDIInput) == "" & sum(trimws(input$universeyesDDIInput) == "Yes"))){ + print("universefileDDIInputEmpty") + shinyalert("universefile is required", + "'Name of the csv file with universe data' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + updateProgress() + if(sum(trimws(input$universeidDDIInput) == "")){ + print("universeidDDIInputEmpty") + shinyalert("universeid is required", + "'Name of the variable within universe to do the join with the survey' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + + if(sum(trimws(input$universesurveyidDDIInput) == "")){ + print("universesurveyidDDIInputEmpty") + shinyalert("universesurveyid is required", + "'Name of the variable within survey to do the join with the universe' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + + if(sum(trimws(input$sampProcDDIInput) == "")){ + print("sampProcDDIInputEmpty") + shinyalert("sampProc is required", + "'Description of the Sampling Procedure in the context of the study' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + + if(sum(trimws(input$weightDDIInput) == "")){ + print("weightDDIInputEmpty") + shinyalert("weight is required", + "'Description of the generation of the final weight - for instance usage of post-stratification and other calibration' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + updateProgress() + if(sum(trimws(input$cleanOpsDDIInput) == "")){ + print("cleanOpsDDIInputEmpty") + shinyalert("cleanOps is required", + "'Data Editing and Cleaning Operation' is empty! please fill it with a proper text", + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + updateProgress() + configInfo <- kobo_get_config() + configInfo[configInfo$name=="titl", "value"] = trimws(input$titlDDIInput) + configInfo[configInfo$name=="abstract", "value"] = trimws(input$abstractDDIInput) + configInfo[configInfo$name=="disclaimer", "value"] = trimws(input$disclaimerDDIInput) + configInfo[configInfo$name=="Country", "value"] = trimws(input$countryDDIInput) + configInfo[configInfo$name=="geogCover", "value"] = trimws(input$geogCoverDDIInput) + configInfo[configInfo$name=="dataKind", "value"] = trimws(input$dataKindDDIInput) + configInfo[configInfo$name=="AnalysisUnit", "value"] = trimws(input$analysisUnitDDIInput) + configInfo[configInfo$name=="ModeOfCollection", "value"] = trimws(input$modeOfCollectionDDIInput) + configInfo[configInfo$name=="universe", "value"] = trimws(input$universeDDIInput) + configInfo[configInfo$name=="universeyes", "value"] = trimws(input$universeyesDDIInput) + configInfo[configInfo$name=="universefile", "value"] = trimws(input$universefileDDIInput) + configInfo[configInfo$name=="universeid", "value"] = trimws(input$universeidDDIInput) + configInfo[configInfo$name=="universesurveyid", "value"] = trimws(input$universesurveyidDDIInput) + configInfo[configInfo$name=="sampProc", "value"] = trimws(input$sampProcDDIInput) + configInfo[configInfo$name=="weight", "value"] = trimws(input$weightDDIInput) + configInfo[configInfo$name=="cleanOps", "value"] = trimws(input$cleanOpsDDIInput) + updateProgress() + result <- kobo_edit_form(analysisSettings = configInfo ) + + if(class(result) == "try-error"){ + shinyalert("Error", + result, + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + + }, error = function(err) { + print("jkfhg8fsdjksdjioerf") + shinyalert("Error", + err$message, + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + }) + }) + + + + + + + output$projectConfiguration2 <- renderUI({ fluidRow( box(id="doYouHaveFormBox", width=12,status="primary", solidHeader = FALSE, collapsible = FALSE, @@ -248,20 +981,20 @@ server <- shinyServer(function(input, output, session) { conditionalPanel( condition = "input.doYouHaveFormSelectInput == 'Yes'", div(id="doYouHaveDatasetsDiv", - box(id="doYouHaveDatasetsBox", title = "File(s) related to project", + box(id="doYouHaveDatasetsBox", title = "File(s) related to project", status = "danger" , width=12,status="primary", solidHeader = FALSE, collapsible = TRUE, column(width = projectConfigurationTheme$questionsWidth, style = "margin-bottom: 10px; border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", h4("Do you have the Data file(s)?") ), column(width = projectConfigurationTheme$yesNoInputWidth, offset = 0, - selectInput("doYouHaveDatasetsSelectInput", label = NULL,choices = c("-- select --","Yes","No")) + selectInput("doYouHaveDatasetsSelectInput2", label = NULL,choices = c("-- select --","Yes","No")) ), column(width = 12, conditionalPanel( condition = "input.doYouHaveDatasetsSelectInput == 'Yes'", column(width = 12, - uiOutput("dataInputsUI") + uiOutput("dataInputsUI9") ), column(width = 12, actionButton("saveDataFilesButton", "Upload and Save files", icon("upload"), class = "uploadButton", style="margin: 15px 0px; width:100%;") @@ -403,10 +1136,23 @@ server <- shinyServer(function(input, output, session) { observeEvent(input$uploadxlsButton, { tryCatch({ + progress <- shiny::Progress$new() + progress$set(message = "Uploading xlsform in progress...", value = 0) + on.exit(progress$close()) + updateProgress <- function(value = NULL, detail = NULL) { + if (is.null(value)) { + value <- progress$getValue() + value <- value + (progress$getMax() - value) / 5 + } + progress$set(value = value, detail = detail) + } + updateProgress() + inFile <- input$xlsFormUploadedFile if (!is.null(inFile)){ wb <- xlsx::loadWorkbook(inFile$datapath) xlsx::saveWorkbook(wb, paste(mainDir(), "data", "/form.xls", sep = "/", collapse = "/")) + updateProgress() projectConfigurationInfo$log[["xlsForm"]] <- TRUE result <- kobo_get_begin_repeat() projectConfigurationInfo$data[["beginRepeatList"]] = c("MainDataFrame",result$names) @@ -423,7 +1169,21 @@ server <- shinyServer(function(input, output, session) { animation = FALSE, showConfirmButton = TRUE ) - projectConfigurationInfo$log[["isPrepared"]] <- FALSE + updateProgress() + result <- kobo_prepare_form() + if(class(result) == "try-error"){ + shinyalert("Error", + result, + type = "error", + closeOnClickOutside = FALSE, + confirmButtonCol = "#ff4d4d", + animation = FALSE, + showConfirmButton = TRUE + ) + return(FALSE) + } + updateProgress() + projectConfigurationInfo$log[["isPrepared"]] <- TRUE projectConfigurationInfo$log[["isRecordSettingsCompleted"]] <- FALSE projectConfigurationInfo$log[["isAnalysisPlanCompleted"]] <- FALSE projectConfigurationInfo$log[["isDataProcessingCompleted"]] <- FALSE @@ -1027,230 +1787,9 @@ server <- shinyServer(function(input, output, session) { }) }) - output$dataInputsUI <- renderText({ - if(!projectConfigurationInfo$log[["beginRepeatList"]]){ - s <-"" - s <- paste( - infoBox( - width = 12,strong("Information"),h4("You have to upload xlsform before uploading data files", align = "center"), icon = icon("exclamation-triangle"), - color = "orange" - ) - , s ,sep="" ) - return(s) - }else{ - s <- "" - for(i in 1:(length(projectConfigurationInfo$data[["beginRepeatList"]]))){ - s <- paste(s , box(class = "uploadFilesBox",title = projectConfigurationInfo$data[["beginRepeatList"]][i], status = "primary", - fluidRow( - column(10, offset = 1, - fileInput(inputId=paste("fileInput",projectConfigurationInfo$data[["beginRepeatList"]][i],sep = ""), NULL, - accept=c('text/csv', - 'text/comma-separated-values,text/plain', - '.csv')) - ), - column(width = 10, offset = 1, style = "border-top: 1px solid lightgray; margin-top: 10px; padding-top: 15px", - radioButtons(inputId=paste("separator",projectConfigurationInfo$data[["beginRepeatList"]][i],sep = ""), 'Separator', - c(Comma=',', - Semicolon=';', - Tab='\t'), - ',', inline =TRUE) - ) - ) - ,collapsible = FALSE ,width = 3),sep="" ) - } - - return(s) - } - }) - - output$recordSettingsUI <- renderText({ - s <-"" - if( - sum(input$doYouHaveFormSelectInput == "No") && - sum(input$doYouWantGenerateFormSelectInput == "Yes") && - sum(input$doYouHaveDataSelectInput == "Yes") && - projectConfigurationInfo$log[["data"]] == FALSE - ){ - s <- paste(infoBox( - width = 12,strong("Information"),h4("You need to upload the data file before starting configuration of Record Settings", align = "center"), icon = icon("exclamation-triangle"), - color = "orange" - ), s ,sep="" ) - return(s) - }else if( - (sum(input$doYouHaveFormSelectInput == "No") && - sum(input$doYouWantGenerateFormSelectInput == "Yes") && - sum(input$doYouHaveDataSelectInput == "Yes") && - ( - projectConfigurationInfo$log[["isPrepared"]] == FALSE || - projectConfigurationInfo$log[["isGenerated"]] == FALSE ) - ) - ){ - if(projectConfigurationInfo$log[["isPrepared"]] == FALSE && projectConfigurationInfo$log[["isGenerated"]] == FALSE ){ - s <- paste(infoBox( - width = 12,strong("Information"),h4("You have to run 'Generate xlsform' function and 'Prepare xlsform' function before starting configuration of Record Settings", align = "center"), icon = icon("exclamation-triangle"), - color = "orange" - ), s ,sep="" ) - }else if(projectConfigurationInfo$log[["isGenerated"]] == FALSE ){ - s <- paste(infoBox( - width = 12,strong("Information"),h4("You have to run 'Generate xlsform' function before starting configuration of Record Settings", align = "center"), icon = icon("exclamation-triangle"), - color = "orange" - ), s ,sep="" ) - }else if(projectConfigurationInfo$log[["isPrepared"]] == FALSE ){ - s <- paste(infoBox( - width = 12,strong("Information"),h4("You have to run 'Prepare xlsform' function before starting configuration of Record Settings", align = "center"), icon = icon("exclamation-triangle"), - color = "orange" - ), s ,sep="" ) - } - return(s) - }else if( - sum(input$doYouHaveFormSelectInput == "Yes") && - sum(input$doYouHaveDatasetsSelectInput == "Yes") && - sum(input$formIncludeSettingsSelectInput == "No") && - projectConfigurationInfo$log[["subAndMainfiles"]] == FALSE - ){ - s <- paste(infoBox( - width = 12,strong("Information"),h4("You have to upload all required data files before starting configuration of Record Settings", align = "center"), icon = icon("exclamation-triangle"), - color = "orange" - ), s ,sep="" ) - return(s) - }else if( - sum(input$doYouHaveFormSelectInput == "Yes") && - sum(input$doYouHaveDatasetsSelectInput == "Yes") && - sum(input$formIncludeSettingsSelectInput == "No") && - projectConfigurationInfo$log[["isPrepared"]] == FALSE - ){ - s <- paste(infoBox( - width = 12,strong("Information"),h4("You have to run 'Prepare xlsform' function before starting configuration of Record Settings", align = "center"), icon = icon("exclamation-triangle"), - color = "orange" - ), s ,sep="" ) - return(s) - } - s <- paste( - fluidRow( - - column(12, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px; margin-bottom: 20px; background-color: ghostwhite; padding-top: 20px;", - column(width = projectConfigurationTheme$questionsWidth, style = "margin-bottom: 10px; border-bottom: 1px dotted lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", - h4("What sampling do you have?") - ), - column(width = projectConfigurationTheme$yesNoInputWidth, offset = 0, - selectInput("samplingSelectInput", label = NULL,choices = c("-- select --", - "No sampling(type 1)", - "Cluster sample (type 2)", - "Stratified sample (type 3)" - )) - - ), - conditionalPanel( - condition = "input.samplingSelectInput == 'Cluster sample (type 2)'", - column(width = 12, style="margin: 15px 0px 15px; border-top: 1px solid lightgray; padding: 20px 10px 0px;", - column(width = 4, - selectizeInput("variableNameCluster", label = "Select the name of cluster variable",choices = projectConfigurationInfo$data[["xlsFormFields"]] - ,options = list(placeholder = '-- select --', onInitialize = I('function() { this.setValue(""); }')) - ) - ), - column(width = 8, - column(width = 9, style = "padding-left: 0px;", - fileInput('weightsClusterFileInput', 'Choose weights file for Cluster sample', - accept=c('text/csv', - 'text/comma-separated-values,text/plain', - '.csv'))), - column(width = 3, style = "border-left: 1px solid lightgray; margin-top: 10px;", - radioButtons('weightsClusterSep', 'Separator', - c(Comma=',', - Semicolon=';', - Tab='\t'), - ',', inline =TRUE)), - column(width = 3, offset = 9, - if(file.exists(paste(mainDir(), "data", "/weightsCluster.csv", sep = "/", collapse = "/"))){ - div(class = "warningBlock", - span(class = "warningTitle","WARNING!"), - span(class = "warningBody","Be careful, there is already weightsCluster.csv file in the data directory, once you upload the new file, it will be overridden.") - ) - } - - ) - ) - ) - - ), - conditionalPanel( - condition = "input.samplingSelectInput == 'Stratified sample (type 3)'", - column(width = 12, style="margin: 15px 0px 15px; border-top: 1px solid lightgray; padding: 20px 10px 0px;", - column(width = 4, - selectizeInput("variableNameStratified", label = "Select the name of stratified variable",choices = projectConfigurationInfo$data[["xlsFormFields"]] - ,options = list(placeholder = '-- select --', onInitialize = I('function() { this.setValue(""); }')) - ) - ), - column(width = 8, - column(width = 9, style = "padding-left: 0px;", - fileInput('weightsStratifiedFileInput', 'Choose weights file for Stratified sample', - accept=c('text/csv', - 'text/comma-separated-values,text/plain', - '.csv'))), - column(width = 3, style = "border-left: 1px solid lightgray; margin-top: 10px;", - radioButtons('weightsStratifiedSep', 'Separator', - c(Comma=',', - Semicolon=';', - Tab='\t'), - ',', inline =TRUE)), - column(width = 3, offset = 9, - if(file.exists(paste(mainDir(), "data", "/weightsStratified.csv", sep = "/", collapse = "/"))){ - div(class = "warningBlock", - span(class = "warningTitle","WARNING!"), - span(class = "warningBody","Be careful, there is already weightsStratified.csv file in the data directory, once you upload the new file, it will be overridden.") - ) - } - - ) - ) - ) - - ) - ), - - column(12, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px; margin-bottom: 20px;", - column(width = projectConfigurationTheme$questionsWidth, style = "margin-bottom: 10px; border-bottom: 1px dotted lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", - h4("Do you have data cleaning log?") - ), - column(width = projectConfigurationTheme$yesNoInputWidth, offset = 0, - selectInput("cleaningLogSelectInput", label = NULL,choices = c("-- select --","Yes","No")) - ), - column(width = projectConfigurationTheme$warningBlockWidth, offset = 0, - if(file.exists(paste(mainDir(), "data", "/cleaningLog.csv", sep = "/", collapse = "/"))){ - div(class = "warningBlock", - span(class = "warningTitle","WARNING!"), - span(class = "warningBody","Be careful, there is already cleaningLog.csv file in the data directory, once you upload the new file, it will be overridden.") - ) - } - - ), - conditionalPanel( - condition = "input.cleaningLogSelectInput == 'Yes'", - column(width = 12, style="margin: 15px 0px 15px; border-top: 1px solid lightgray; padding: 20px 10px 0px;", - column(width = 9, style = "padding-left: 0px;", - fileInput('cleaningLogFileInput', 'Choose cleaning Log file', - accept=c('text/csv', - 'text/comma-separated-values,text/plain', - '.csv'))), - column(width = 3, style = "border-left: 1px solid lightgray; margin-top: 10px;", - radioButtons('cleaningLogSep', 'Separator', - c(Comma=',', - Semicolon=';', - Tab='\t'), - ',', inline =TRUE)) - ) - ) - - ), - column(12, style = "border: 1px solid lightgray; border-bottom-right-radius: 7px; margin-bottom: 20px; background-color: ghostwhite; padding-top: 0px;", - actionButton("saveRecordSettingsConfigurationButton", "Save Settings", icon("upload"), class = "uploadButton", style="margin: 15px 0px; height:45px; width:100%;") - ) - + - ), s ,sep="" ) - - return(s) - }) + observeEvent(input$saveRecordSettingsConfigurationButton, { tryCatch({ @@ -1288,16 +1827,16 @@ server <- shinyServer(function(input, output, session) { return(FALSE) } updateProgress() - if(sum(input$samplingSelectInput == "No sampling(type 1)")){ + if(sum(input$samplingSelectInput == "No sampling (type 1)")){ settingsDF[lastRow,"name"] <- "sample_type" settingsDF[lastRow,"label"] <- "Sample type of the project" - settingsDF[lastRow,"options"] <- "1. No sampling(type 1) 2. Cluster sample (type 2) 3. Stratified sample (type 3)" - settingsDF[lastRow,"value"] <- "No sampling(type 1)" + settingsDF[lastRow,"options"] <- "1. No sampling (type 1) 2. Cluster sample (type 2) 3. Stratified sample (type 3)" + settingsDF[lastRow,"value"] <- "No sampling (type 1)" } else if(sum(input$samplingSelectInput == "Cluster sample (type 2)")){ settingsDF[lastRow,"name"] <- "sample_type" settingsDF[lastRow,"label"] <- "Sample type of the project" - settingsDF[lastRow,"options"] <- "1. No sampling(type 1) 2. Cluster sample (type 2) 3. Stratified sample (type 3)" + settingsDF[lastRow,"options"] <- "1. No sampling (type 1) 2. Cluster sample (type 2) 3. Stratified sample (type 3)" settingsDF[lastRow,"value"] <- input$samplingSelectInput if(sum(input$variableNameCluster == "")){ @@ -1347,7 +1886,7 @@ server <- shinyServer(function(input, output, session) { else if(sum(input$samplingSelectInput == "Stratified sample (type 3)")){ settingsDF[lastRow,"name"] <- "sample_type" settingsDF[lastRow,"label"] <- "Sample type of the project" - settingsDF[lastRow,"options"] <- "1. No sampling(type 1) 2. Cluster sample (type 2) 3. Stratified sample (type 3)" + settingsDF[lastRow,"options"] <- "1. No sampling (type 1) 2. Cluster sample (type 2) 3. Stratified sample (type 3)" settingsDF[lastRow,"value"] <- input$samplingSelectInput updateProgress() if(sum(input$variableNameStratified == "")){ @@ -1462,11 +2001,11 @@ server <- shinyServer(function(input, output, session) { projectConfigurationInfo$log[["isRecordSettingsSaved"]] <- TRUE updateProgress() - if(sum(input$samplingSelectInput != "No sampling(type 1)")){ + if(sum(input$samplingSelectInput != "No sampling (type 1)")){ showModal(showSamplingMoreParm()) }else{ shinyalert("Done, Record Settings Configuration has been successfully saved", - "You can find the Settings in 'settings' sheet in xlsform file", + "You can find the Settings in 'analysisSettings' sheet in xlsform file", type = "success", closeOnClickOutside = FALSE, confirmButtonCol = "#28A8E2", @@ -1667,7 +2206,7 @@ server <- shinyServer(function(input, output, session) { removeModal() shinyalert("Done, Record Settings Configuration has been successfully saved", - "You can find the Settings in 'settings' sheet in xlsform file", + "You can find the Settings in 'analysisSettings' sheet in xlsform file", type = "success", closeOnClickOutside = FALSE, confirmButtonCol = "#28A8E2", @@ -2679,7 +3218,7 @@ server <- shinyServer(function(input, output, session) { h4("Enter indicator's label:") ), column(width = 5, offset = 0, - textInput("indicatorLabelInput", label = NULL, value = rowInd[1,"label"], width = "100%") + textInput("indicatorLabelInput", label = NULL, value = rowInd[1,"labelReport"], width = "100%") ), column(width = 1, offset = 0, align="center", uiOutput("indicatorLabelInputLengthUI") @@ -2745,17 +3284,6 @@ server <- shinyServer(function(input, output, session) { width = "100%") ) ), - column( - width=12, - column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", - h4("Apply sensitive?") - ), - column(width = 6, offset = 0, - selectInput("indicatorSensitiveInput", label = NULL, selected = ifelse(rowInd[1,"sensitive"]=="TRUE","Yes",ifelse(rowInd[1,"sensitive"]=="FALSE","No","-- select --")), - choices = c("-- select --","Yes","No"), - width = "100%") - ) - ), column( width=12, column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", @@ -2816,13 +3344,44 @@ server <- shinyServer(function(input, output, session) { column( width=12, column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", - h4("Apply structuralequation?") + h4("Apply structuralequation risk?") + ), + column(width = 6, offset = 0, + selectInput("indicatorstructuralequationRiskInput", label = NULL, selected = ifelse(rowInd[1,"structuralequation.risk"]=="TRUE","Yes",ifelse(rowInd[1,"structuralequation.risk"]=="FALSE","No","-- select --")), + choices = c("-- select --","Yes","No"), + width = "100%") + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Apply structuralequation coping?") + ), + column(width = 6, offset = 0, + selectInput("indicatorstructuralequationCopingInput", label = NULL, selected = ifelse(rowInd[1,"structuralequation.coping"]=="TRUE","Yes",ifelse(rowInd[1,"structuralequation.coping"]=="FALSE","No","-- select --")), + choices = c("-- select --","Yes","No"), + width = "100%") + ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Apply structuralequation resilience?") ), column(width = 6, offset = 0, - selectInput("indicatorStructuralequationInput", label = NULL, selected = ifelse(rowInd[1,"structuralequation"]=="TRUE","Yes",ifelse(rowInd[1,"structuralequation"]=="FALSE","No","-- select --")), + selectInput("indicatorstructuralequationResilienceInput", label = NULL, selected = ifelse(rowInd[1,"structuralequation.resilience"]=="TRUE","Yes",ifelse(rowInd[1,"structuralequation.resilience"]=="FALSE","No","-- select --")), choices = c("-- select --","Yes","No"), width = "100%") ) + ), + column( + width=12, + column(width = 6, style = "border-bottom: 1px solid lightgray; border-right: 1px dotted lightgray; border-bottom-right-radius: 7px;", + h4("Enter indicator's hint:") + ), + column(width = 6, offset = 0, + textInput("indicatorHintInput", label = NULL, value = rowInd[1,"hintReport"], width = "100%") + ) ) ) @@ -3010,7 +3569,7 @@ server <- shinyServer(function(input, output, session) { return(FALSE) } calculationResult <- "cut(" - calculationResult <- paste(calculationResult,input$frameDVSelectInput,"$",input$variableDVSelectInput, " ", sep="") + calculationResult <- paste(calculationResult,paste0(input$frameDVSelectInput,"_edited"),"$",input$variableDVSelectInput, " ", sep="") calculationResult <- paste(calculationResult, ",c(", pre,"))" , sep = "" ) }, error = function(err) { calculationResult <- structure(c, class = "try-error") @@ -3039,7 +3598,7 @@ server <- shinyServer(function(input, output, session) { ############################ END ############################ calculationResult <- "fct_recode(" - calculationResult <- paste(calculationResult,input$frameFRSelectInput,"$",input$variableFRSelectInput, ", ", sep="") + calculationResult <- paste(calculationResult,paste0(input$frameFRSelectInput,"_edited"),"$",input$variableFRSelectInput, ", ", sep="") factorValues <- choicesSheetFR()[choicesSheetFR()$list_name==input$listnameFRSelectInput,c("list_name", "name", "label")] for(i in 1:nrow(factorValues)){ @@ -3078,11 +3637,11 @@ server <- shinyServer(function(input, output, session) { calculationResult <- "psum(" calculationResult <- paste(calculationResult, - input$frameSUSelectInput, + paste0(input$frameSUSelectInput,"_edited"), "$", input$varSU1, ", ", - input$frameSUSelectInput, + paste0(input$frameSUSelectInput,"_edited"), "$", input$varSU2, ifelse(length(variablesToUseSU$idOfVar)>0, @@ -3094,7 +3653,7 @@ server <- shinyServer(function(input, output, session) { for(i in variablesToUseSU$idOfVar){ val <- input[[paste("varSU", i, sep = "")]] calculationResult <- paste(calculationResult, - input$frameSUSelectInput, + paste0(input$frameSUSelectInput,"_edited"), "$", val , sep="") @@ -3134,7 +3693,7 @@ server <- shinyServer(function(input, output, session) { ############################ END ############################ - varFrame <- paste(input$frameMMASelectInput,"$",input$variableMMASelectInput, sep="") + varFrame <- paste(paste0(input$frameMMASelectInput,"_edited"),"$",input$variableMMASelectInput, sep="") if(sum(input$statisticalFunctionsMMASelectInput=="Minimum")){ calculationResult <- paste("min(",varFrame," ,na.rm = TRUE)",sep = "") }else if(sum(input$statisticalFunctionsMMASelectInput=="Maximum")){ @@ -3176,17 +3735,17 @@ server <- shinyServer(function(input, output, session) { } ############################ END ############################ - form_tmp <- paste(mainDir(), "data", paste(input$frameD2SelectInput, ".csv", sep = ""), sep = "/", collapse = "/") + form_tmp <- paste(mainDir(), "data", paste(paste(input$frameD2SelectInput,"_edited"), ".csv", sep = ""), sep = "/", collapse = "/") temp <- read.csv(form_tmp, stringsAsFactors = TRUE) if(input$variableD2SelectInput1 %in% colnames(temp)){ - calculationResult <- paste(input$frameD2SelectInput,"$",input$variableD2SelectInput1, " / ", sep="") + calculationResult <- paste(paste0(input$frameD2SelectInput,"_edited"),"$",input$variableD2SelectInput1, " / ", sep="") }else{ calculationResult <- paste(input$variableD2SelectInput1, " / ", sep="") } if(input$variableD2SelectInput2 %in% colnames(temp)){ - calculationResult <- paste(calculationResult, input$frameD2SelectInput,"$",input$variableD2SelectInput2, sep="") + calculationResult <- paste(calculationResult, paste0(input$frameD2SelectInput,"_edited"),"$",input$variableD2SelectInput2, sep="") }else{ calculationResult <- paste(calculationResult, input$variableD2SelectInput2, sep="") } @@ -3210,7 +3769,6 @@ server <- shinyServer(function(input, output, session) { leftSide <- input[[paste("leftSideCond", conditionsId[j], "Block", blocksId[i], sep = "")]] rightSide <- input[[paste("rightSideCond", conditionsId[j], "Block", blocksId[i], sep = "")]] logicalOperators <- input[[paste("logicalOperatorsCond", conditionsId[j], "Block", blocksId[i], sep = "")]] - x<<-rightSide ############################## validation ############################## if(conditionsId[j]!=1){ if((linkBy=="-- select --" | trimws(linkBy)=="" )){ @@ -3278,7 +3836,7 @@ server <- shinyServer(function(input, output, session) { conditionString <- "(" if(leftSide %in% colnames(mainDf)){ - leftSide <- paste(input$frameIFSelectInput ,"['",leftSide,"']", sep = "") + leftSide <- paste(paste0(input$frameIFSelectInput,"_edited") ,"['",leftSide,"']", sep = "") } else{ checker <- as.numeric(leftSide) @@ -3289,7 +3847,7 @@ server <- shinyServer(function(input, output, session) { } } if(rightSide %in% colnames(mainDf)){ - rightSide <- paste(input$frameIFSelectInput ,"['",rightSide,"']", sep = "") + rightSide <- paste(paste0(input$frameIFSelectInput,"_edited") ,"['",rightSide,"']", sep = "") } else{ if(logicalOperators == "in" | logicalOperators == "not in"){ @@ -3348,7 +3906,7 @@ server <- shinyServer(function(input, output, session) { return(FALSE) } if(resultOfBlock %in% colnames(mainDf)){ - resultOfBlock <- paste(input$frameIFSelectInput ,"['",resultOfBlock,"']", sep = "") + resultOfBlock <- paste(paste0(input$frameIFSelectInput,"_edited") ,"['",resultOfBlock,"']", sep = "") } else{ checker <- as.numeric(resultOfBlock) @@ -3376,7 +3934,7 @@ server <- shinyServer(function(input, output, session) { return(FALSE) } if(resultOfElse %in% colnames(mainDf)){ - resultOfElse <- paste(input$frameIFSelectInput ,"['",resultOfElse,"']", sep = "") + resultOfElse <- paste(paste0(input$frameIFSelectInput,"_edited") ,"['",resultOfElse,"']", sep = "") } else{ checker <- as.numeric(resultOfElse) @@ -3415,8 +3973,8 @@ server <- shinyServer(function(input, output, session) { if(sum(input$indicatorCaseSelectInput=="Discretize a value")){ tryCatch({ - form_tmp <- paste(mainDir(), "data", paste(input$frameDVSelectInput, ".csv", sep = ""), sep = "/", collapse = "/") - assign(input$frameDVSelectInput,read.csv(form_tmp, stringsAsFactors = TRUE)) + form_tmp <- paste(mainDir(), "data", paste(paste0(input$frameDVSelectInput,"_edited"), ".csv", sep = ""), sep = "/", collapse = "/") + assign(paste0(input$frameDVSelectInput,"_edited"),read.csv(form_tmp, stringsAsFactors = TRUE)) typeOfInd <- eval(parse(text=calculationResult)) if(is.character(typeOfInd)){ typeOfInd <- "factor" @@ -3427,7 +3985,7 @@ server <- shinyServer(function(input, output, session) { }else{ typeOfInd <- "factor" } - rm(input$frameDVSelectInput) + rm(paste0(input$frameDVSelectInput,"_edited")) }, error = function(err) { typeOfInd <- structure(c, class = "try-error") }) @@ -3435,8 +3993,8 @@ server <- shinyServer(function(input, output, session) { else if(sum(input$indicatorCaseSelectInput=="Re categorize a categorical variable by re coding modalities")){ tryCatch({ - form_tmp <- paste(mainDir(), "data", paste(input$frameFRSelectInput, ".csv", sep = ""), sep = "/", collapse = "/") - assign(input$frameFRSelectInput,read.csv(form_tmp, stringsAsFactors = TRUE)) + form_tmp <- paste(mainDir(), "data", paste(paste0(input$frameFRSelectInput,"_edited"), ".csv", sep = ""), sep = "/", collapse = "/") + assign(paste0(input$frameFRSelectInput,"_edited"),read.csv(form_tmp, stringsAsFactors = TRUE)) typeOfInd <- eval(parse(text=calculationResult)) if(is.character(typeOfInd)){ typeOfInd <- "factor" @@ -3447,7 +4005,7 @@ server <- shinyServer(function(input, output, session) { }else{ typeOfInd <- "factor" } - rm(input$frameFRSelectInput) + rm(paste0(input$frameFRSelectInput,"_edited")) }, error = function(err) { typeOfInd <- structure(c, class = "try-error") @@ -3456,8 +4014,8 @@ server <- shinyServer(function(input, output, session) { else if(sum(input$indicatorCaseSelectInput=="Sum up different numeric or integer variables") ){ tryCatch({ - form_tmp <- paste(mainDir(), "data", paste(input$frameSUSelectInput, ".csv", sep = ""), sep = "/", collapse = "/") - assign(input$frameSUSelectInput,read.csv(form_tmp, stringsAsFactors = TRUE)) + form_tmp <- paste(mainDir(), "data", paste(paste0(input$frameSUSelectInput,"_edited"), ".csv", sep = ""), sep = "/", collapse = "/") + assign(paste0(input$frameSUSelectInput,"_edited"),read.csv(form_tmp, stringsAsFactors = TRUE)) typeOfInd <- eval(parse(text=calculationResult)) if(is.character(typeOfInd)){ typeOfInd <- "factor" @@ -3468,7 +4026,7 @@ server <- shinyServer(function(input, output, session) { }else{ typeOfInd <- "factor" } - rm(input$frameSUSelectInput) + rm(paste0(input$frameSUSelectInput,"_edited")) }, error = function(err) { typeOfInd <- structure(c, class = "try-error") @@ -3477,8 +4035,8 @@ server <- shinyServer(function(input, output, session) { else if(sum(input$indicatorCaseSelectInput=="Calculate min, max or avg value for multiple integer or numeric variables")){ tryCatch({ - form_tmp <- paste(mainDir(), "data", paste(input$frameMMASelectInput, ".csv", sep = ""), sep = "/", collapse = "/") - assign(input$frameMMASelectInput,read.csv(form_tmp, stringsAsFactors = TRUE)) + form_tmp <- paste(mainDir(), "data", paste(paste0(input$frameMMASelectInput,"_edited"), ".csv", sep = ""), sep = "/", collapse = "/") + assign(paste0(input$frameMMASelectInput,"_edited"),read.csv(form_tmp, stringsAsFactors = TRUE)) typeOfInd <- eval(parse(text=calculationResult)) if(is.character(typeOfInd)){ typeOfInd <- "factor" @@ -3489,7 +4047,7 @@ server <- shinyServer(function(input, output, session) { }else{ typeOfInd <- "factor" } - rm(input$frameMMASelectInput) + rm(paste0(input$frameMMASelectInput,"_edited")) }, error = function(err) { typeOfInd <- structure(c, class = "try-error") @@ -3498,8 +4056,8 @@ server <- shinyServer(function(input, output, session) { else if(sum(input$indicatorCaseSelectInput=="Calculate ratio by dividing 2 numeric or integer variables")){ tryCatch({ - form_tmp <- paste(mainDir(), "data", paste(input$frameD2SelectInput, ".csv", sep = ""), sep = "/", collapse = "/") - assign(input$frameD2SelectInput,read.csv(form_tmp, stringsAsFactors = TRUE)) + form_tmp <- paste(mainDir(), "data", paste(paste0(input$frameD2SelectInput,"_edited"), ".csv", sep = ""), sep = "/", collapse = "/") + assign(paste0(input$frameD2SelectInput,"_edited"),read.csv(form_tmp, stringsAsFactors = TRUE)) typeOfInd <- eval(parse(text=calculationResult)) if(is.character(typeOfInd)){ typeOfInd <- "factor" @@ -3510,7 +4068,7 @@ server <- shinyServer(function(input, output, session) { }else{ typeOfInd <- "factor" } - rm(input$frameD2SelectInput) + rm(paste0(input$frameD2SelectInput,"_edited")) }, error = function(err) { typeOfInd <- structure(c, class = "try-error") @@ -3519,8 +4077,8 @@ server <- shinyServer(function(input, output, session) { else if(sum(input$indicatorCaseSelectInput=="Set condition on specific variables")){ tryCatch({ - form_tmp <- paste(mainDir(), "data", paste(input$frameIFSelectInput, ".csv", sep = ""), sep = "/", collapse = "/") - assign(input$frameIFSelectInput,read.csv(form_tmp, stringsAsFactors = TRUE)) + form_tmp <- paste(mainDir(), "data", paste(paste0(input$frameIFSelectInput,"_edited"), ".csv", sep = ""), sep = "/", collapse = "/") + assign(paste0(input$frameIFSelectInput,"_edited"),read.csv(form_tmp, stringsAsFactors = TRUE)) typeOfInd <- eval(parse(text=calculationResult)) if(is.character(typeOfInd)){ typeOfInd <- "factor" @@ -3531,7 +4089,7 @@ server <- shinyServer(function(input, output, session) { }else{ typeOfInd <- "factor" } - rm(input$frameIFSelectInput) + rm(paste0(input$frameIFSelectInput,"_edited")) }, error = function(err) { typeOfInd <- structure(c, class = "try-error") @@ -3587,27 +4145,25 @@ server <- shinyServer(function(input, output, session) { preCal <- NA } indicator <- indicator[!is.na(indicator$fullname) & indicator$fullname!=selInd,] - frame <- input$indicatorFrameInput - if(input$indicatorFrameInput=="MainDataFrame"){ - frame <- "MainDataFrame_edited" - } - + frame <- paste0(input$indicatorFrameInput, "_edited") newRow <- data.frame( type = ifelse(sum(input$useCalculation=="No"),ifelse(is.null(typeOfInd),NA,ifelse(typeOfInd=="factor", "select_one",typeOfInd)),preTyp), fullname = input$indicatorFullnameInput, - label = input$indicatorLabelInput, + labelReport = input$indicatorLabelInput, + hintReport = input$indicatorHintInput, chapter = preChp, disaggregation = ifelse(sum(input$indicatorDisaggregationInput=="Yes"),"TRUE",ifelse(sum(input$indicatorDisaggregationInput=="No"),"False",NA)), correlate = ifelse(sum(input$indicatorCorrelateInput=="Yes"),"TRUE",ifelse(sum(input$indicatorCorrelateInput=="No"),"False",NA)), - sensitive = ifelse(sum(input$indicatorSensitiveInput=="Yes"),"TRUE",ifelse(sum(input$indicatorSensitiveInput=="No"),"False",NA)), anonymise = ifelse(sum(input$indicatorAnonymiseInput=="-- select --"),NA,input$indicatorAnonymiseInput), cluster = ifelse(sum(input$indicatorClusterInput=="Yes"),"TRUE",ifelse(sum(input$indicatorClusterInput=="No"),"False",NA)), predict = ifelse(sum(input$indicatorPredictInput=="Yes"),"TRUE",ifelse(sum(input$indicatorPredictInput=="No"),"False",NA)), variable = ifelse(typeOfInd=="factor",preVar,NA), mappoint = ifelse(sum(input$indicatorMappointInput=="Yes"),"TRUE",ifelse(sum(input$indicatorMappointInput=="No"),"False",NA)), mappoly = ifelse(sum(input$indicatorMappolyInput=="Yes"),"TRUE",ifelse(sum(input$indicatorMappolyInput=="No"),"False",NA)), - structuralequation = ifelse(sum(input$indicatorStructuralequationInput=="Yes"),"TRUE",ifelse(sum(input$indicatorStructuralequationInput=="No"),"False",NA)), + structuralequation.risk = ifelse(sum(input$indicatorstructuralequationRiskInput=="Yes"),"TRUE",ifelse(sum(input$indicatorstructuralequationRiskInput=="No"),"False",NA)), + structuralequation.coping = ifelse(sum(input$indicatorstructuralequationCopingInput=="Yes"),"TRUE",ifelse(sum(input$indicatorstructuralequationCopingInput=="No"),"False",NA)), + structuralequation.resilience = ifelse(sum(input$indicatorstructuralequationResilienceInput=="Yes"),"TRUE",ifelse(sum(input$indicatorstructuralequationResilienceInput=="No"),"False",NA)), frame = ifelse(sum(input$indicatorFrameInput=="-- select --"),NA,frame) , listname = ifelse(sum(input$indicatorListnameInput=="-- select --"),NA,input$indicatorListnameInput), calculation = ifelse(sum(input$useCalculation=="No"),gsub("MainDataFrame", "MainDataFrame_edited", calculationResult),preCal), @@ -6848,8 +7404,6 @@ server <- shinyServer(function(input, output, session) { }) }) - - ####################################### Data Processing page ############################################ output$dataProcessing <- renderUI({ if(!projectConfigurationInfo$log[["isAnalysisPlanCompleted"]]){ @@ -7389,4 +7943,3 @@ server <- shinyServer(function(input, output, session) { # Run the application shinyApp(ui = ui, server = server) - diff --git a/docs/reference/data/form.xls b/docs/reference/data/form.xls index d3960d98f0076f2fe1af3f7ae7c5f9974a4da008..7aed1e9e8ba564f541ea3d34b275b51d1ee79934 100644 GIT binary patch delta 1097 zcmZvcy>HV%7{*^aZjvUYag)+7XbImfh^inVI-rV)1r}gM3RmaSp19h|3X+ONEiztwilXrk7vpenh3jOh7Bih2jjX0qYbh+f$zqwm$>9?YO$q)(5DBQlXw z0R%U)oCTW7X#jL8ry}TdP9>1u=Tx%{LYEm0g7o1?a}`jzmtz$Oi?ieqXeOr j)!W97sfy_zLiF5xX&#J54+?jqJB80XqqA{y?2GXSe-qL& delta 476 zcmXxhJ4?e*6bJBgZ_|fSQ(tW!wY5HKYkjpoY83==5C=iJxLPOy1wpVX=%8KP6f_x} z1Sc0kEO&D2>@FP~{36o$zX31&I437JIk_i|a-(oxNYnr7BkDrVpyPR-EUO@j);n{I zQ^!(xOLH%cD}JZB6?4noFk23P2`bpcM3dXf&SOYE6{7mt$+>-TLs2riWhG3tgX6=R zUB4v-4H&&KKPozD#N`fu$veN4V!OD~#Yfm=36Cs_(0-7p2StHcMa-j5+dYb9RlgxB zZPk5>J&P~(C&0HgKi`YKa`722v4`rqW96>pm&lj&f(B8*nW-NJU=W5N2652A023@o zz%V2s1tXA#Q5b`9n1BpSLKbo`1$m-Pnnp4MvoHtqP=F#Vz#=TcGL&Ei%CHJ+&}mk5 bmX!ZSjw}Fj^cV>yE@w;>5gF?n=Z*XU)iXgO diff --git a/docs/reference/format_si.html b/docs/reference/format_si.html index 37345ec..fac1b35 100644 --- a/docs/reference/format_si.html +++ b/docs/reference/format_si.html @@ -207,7 +207,7 @@

Examp #> trim = TRUE, scientific = FALSE, ...), #> prefix[i]) #> } -#> <environment: 0x55d95e1f11a0>
+#> <environment: 0x5570ea3a7620>
- 
kobo_clean(frame, dico)
+ 
kobo_clean(frame, dico = "dico_form.xls.csv")

Arguments

- - + + - - + +
dico

Generated from kobo_dico function

frame

odk dataset to use
kobo

or odk dataset to use

dico

Generated from kobo_dico function

Examples

- 
kobo_clean()
#> Error in levels(dico$clean): argument "dico" is missing, with no default

+    
kobo_clean()
#> Error in dico$clean: $ operator is invalid for atomic vectors

 
# NOT RUN {
 kobo_clean(frame, dico)
 # }

diff --git a/docs/reference/kobo_crunching_report.html b/docs/reference/kobo_crunching_report.html
index 4687621..8e921ca 100644
--- a/docs/reference/kobo_crunching_report.html
+++ b/docs/reference/kobo_crunching_report.html
@@ -532,58 +532,40 @@ 
Examp
 #>     as.Date, as.Date.numeric
#> 
 #> Attaching package: ‘lubridate’
#> The following object is masked from ‘package:plyr’:
 #> 
-#>     here
#> The following objects are masked from ‘package:data.table’:
+#>     here
#> The following object is masked from ‘package:base’:
 #> 
-#>     hour, isoweek, mday, minute, month, quarter, second, wday, week,
-#>     yday, year
#> The following object is masked from ‘package:base’:
+#>     date
#> gdata: read.xls support for 'XLS' (Excel 97-2004) files ENABLED.
#> 
#> gdata: read.xls support for 'XLSX' (Excel 2007+) files ENABLED.
#> 
+#> Attaching package: ‘gdata’
#> The following object is masked from ‘package:stats’:
 #> 
-#>     date
#> 
-#> Attaching package: ‘gridExtra’
#> The following object is masked from ‘package:gdata’:
+#>     nobs
#> The following object is masked from ‘package:utils’:
+#> 
+#>     object.size
#> The following object is masked from ‘package:base’:
 #> 
-#>     combine
#> The following object is masked from ‘package:dplyr’:
+#>     startsWith
#> 
+#> Attaching package: ‘gridExtra’
#> The following object is masked from ‘package:gdata’:
 #> 
 #>     combine
#> 
 #> Attaching package: ‘scales’
#> The following object is masked from ‘package:viridis’:
 #> 
-#>     viridis_pal
#> The following object is masked from ‘package:readr’:
-#> 
-#>     col_factor
#> 
-#> Attaching package: ‘kableExtra’
#> The following object is masked from ‘package:dplyr’:
-#> 
-#>     group_rows
#> Loading required package: sylly
#> 
+#>     viridis_pal
#> Loading required package: sylly
#> 
 #> Attaching package: ‘sylly’
#> The following object is masked from ‘package:testthat’:
 #> 
 #>     describe
#> For information on available language packages for 'koRpus', run
 #> 
 #>   available.koRpus.lang()
 #> 
-#> and see ?install.koRpus.lang()
#> 
-#> Attaching package: ‘koRpus’
#> The following object is masked from ‘package:readr’:
-#> 
-#>     tokenize
#> Loading required package: Hmisc
#> Loading required package: survival
#> 
-#> Attaching package: ‘survival’
#> The following object is masked from ‘package:OpenRepGrid’:
-#> 
-#>     cluster
#> Loading required package: Formula
#> 
+#> and see ?install.koRpus.lang()
#> Loading required package: Hmisc
#> Loading required package: lattice
#> Loading required package: survival
#> Loading required package: Formula
#> Loading required package: ggplot2
#> 
 #> Attaching package: ‘Hmisc’
#> The following object is masked from ‘package:koRpus’:
 #> 
 #>     describe
#> The following object is masked from ‘package:sylly’:
 #> 
-#>     describe
#> The following object is masked from ‘package:testthat’:
-#> 
-#>     describe
#> The following object is masked from ‘package:simFrame’:
-#> 
-#>     stratify
#> The following object is masked from ‘package:ape’:
-#> 
-#>     zoom
#> The following objects are masked from ‘package:dplyr’:
-#> 
-#>     src, summarize
#> The following objects are masked from ‘package:plyr’:
+#>     describe
#> The following objects are masked from ‘package:plyr’:
 #> 
-#>     is.discrete, summarize
#> The following objects are masked from ‘package:base’:
+#>     is.discrete, summarize
#> The following object is masked from ‘package:testthat’:
 #> 
-#>     format.pval, units
#> Loading required package: carData
#> 
-#> Attaching package: ‘car’
#> The following object is masked from ‘package:dplyr’:
+#>     describe
#> The following objects are masked from ‘package:base’:
 #> 
-#>     recode
#> 
+#>     format.pval, units
#> Loading required package: carData
#> 
 #> 
 #>  Loading data. It is assumed that the cleaning, weighting & re-encoding has been done previously 
#> Warning: cannot open file '/home/edouard/R-project/koboloadeR-ghpages/docs/reference/data/MainDataFrame_encoded.csv': No such file or directory
#> [1] "kobo_crunching_report_ERROR"
#> $message
 #> [1] "cannot open the connection"
diff --git a/docs/reference/kobo_dummy.html b/docs/reference/kobo_dummy.html
index 1bf9206..2d00c36 100644
--- a/docs/reference/kobo_dummy.html
+++ b/docs/reference/kobo_dummy.html
@@ -38,7 +38,7 @@
 This function helps imagine what data will look like before they collect it.
 samplesize is set per defautl at 500 records
 Supported Features
-- Gnerate a data set with an output similar to the one needed in koboloader
+- Generate a data set with an output similar to the one needed in koboloader
 - respects ODK structure "`relevant`" skip logic (Some advanced functionality such as "coalesce()" not covered)
   "`constraint`" and "`repeat`"
 - adds InstandID column to link hierearchical data based on "`repeat_count`"" />
@@ -164,7 +164,7 @@ 
Create a dummy dataset

 This function helps imagine what data will look like before they collect it.
 samplesize is set per defautl at 500 records

 
Supported Features

-
- Gnerate a data set with an output similar to the one needed in koboloader
+
- Generate a data set with an output similar to the one needed in koboloader
 - respects ODK structure "`relevant`" skip logic (Some advanced functionality such as "coalesce()" not covered)
   "`constraint`" and "`repeat`"
 - adds InstandID column to link hierearchical data based on "`repeat_count`"

@@ -177,8 +177,8 @@ 
Arg
     
-      
-      
+      
+      

     
     
dico
file representing the xlsform data dictionnary - generated from kobo_dico()
form
file xlsform

     

     

     
diff --git a/docs/reference/kobo_edit_form.html b/docs/reference/kobo_edit_form.html
index 1d141ed..9dfcd92 100644
--- a/docs/reference/kobo_edit_form.html
+++ b/docs/reference/kobo_edit_form.html
@@ -192,7 +192,7 @@ 
Value

     
 
     
Examples

-    
kobo_edit_form()
#> Workbook has no sheets!
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf

+    
kobo_edit_form()
#> Workbook has no sheets!
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf
#> Warning: no non-missing arguments to max; returning -Inf

 
# NOT RUN {
 kobo_edit_form("myform.xls")
 # }

diff --git a/docs/reference/kobo_form.html b/docs/reference/kobo_form.html
index 7b84a99..4576556 100644
--- a/docs/reference/kobo_form.html
+++ b/docs/reference/kobo_form.html
@@ -163,16 +163,16 @@ 
Arg
       
The ID of the form to be accessed (as a character string).

     
     
-      api
-      
The URL at which the API can be accessed.
-Defaults to "unhcr", which loads the UNHCR KoBo Toolbox API.

-    
-    
-      user
+      userpwd
       
Optional. A single string indicating the username and password
 (in the form of "username:password"), or a character vector or list,
 length 2, with the first value being the "username", and the second being
 the "password".

+    
+    
+      api
+      
The URL at which the API can be accessed.
+Defaults to "unhcr", which loads the UNHCR KoBo Toolbox API.

     
     
     
diff --git a/docs/reference/kobo_getMainDirectory.html b/docs/reference/kobo_getMainDirectory.html
index e255b69..803e965 100644
--- a/docs/reference/kobo_getMainDirectory.html
+++ b/docs/reference/kobo_getMainDirectory.html
@@ -172,10 +172,6 @@ 
Examp
 #> image exists in subDir and is a directory.
 #> Data exists in mainDir and is a directory.
 #> Out directory exists in your project directory and is a directory.
-#> bar_multi directory exists in out directory and is a directory.
-#> disagg_multi directory exists in out directory and is a directory.
-#> bar_one directory exists in out directory and is a directory.
-#> disagg_one directory exists in out directory and is a directory.
 #> crunching_reports directory exists in out directory and is a directory.
 #> cluster_reports directory exists in out directory and is a directory.
 #> anonymisation_reports directory exists in out directory and is a directory.
diff --git a/docs/reference/kobo_get_dataframes_levels.html b/docs/reference/kobo_get_dataframes_levels.html
index 73efc20..56c4f8b 100644
--- a/docs/reference/kobo_get_dataframes_levels.html
+++ b/docs/reference/kobo_get_dataframes_levels.html
@@ -171,8 +171,14 @@ 
Value

     
 
     
Examples

-    
kobo_get_dataframes_levels()
#>            name level parent
-#> 1 MainDataFrame     1   root

+    
kobo_get_dataframes_levels()
#> [1] "kkobo_get_dataframes_levels_ERROR"
#> $message
+#> [1] "could not find function \"str_replace\""
+#> 
+#> $call
+#> str_replace(survey$type, "_", " ")
+#> 
+#> attr(,"class")
+#> [1] "try-error"

 
# NOT RUN {
 kobo_get_dataframes_levels("myform.xls")
 # }

diff --git a/docs/reference/kobo_label.html b/docs/reference/kobo_label.html
index c7295f0..945c253 100644
--- a/docs/reference/kobo_label.html
+++ b/docs/reference/kobo_label.html
@@ -159,12 +159,12 @@ 
Arg
     
-      
-      
+      
+      
-      
-      
+      
+      

     
     
dico
( generated from kobo_dico)
datalabel
file to be labeled

     

     
data
.
dico
generated from kobo_dico)

     

     

     
diff --git a/docs/reference/kobo_left_align.html b/docs/reference/kobo_left_align.html
index d79925b..4faa167 100644
--- a/docs/reference/kobo_left_align.html
+++ b/docs/reference/kobo_left_align.html
@@ -154,7 +154,20 @@ 
UNHCR ggplot2 theme

     

 
     
kobo_left_align(plot_name, pieces)

-        
+    
+    
Arguments

+    
+    
+    
+      
+      
+    
+    
+      
+      
+    
+    
plot_name
ggplot2 object
pieces
plot labels to align

+    
     
Value

 
     
Return better chart

@@ -167,6 +180,7 @@ 
Examp
   
diff --git a/docs/reference/kobo_shiny.html b/docs/reference/kobo_shiny.html
index 8e946f8..e230872 100644
--- a/docs/reference/kobo_shiny.html
+++ b/docs/reference/kobo_shiny.html
@@ -160,7 +160,7 @@ 
Arg
     
     
       app
-      
+      
script where shyni app is located

     
     
     
diff --git a/docs/reference/kobo_surveyname.html b/docs/reference/kobo_surveyname.html
index b7a95b3..a2af16d 100644
--- a/docs/reference/kobo_surveyname.html
+++ b/docs/reference/kobo_surveyname.html
@@ -166,7 +166,7 @@ 
Arg
     
 
     
Examples

-    
kobo_surveyname()
#> Error in paste0("data/", form): argument "form" is missing, with no default

+    
kobo_surveyname()
#> Error in kobo_surveyname(): could not find function "kobo_surveyname"

 
# NOT RUN {
 r
 kobo_surveyname(form)
diff --git a/docs/reference/kobo_time_parser.html b/docs/reference/kobo_time_parser.html
index f48b251..302adcf 100644
--- a/docs/reference/kobo_time_parser.html
+++ b/docs/reference/kobo_time_parser.html
@@ -166,7 +166,7 @@ 
Value

     
 
     
Examples

-    
kobo_time_parser(TIME)
#> Error in gsub("\\.\\d{3}|:", "", instring): object 'TIME' not found
kobo_time_parser(TIME, timezone = "Asia/Rangoon")
#> Error in gsub("\\.\\d{3}|:", "", instring): object 'TIME' not found
kobo_time_parser(TIME, timezone = "America/Los_Angeles")
#> Error in gsub("\\.\\d{3}|:", "", instring): object 'TIME' not found

+    
kobo_time_parser(TIME)
#> Error in kobo_time_parser(TIME): could not find function "kobo_time_parser"
kobo_time_parser(TIME, timezone = "Asia/Rangoon")
#> Error in kobo_time_parser(TIME, timezone = "Asia/Rangoon"): could not find function "kobo_time_parser"
kobo_time_parser(TIME, timezone = "America/Los_Angeles")
#> Error in kobo_time_parser(TIME, timezone = "America/Los_Angeles"): could not find function "kobo_time_parser"