#' @name is_selectmultiple
#' @rdname is_selectmultiple
#' @title Check that question is select_multiple as definied by XLSform
#' @param df The dataframe object to be processed
#' @param column Column/question name to be checked, as string
#' @return TRUE is question validates, FALSE otherwise
#'
#' @export is_selectmultiple
is_selectmultiple <- function(df, column){
df <- as.data.frame(df)
col_index <- match(column, names(df))
if(is.na(col_index)){stop("Column not in df. Check spelling")}
if(col_index < ncol(df)){
if(grepl("\\/", names(df)[col_index+1]) && grepl(names(df)[col_index], names(df)[col_index+1])&&
(sum(as.numeric(df[,col_index+1]), na.rm = TRUE)/nrow(df)<=1)){
return(TRUE)
} else{return(FALSE)}
}else{
return(FALSE)
}
}
#' @name is_selectmultiple_choices
#' @rdname is_selectmultiple_choices
#' @title Check that question is is_selectmultiple_choices as definied by XLSform
#' @param df The dataframe object to be processed
#' @param column Column/question name to be checked, as string
#' @return TRUE is question validates, FALSE otherwise
#'
#' @author Elliott Messeiller
#'#'
#' @export is_selectmultiple_choices
is_selectmultiple_choices <- function(df, column){
df <- as.data.frame(df)
col_index <- match(column, names(df))
if(is.na(col_index)){stop("Column not in df. Check spelling")}
if(grepl("\\/", names(df)[col_index]) && sum(grepl(paste0("^",strsplit(column, "\\/")[[1]][1], "$"), names(df)))==1&&
(sum(as.numeric(df[,col_index]), na.rm = TRUE)/nrow(df)<=1)){
return(TRUE)
}else{return(FALSE)}
}
#' @name is_selectone
#' @rdname is_selectone
#' @title Check that question is is_selectone as definied by XLSform
#' @param df The dataframe object to be processed
#' @param column Column/question name to be checked, as string
#' @return TRUE is question validates, FALSE otherwise
#'
#' @author Elliott Messeiller
#'#'
#' @export is_selectone
is_selectone <- function(df, column, num_fact = 100){
df <- as.data.frame(df)
col_index <- match(column, names(df))
if(is.na(col_index)){stop("Column not in df. Check spelling")}
if(is_selectmultiple(df, column)== FALSE){
if(class(df[,col_index][[1]][[1]])=="character"){
if(as.integer(nlevels(as.factor(df[,col_index]))) < num_fact){
return(TRUE)
}else{
return(FALSE)
}
}else{return(FALSE)}
}else{return(FALSE)}
}
#' @name is_decimal
#' @rdname is_decimal
#' @title Check that question is decimal as definied by XLSform
#' @param df The dataframe object to be processed
#' @param column Column/question name to be checked, as string
#' @return TRUE is question validates, FALSE otherwise
#'
#' @author Elliott Messeiller
#'#'
#' @export is_decimal
is_decimal <- function(df, column){
col_index <- match(column, names(df))
if(is.na(col_index)){stop("Column not in df. Check spelling")}
if(is_selectmultiple_choices(df, column)!= TRUE){
if(sum(is.na(as.numeric(as.character(df[,col_index][[1]])))) <= nrow(df)*0.999){
return(TRUE)
}else{return(FALSE)}
}else{return(FALSE)}
}
#' @name col_type
#' @rdname col_type
#' @title Check the type of question
#' @param df The dataframe object to be processed
#' @param column Column/question name to be checked, as string
#' @return "select_one", "select_multiple" or "decimal" depending on the type of question.
#'
#' @author Elliott Messeiller
#'#'
#' @export col_type
col_type <- function(df, column, num_fact = 100){
if(is_selectone(df, column, num_fact) == TRUE){
return("select_one")
}else if(is_selectmultiple(df, column)== TRUE){
return("select_multiple")
}else if(is_decimal(df, column)==TRUE){
return("decimal")
}else if(is_selectmultiple_choices(df, column) == TRUE){
return("choice")
}else{return("text")}
}
#' @name kobo_splitNames
#' @rdname kobo_splitNames
#' @title Rename data frame to delete group deliminators.
#' @param data The dataframe object to be processed
#' @param grpSbl The group deliminator written in [regex]
#' @return data frame with new names.
#' @author Elliott Messeiller
#' @export kobo_splitNames
kobo_splitNames <- function(data, grpSbl){
if(class(data) != "data.frame"){stop("data is not a dataframe, please input a dataframe, or an object that can be cohorsed to one.")}
names_data <- data.frame(name = names(data), stringsAsFactors = FALSE)
names_data_splitted <- as.data.frame(sapply(names_data, str_split, grpSbl))
grpSbl_max <- max(str_count(names_data$name, pattern = grpSbl))
splitted <- as.data.frame(str_split_fixed(names_data$name, pattern = grpSbl, n = grpSbl_max + 1), stringsAsFactors = FALSE)
# apply(data, 1, function(x, grpSbl_max) ifelse(sum(is.na(x)) == grpSbl_max, "", tail(na.omit(x), 1)))
result <- NA
for(i in 1:nrow(splitted)){
for(j in 1:ncol(splitted)){
if(splitted[i,j] != ""){
if(j < (grpSbl_max + 1)){
if(splitted[i, j +1] == ""){
result[i] <- splitted[i,j]
}
} else{
if(splitted[i,j] != ""){
result[i] <- splitted[i,j]
}
}
}
}
}
names(data) <- result
return(data)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.