R/kobo_Qtypes.R

In ElliottMess/koboloadeRlight: Data crunching light for kobo forms

#' @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)
}