Skip to content

Commit

Permalink
Fixing bugs with loops and multiple languages
Browse files Browse the repository at this point in the history
  • Loading branch information
@ElliottMess
ElliottMess committed Dec 5, 2019
1 parent f88cc38 commit 5f5dd17
Show file tree
Hide file tree
Showing 3 changed files with 311 additions and 118 deletions.
209 changes: 91 additions & 118 deletions R/koboAPI.R
View file
Original file line number Diff line number Diff line change
@@ -1,54 +1,49 @@
#' @name kobo_form
#' @rdname kobo_form
#' @name download_form
#' @rdname download_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). Must be a KPI-type ID (not api V1 ID). See kobo_all_forms for more details.
#' @param formid The ID of the form to be accessed (as a character string). Must be a KPI-type ID (not api V1 ID). See download_forms_all for more details.
#' @param user Optional. A single string indicating the username
#' @param api The URL at which the API can be accessed. Default to "kobo.humanitarianresponse.info"
#'
#' @return A list with two objects: The "survey" sheet as a dataframe with all the questions variables, and the "choices" sheet as a dataframe with all the choices variables.
#'
#' @author Elliott Messeiller
#'
#' @export kobo_form
#' @export download_form
#'

kobo_form <- function(formid, user, api="https://kobo.humanitarianresponse.info") {
if(pwd == ""){pwd <- readline("Enter password:")}
download_form <- function(formid, user, pwd =NULL, api="https://kobo.humanitarianresponse.info") {
if(!exists('pwd') || (pwd == "" || is.null(pwd))){pwd <- readline("Enter password:")}
if(pwd == "") stop("No password entered.")

url_form <- paste0(api, "/assets/", formid, "/")
raw_form <- GET(url_form, authenticate(user, pwd))
raw_form <- GET(url_form, authenticate(user, pwd), progress())
raw_form_text <- content(raw_form, "text", encoding = "UTF-8")
raw_form_text_json <- fromJSON(raw_form_text)

languages <- as.vector(raw_form_text_json$content$translations)
languages_labels <- paste0("label::", languages)
choices <- as.data.frame(raw_form_text_json$content$choices)
survey <- as.data.frame(raw_form_text_json$content$survey)
survey$label <- nullToNA(survey$label)

if(length(languages)>1){
choices_labels <- as.data.frame(do.call(rbind, choices$label))
names(choices_labels) <- languages_labels
choices <- cbind(choices, choices_labels) %>%
select(-label)

survey_labels <- as.data.frame(do.call(rbind, survey$label))
names(survey_labels) <- languages_labels
survey <- cbind(survey, survey_labels) %>%
select(-label)
}

form <- list("survey" = survey, "choices" = choices)

choices <- as.data.frame(raw_form_text_json$content$choices)%>%
purrr::modify_depth(2, replace_x, replacement = c(rep("NA", length(languages_labels))))%>%
dplyr::mutate(label = purrr::map(label, setNames, languages_labels))%>%
unnest_wider(label)

survey <- as.data.frame(raw_form_text_json$content$survey)%>%
purrr::modify_depth(2, replace_x, replacement = c(rep("NA", length(languages_labels))))%>%
dplyr::mutate(label = purrr::map(label, setNames, languages_labels))%>%
unnest_wider(label)

form <- list("survey" = survey, "choices" = choices)
return(form)
}

#' @name kobo_all_forms
#' @rdname kobo_all_forms
#' @name download_forms_all
#' @rdname download_forms_all
#' @title Returns a dataframe with all forms available for the user
#'
#' @description Download form from the platform
Expand All @@ -61,21 +56,26 @@ kobo_form <- function(formid, user, api="https://kobo.humanitarianresponse.info"
#'
#' @author Elliott Messeiller
#'
#' @export kobo_all_forms
#'
#'
kobo_all_forms <- function(user,pwd, api = "https://kobo.humanitarianresponse.info"){
if(pwd == ""){pwd <- readline("Enter password:")}
#' @export download_forms_all


download_forms_all <- function(user,pwd, api = "https://kobo.humanitarianresponse.info"){
if(!exists('pwd') || (pwd == "" || is.null(pwd))){pwd <- readline("Enter password:")}
if(pwd == "") stop("No password entered.")
api_type <- kobo_api_type(api)
api_type <- api_type(api)

if(pwd == "") stop("No password entered.")

all_forms <- GET(paste0(api, "/assets/"), authenticate(user, pwd))
all_forms_text <- content(all_forms, "text", encoding = "UTF-8")
all_forms_text_json <- fromJSON(all_forms_text)
download_forms_all <- GET(paste0(api, "/assets/"), authenticate(user, pwd), progress())
if(download_forms_all$status_code == 403){
stop('Error 403 Forbidden: probably wrong username or password'
)
}
download_forms_all <- download_forms_all%>%
content("text", encoding = "UTF-8")%>%
fromJSON()

all_forms_df <- as.data.frame(all_forms_text_json$results)%>%
download_forms_all_df <- as.data.frame(download_forms_all$results)%>%
filter(has_deployment == TRUE)%>%
select(name, uid, date_created, date_modified, deployment__submission_count)

Expand All @@ -85,21 +85,21 @@ kobo_all_forms <- function(user,pwd, api = "https://kobo.humanitarianresponse.in
if(api_type == "humanitarianresponse.info"){
old_api <- "https://kc.humanitarianresponse.info/api/v1/data"
}
all_forms_old <- GET(old_api, authenticate(user, pwd))
all_forms_old <- content(all_forms_old, "text", encoding = "UTF-8")
all_forms_old <- fromJSON(all_forms_old)
all_forms_old <- as.data.frame(all_forms_old)%>%
download_forms_all_old <- GET(old_api, authenticate(user, pwd), progress())
download_forms_all_old <- content(download_forms_all_old, "text", encoding = "UTF-8")
download_forms_all_old <- fromJSON(download_forms_all_old)
download_forms_all_old <- as.data.frame(download_forms_all_old)%>%
mutate(old_id = id)%>%
select(old_id, id_string)

all_forms_df <- left_join(all_forms_df, all_forms_old, by = c("uid" = "id_string"))
download_forms_all_df <- left_join(download_forms_all_df, download_forms_all_old, by = c("uid" = "id_string"))


return(all_forms_df)
return(download_forms_all_df)
}

#' @name kobo_all_exports
#' @rdname kobo_all_exports
#' @name all_exports
#' @rdname all_exports
#' @title Downloads forms from KPI
#'
#' @description Returns a dataframe with all the exports available.
Expand All @@ -111,15 +111,15 @@ kobo_all_forms <- function(user,pwd, api = "https://kobo.humanitarianresponse.in
#'
#' @author Elliott Messeiller
#'
#' @export kobo_all_exports
#' @export all_exports
#'


kobo_all_exports <- function(user,pwd="", api="https://kobo.humanitarianresponse.info") {
if(pwd == ""){pwd <- readline("Enter password:")}
all_exports <- function(user,pwd="", api="https://kobo.humanitarianresponse.info") {
if(!exists('pwd') || (pwd == "" || is.null(pwd))){pwd <- readline("Enter password:")}
if(pwd == "") stop("No password entered.")

all_exports <- GET(paste0(api, "/exports/"), authenticate(user, pwd))
all_exports <- GET(paste0(api, "/exports/"), authenticate(user, pwd), progress())
all_expors_text <- content(all_exports, "text", encoding = "UTF-8")
all_exports_text_json <- fromJSON(all_expors_text)

Expand All @@ -132,8 +132,8 @@ kobo_all_exports <- function(user,pwd="", api="https://kobo.humanitarianresponse
return(all_exports_df)
}

#' @name kobo_data
#' @rdname kobo_data
#' @name download_data
#' @rdname download_data
#' @title Download data from the platform
#'
#' @description Download data from the platform.
Expand All @@ -147,35 +147,44 @@ kobo_all_exports <- function(user,pwd="", api="https://kobo.humanitarianresponse
#'
#' @author Elliott Messeiller
#'
#' @export kobo_data
#' @export download_data
#'


kobo_data <- function(formid, user,pwd, api="https://kobo.humanitarianresponse.info", seperator="\\/") {
if(pwd == ""){pwd <- readline("Enter password:")}
download_data <- function(formid, user,pwd, api="https://kobo.humanitarianresponse.info", seperator="\\/") {
if(!exists('pwd') || (pwd == "" || is.null(pwd))){pwd <- readline("Enter password:")}
if(pwd == "") stop("No password entered.")
all_forms <- kobo_all_forms(user, pwd, api)
download_forms_all <- download_forms_all(user, pwd, api)

old_id <- as.character(download_forms_all%>%filter(uid == formid)%>%select(old_id))
old_id <- as.character(download_forms_all[download_forms_all$uid == formid, 'old_id'])

type_api <- api_type(api)
if(type_api == 'humanitarianresponse.info'){
api_old <- gsub("kobo", "kc", api)
}else if(type_api == 'kf.kobotoolbox.org'){
api_old <- gsub("kf", "kc", api)
}else{
stop("API not supported. Please use kf.kobotoolbox.org, or kobo.humanitarianresponse.info API.")
}

old_id <- as.character(all_forms%>%filter(uid == formid)%>%select(old_id))
form <- download_form(formid = formid, user = user, pwd = pwd)

api_old <- gsub("kobo", "kc", api)
url_data <- paste0(api_old, "/api/v1/data/",old_id, ".csv")
raw_data <- GET(url_data, authenticate(user, pwd))
raw_data <- GET(url_data, authenticate(user, pwd), progress())
raw_data <- content(raw_data, "raw", encoding = "UTF-8")
raw_data <- read_csv(raw_data, na = c("", "NA", "n/a"))

raw_data <- kobo_noGroupsHeader(raw_data, formid, pwd, user, api)

raw_data <- kobo_AddstartSelectMultiple(raw_data)
names(raw_data) <- gsub("\\.","\\/", names(raw_data))
raw_data <- remove_GroupeHeaders(raw_data, formid, pwd, user, api)

raw_data <- addStartCols_sm(raw_data, form )

return(raw_data)

}

#' @name kobo_noGroupsHeader
#' @rdname kobo_noGroupsHeader
#' @name remove_GroupeHeaders
#' @rdname remove_GroupeHeaders
#' @title Remove groupes from dataframe header
#'
#' @description Remove groupes from dataframe header
Expand All @@ -189,28 +198,23 @@ kobo_data <- function(formid, user,pwd, api="https://kobo.humanitarianresponse.i
#'
#' @author Elliott Messeiller
#'
#' @export kobo_noGroupsHeader
#'

#' @export remove_GroupeHeaders

kobo_noGroupsHeader <- function(data,formid, pwd, user, api="https://kobo.humanitarianresponse.info", seperator = "\\/") {
remove_GroupeHeaders <- function(data,formid, pwd, user, api="https://kobo.humanitarianresponse.info", seperator = "\\/") {

if(pwd == ""){pwd <- readline("Enter password:")}
if(!exists('pwd') || (pwd == "" || is.null(pwd))){pwd <- readline("Enter password:")}
if(pwd == "") stop("No password entered.")

form <-kobo_form(formid, user , api)
form <-download_form(formid, user, pwd)
survey_sheet <- form$survey
groups <- paste0(as.list(survey_sheet%>%filter(type %in% c("begin_group", "begin group"))%>% select(name))[[1]],seperator)
groups <- c(groups, paste0("meta", seperator))
collapse_groups <- str_c(groups, collapse = "|")
groups_removed <- map(names(data), str_remove, collapse_groups)
names(data) <- groups_removed
return(data)

data <- noGroupsHeader(data, survey_sheet, seperator)

return(data)
}

#' @name kobo_api_type
#' @rdname kobo_api_type
#' @name api_type
#' @rdname api_type
#' @title Check the API type
#'
#' @description Check the API type
Expand All @@ -220,10 +224,10 @@ kobo_noGroupsHeader <- function(data,formid, pwd, user, api="https://kobo.humani
#'
#' @author Elliott Messeiller
#'
#' @export kobo_api_type
#' @export api_type
#'

kobo_api_type <- function(api="https://kobo.humanitarianresponse.info"){
api_type <- function(api="https://kobo.humanitarianresponse.info"){
if(grepl("kf.kobotoolbox.org", api)){
api_type <- "kobotoolbox.org"
}else if(grepl("kobo.humanitarianresponse.info", api)){
Expand All @@ -234,14 +238,14 @@ kobo_api_type <- function(api="https://kobo.humanitarianresponse.info"){

}

#' @name kobo_create_export
#' @rdname kobo_create_export
#' @name create_export
#' @rdname create_export
#' @title Create exports through API
#' @description Create exports (endpoint) through API for specified form. Exports allow to download the data via the new KPI.
#'
#' @param asset_uid UID (ID) of the asset (form) for which an export is created.
#' @param kobo_user Username of the Kobo account to use.
#' @param Kobo_pw Password of the Kobo account to use.
#' @param user Username of the Kobo account to use.
#' @param pw Password of the Kobo account to use.
#' @param type Type of exports to create: can be "csv" or "xls". Defaults to "csv"
#' @param lang Language to be used for the export. Defaults to "xml"
#' @param fields_from_all_versions Include or not all versions of the form. Logical string: "true" or "false". Defaults to "true"
Expand All @@ -251,11 +255,11 @@ kobo_api_type <- function(api="https://kobo.humanitarianresponse.info"){
#'
#' @author Punya Prasad Sapkota (https://github.com/ppsapkota/), Elliott Messeiller
#'
#' @export kobo_create_export
#' @export create_export

kobo_create_export<-function(asset_uid, kobo_user, Kobo_pw ="", api="https://kobo.humanitarianresponse.info", type ="csv",lang="xml",fields_from_all_versions = "true",hierarchy_in_labels ="false",group_sep = "/"){
if(Kobo_pw == ""){Kobo_pw <- readline("Enter password:")}
if(Kobo_pw == "") stop("No password entered.")
create_export<-function(asset_uid, user, pwd ="", api="https://kobo.humanitarianresponse.info", type ="csv",lang="xml",fields_from_all_versions = "true",hierarchy_in_labels ="false",group_sep = "/"){
if(!exists('pwd') || (pwd == "" || is.null(pwd))){pwd <- readline("Enter password:")}
if(pwd == "") stop("No password entered.")


api_url_export<-paste0(api,"/exports/")
Expand All @@ -271,39 +275,8 @@ kobo_create_export<-function(asset_uid, kobo_user, Kobo_pw ="", api="https://kob
#fetch data
result<-httr::POST (url=api_url_export,
body=d,
authenticate(kobo_user,Kobo_pw),
authenticate(user,pw),
progress()
)
return(result$status_code)
}

#' @name kobo_AddstartCol_SelectMultiple
#' @rdname kobo_AddstartCol_SelectMultiple
#' @title Adds a list column with the choices selected at the beggining of select_multiple questions
#' @description Adds a list column with the choices selected at the beggining of select_multiple questions
#' @param data The dataframe to be treated.
#' @param form A list with two objects: The "survey" sheet as a dataframe with all the questions variables, and the "choices" sheet as a dataframe with all the choices variables. See kobo_form()
#' @param seperator Separator used between select_multiple questions and their choices. Must be a regex expression. Default to forward slash
#' @return Returns data with the additional columns
#' @author Elliott Messeiller
#'
#' @export kobo_AddstartCol_SelectMultiple
kobo_AddstartCol_SelectMultiple<- function(data, form, seperator = "\\/"){
survey <- form$survey
all_selectMultiple <- survey[survey$type == "select_multiple", "name"]

if(length(all_selectMultiple)==0){warning(paste0("No select_multiple question found with. Please double check that you have select_multiple qustions in your form."))}

expr_firstCol <- paste0(all_selectMultiple, seperator, ".*?$")

indices <- map(expr_firstcol, grep, names(data))
min_indices <- map_dbl(indices, min)
new_data <- map2(min_indices, all_selectMultiple, ~ add_column(data, .y = NA, .before = .x))
return(new_data)
}


nullToNA <- function(x) {
x[sapply(x, is.null)] <- NA
return(x)
}
Loading

0 comments on commit 5f5dd17

Please sign in to comment.