R/FrequenciesToR.r

In lebebr01/SPSStoR: Convert SPSS Syntax to R Syntax

#' Frequencies to R
#' 
#' Convert SPSS frequencies command to R syntax.
#' 
#' @param x SPSS syntax - read in by SPSStoR function
#' @param dplyr A value of TRUE uses dplyr syntax (default), 
#'              a value of FALSE uses data.table syntax
#' @param ... Additional arguments passed to function, not currently supported.
#' @export
frequencies_to_r <- function(x, dplyr = TRUE, ...) {
  
  varsLoc <- grep("variables\\s?=", x, ignore.case = TRUE)
  vars <- substr(x[varsLoc], (which(strsplit(x[varsLoc], '')[[1]]=='=')+1), nchar(x[varsLoc]))
  freqVars <- unlist(strsplit(gsub("^\\s+|\\s+$", "", vars), " "))
  
  #orderLoc <- grep("order\\s?=", x, ignore.case = TRUE)
  
  if(any(grepl("format\\s?=\\s?notable", x, ignore.case = TRUE))){
    freqOut <- ""
  } else { 
    freqOut <- sapply(1:length(freqVars), function(ii) 
      paste("with(x, table(", freqVars[ii], "))", sep = '')) 
  }
  
  if(any(grepl("^\\/stat", x, ignore.case = TRUE))){
    statOut <- descriptives_to_r(x)
  } else { statOut <- "" }
  
  if(any(grepl("^\\/ntiles\\s?=", x, ignore.case = TRUE))){
    ntileLoc <- grep("^\\/ntiles\\s?=", x, ignore.case = TRUE)
    numBreak <- sapply(1:length(ntileLoc), function(ii) 
      as.numeric(substr(x[ntileLoc[ii]], (which(strsplit(x[ntileLoc[ii]], '')[[1]]=='=')+1), 
                                  nchar(x[ntileLoc[ii]]))))
    ntilesOut <- sapply(1:length(ntileLoc), function(ii) 
      paste("quantile(x, probs = seq(0, 1, 1/", numBreak[ii], "), type = 6)", sep = ''))
  } else { ntilesOut <- "" }
  
  if(any(grepl("^\\/percentiles\\s?=", x, ignore.case = TRUE))){
    perLoc <- grep("^\\/percentiles\\s?=", x, ignore.case = TRUE)
    nums <- substr(x[perLoc], (which(strsplit(x[perLoc], '')[[1]]=='=')+1), nchar(x[perLoc]))
    probNum <- paste(unlist(strsplit(gsub("^\\s+|\\s+$", "", nums), " ")), collapse = ", ")
    percentileOut <- paste("quantile(x, probs = c(", probNum, "), type = 6)", sep = '') 
  } else { percentileOut <- "" }
  
  if(any(grepl("^\\/pie", x, ignore.case = TRUE))){
    pieG <- sapply(1:length(freqVars), function(ii) 
      paste("ggplot(x, aes(x = factor(1), fill = ", freqVars[ii], ")) + geom_bar() + coord_polar(theta = 'y')", sep = ""))
  } else { pieG <- "" }
  
  if(any(grepl("^\\/bar", x, ignore.case = TRUE))){
    barG <- sapply(1:length(freqVars), function(ii) 
      paste("ggplot(x, aes(x = factor(1), fill = ", freqVars[ii], ")) + geom_bar()", sep = ''))
  } else { barG <- ""}
  
  if(any(grepl("^\\/hist", x, ignore.case = TRUE))){
    histogramG <- sapply(1:length(freqVars), function(ii) 
      paste("ggplot(x, aes(x = factor(1), fill = ", freqVars[ii], ")) + geom_histogram()", sep = ''))
  } else { histogramG <- "" }
  
  missingOut <- sapply(1:length(freqVars), function(ii) 
    paste("with(x, table(is.na(", freqVars[ii], ")))", sep = ''))
  
  finMat <- c(missingOut, freqOut, statOut, ntilesOut, percentileOut, pieG, barG, histogramG)
  finMat <- subset(finMat, grepl(".+", finMat) == TRUE)
  
  finMat  
}