R/generateVisuals.R

In edixon1/spryngr: A Toolset for Data Generated within Spryng.io Sensors

#' @slot type character String containing one of the following:
#'  "Marble","Slider","MCQ","MCQ_Checkbox","Triangle","FreeText"
#'
#' @slot title character String containing the questions title
#' @slot labels one or more Strings containing the question labels
#' @slot data data.frame containing the spryng output data associated with this question
#'
#' @export
setClass("Question", representation(type="character", title="character", labels="character", data="data.frame"))

#' Generates a list of S4 Question objects for each question within label file
#'
#' @param outputFolder String containing path to folder generated by call to generateLabelFile()
#'
#' @return A list containing four sublists titled
#' @export
#'
generateQuestionObjects <- function(outputFolder){
  setOutPath(outputFolder)
  labelFile <- paste0(outputFolder, "/", "Question_Labels.xlsx")
  pathFile <- paste0(outputFolder, "/", "Data_Path.txt")
  visualizationFolder <- paste0(outputFolder, "/", "Visualizations")

# #TODO: displayInfo
#   displayInfo <- TRUE

  #read in data
  rawData <- read.csv(readLines(pathFile), check.names = FALSE)
  answers <- rawData[,15:length(rawData)]

  qTypes <- c("Marble","Slider","MCQ","Triangle","FreeText")

  qObjects <- list()

  #Establish what question types are in label file
  sheetNames <- loadWorkbook(labelFile) %>%
    getSheets() %>%
    names()
  qTypes <- intersect(sheetNames,qTypes)

  #Read label file in and instantiate question objects
  for(type in qTypes){
    qCategory <- read.xlsx(labelFile, sheetName = type)
    for(i in 1:NROW(qCategory)){
      thisQuestion <- qCategory[i,]
      labels <- strsplit(thisQuestion$labels," _ ") %>%
        unlist() %>%
        trimws()
      title <- labels[1]
      labels <- labels[2:length(labels)]
      thisQOb <- new("Question", type=type, labels=labels, title=title,
                     data=data.frame(answers[thisQuestion$startColIndex:thisQuestion$endColIndex],
                                     check.names=FALSE, fix.empty.names=FALSE))
      if(type == "Slider"){
        if(thisQuestion$lowerLimit != 0 | thisQuestion$upperLimit != 1){
          thisQOb <- normalizeSlider(thisQOb, thisQuestion$lowerLimit, thisQuestion$upperLimit)
        }
      }
      qObjects[[type]] <- append(qObjects[[type]], thisQOb)

    }
  }



  for(i in 1:length(qObjects$MCQ)){
    if(isCheckboxMcq(qObjects$MCQ[[i]])){
      qObjects$MCQ[[i]]<- collapseMcq(qObjects$MCQ[[i]])
    }

  }




  return(qObjects)
}


#-----------------------Plot All Functions----------------------


#' Generate a violin plot for each combination of Marble and MCQ Question object
#'
#' @param marbles List of Question objects of type Marble
#' @param factors List of Question objects of type MCQ or MCQ_Checkbox
#' @param save Logical indicating whether to save produced plots in output folder
#'
#' @return a list of ggplot objects
#' @export
#'
plotAllMarbles <- function(marbles, factors, save=FALSE){
  marbles <- prepMarbles(marbles)
  plots <- list()
  i <- 1
  for(marble in marbles){
    for(factor in factors){
      #plotInfo: type, cInd, fInd, varInd, axis

      #plotInfo <- list(type="Marble", cInd=, fInd)


      if(factor@type == "MCQ_Checkbox"){
        thisPlot <- getPlotDataCheckbox(marble, factor)
      }else{
        thisPlot <- getPlotDataRadio(marble, factor)
      }
      plots[[i]] <- thisPlot
      i = i+1
    }
  }
  if(save){
    savePlots(plots, "marble", paste0(pkgGlobals$outPath, "/Visualizations/Marbles"))
  }

  return(plots)
}




#' Generate a violin plot for each combination of Slider and MCQ Question object
#'
#' @param dyads A list of Question objects of type Slider
#' @param factors a list of Question Objects of type MCQ or MCQ_Checkbox
#' @param save Logical indicating whether to save produced plots in output folder
#'
#' @return a list of ggplot objects
#' @export
#'
plotAllDyads <- function(dyads, factors, save=FALSE){
  plots <- list()
  i = 1
  for(dyad in dyads){
    for(factor in factors){
      if(factor@type == "MCQ_Checkbox"){
        thisPlot <- getPlotDataCheckbox(dyad, factor)
      }else{
        thisPlot <- getPlotDataRadio(dyad, factor)
      }
      plots[[i]] <- thisPlot
      i = i+1
    }
  }

  if(save){
    savePlots(plots, "slider", paste0(pkgGlobals$outPath, "/Visualizations/Sliders"))
  }

  return(plots)
}


#' Generate a violin plot for each combination of Triangle and MCQ Question object
#'
#' @param ternaries List of Question objects of type Triangle
#' @param factors List of Question objects of type MCQ or MCQ_Checkbox
#' @param save Logical indicating whether to save produced plots in output folder
#'
#' @return a list of ggplot objects
#' @export
#'
plotAllTernaries <- function(ternaries, factors, save=FALSE){
  ternaries <- prepTernaries(ternaries)
  i <- 1
  plots <- c()
  for(ternary in ternaries){
    for(factor in factors){
      if(factor@type == "MCQ_Checkbox"){
        thisPlot <- getPlotDataCheckbox(ternary, factor)
      }else {
        thisPlot <- getPlotDataRadio(ternary, factor)
      }
      plots[[i]] <- thisPlot
      i = i + 1
    }
  }

  if(save){
    savePlots(plots, "triangle", paste0(pkgGlobals$outPath, "/Visualizations/Triangles"))
  }

  return(plots)
}


#'Function which plots single dyad vs single factor which allows specification of labels and titles

#'Any labels left blank will be gathered from the generated labels document

#-----------------------Plot Functions--------------------------


#' Plot single dyad vs single factor with specification of labels and tites
#'
#' @param dyad: Question object of type Slider
#' @param factor: Question object of type MCQ or MCQ_Checkbox
#' @param title: String containing the title for the generated plot (optional)
#' @param ylab: String containing the Y label for the generated plot (optional)
#' @param xlab: Vector containing 2 Strings to label the x axis in the negative and positive direction respectively (optional)
#' @param save Logical indicating whether to save produced plots in output folder
#'
#' @return a ggplot object
#' @export
#'
plotDyad <- function(dyad, factor, title=NULL, ylab=NULL, xlab=NULL,
                     save=FALSE){
  plot <- NULL

  if(!is.null(title)){
    dyad@title <- title
  }
  if(!is.null(ylab)){
    factor@title <- ylab
  }
  if(!is.null(xlab)){
    dyad@labels <- xlab
  }

  if(factor@type == "MCQ_Checkbox"){
    plot <- getPlotDataCheckbox(dyad, factor)
  }else{
    plot <- getPlotDataRadio(dyad, factor)
  }

  if(save){
    savePlots(plot, "slider", paste0(pkgGlobals$outPath, "/Visualizations/Sliders"))
  }

  return(plot)
}

#'

#
#' Plot single marble vs single factor with specification of sub-marble-index, axis, labels, and titles
#'
#' @param marble: Question object of type Marble
#' @param factor: Question object of type MCQ or MCQ_Checkbox
#' @param varIndex: integer indicating the index of the Marble to be used
#' @param axis: integer equal to 1 or 2 dictating x or y axis respectively
#' @param title: String containing the title for the generated plot (optional)
#' @param ylab: String containing the Y label for the generated plot (optional)
#' @param xlab: Vector containing 2 Strings to label the x axis in the negative and positive direction respectively (optional)
#' @param save Logical indicating whether to save produced plots in output folder
#'
#' @return a ggplot object
#' @export
#'
plotMarble <- function(marble, factor, varIndex, axis, title=NULL,
                       ylab=NULL, xlab=NULL, save=FALSE){
  plot <- NULL
  if(varIndex > NCOL(marble@data)){
    warning("marble index out of bounds")
    return()
  }
  if(axis > 2){
    warning("axis must be equal to 1 (x axis) or 2 (y axis)")
    return()
  }

  if(!is.null(title)){
    marble@title <- title
  }else{
    marble@title <- marble@labels[varIndex]
  }
  if(!is.null(ylab)){
    factor@title <- ylab
  }
  #if specified x axis
  if(axis==1){
    #if xlabel is specied via argument
    if(!is.null(xlab)){
      marble@labels <- xlab
    }else{
      #set marble@labels to labels at corresponding to proper marble index and axis
      marble@labels <- c(marble@labels[(length(marble@labels))-3],
                         marble@labels[(length(marble@labels))-2])
    }

    marble@data <- marble@data[(varIndex + (varIndex - 1))]
  }#if specified y axis
  else if(axis==2){
    #if xlabel is specied via argument
    if(!is.null(xlab)){
      marble@labels <- xlab
    }else{
      #set marble@labels to labels at corresponding to proper marble index and axis
      marble@labels <- c(marble@labels[(length(marble@labels))-1],
                         marble@labels[length(marble@labels)])
    }
    marble@data <- marble@data[(varIndex + varIndex)]

  }
  #generate plot
  if(factor@type == "MCQ_Checkbox"){
    plot <- getPlotDataCheckbox(marble, factor)
  }else {
    plot <- getPlotDataRadio(marble, factor)
  }

  if(save){
    savePlots(plot, "marble", paste0(pkgGlobals$outPath, "/Visualizations/Marbles"))
  }

  return(plot)

}



#' Plot single triangle vs single factor with specification of side, labels, and titles
#'
#' @param ternary: Question object of type Triangle
#' @param factor: Question object of type MCQ or MCQ_Checkbox Question object
#' @param varIndex: int 1-3 indicating which side of the Triangle to use (1=left, 2=bottom, 3=right)
#' @param title: String containing the title for the generated plot (optional)
#' @param ylab: String containing the Y label for the generated plot (optional)
#' @param xlab: Vector containing 2 strings to label the x axis in the negative and positive direction respectively (optional)
#' @param save Logical indicating whether to save produced plots in output folder
#'
#' @return a ggplot object
#' @export
#'
plotTernary <- function(ternary, factor, varIndex, title=NULL,
                        ylab=NULL, xlab=NULL, save=FALSE){
  plot <- NULL
  if(varIndex > 3){
    print("varIndex should be 1-3")
    return()
  }

  #check for specified labels
  if(!is.null(title)){
    ternary@title <- title
  }
  if(!is.null(ylab)){
    factor@title <- ylab
  }
  if(!is.null(xlab)){
    ternary@labels <- xlab
  }else{
    ternary@labels <- c(paste0("- ",ternary@labels[varIndex]),
                        paste0("+ ",ternary@labels[varIndex]))
  }
  ternary@data <- ternary@data[varIndex]/100

  if(factor@type == "MCQ_Checkbox"){
    plot <- getPlotDataCheckbox(ternary, factor)
  }else {
    plot <- getPlotDataRadio(ternary, factor)
  }

  if(save){
    savePlots(plot, "triangle", paste0(pkgGlobals$outPath, "/Visualizations/Triangles"))
  }

  return(plot)
}



#--------------------------------------------------Write Plot Function-------------------------------

#' Function which saves one or more ggplot objects
#'
#' @param plots a ggplot object or list of ggplot objects
#' @param path a string containing a location to save the plots.  If left blank a location may be selected via a windows file explorer dialogue box
#' @param names a vector of strings the same length as the list of plots.  If left blank random names will be generated
#'
#' @return
#' @export
#'
writePlots <- function(plots, path=NULL, names=NULL, width=NA, height=NA){
  if(is.null(path)){
    path <- choose.dir()
  }

  if(!is.null(names)){
    filesAtPath <- list.files(path) %>%
      str_remove(".png")
    overlap <- names %in% filesAtPath

    if(TRUE %in% overlap){
      warning(sprintf("Files with the name(s): %s already exist in this location",
                      paste(names[overlap], collapse=", ")))
      return()
    }
  }

  #if plots = a single ggplot object
  if(class(plots)[1] == "gg"){
    if(is.null(names)){
      names <- paste0("spryngr_plot_", randString())
    }
    else if(length(names) != 1){
      warning("names vector must be same length as plots argument")
      return()
    }
    ggsave(paste0(path, "/", names, ".png"), plots, width=width, height=heigth)
  }

  #if plots = a list of ggplot objects
  else if(class(plots) == "list"){
    if(is.null(names)){
      names <- replicate(length(plots), randString()) %>%
      lapply(function(x){
        paste0("spryngr_plot_", x)
      }) %>%
        unlist()
    }
    else if(length(names) != length(plots)){
      warning("names vector must be same length as plots argument")
      return()
    }
    for(i in 1:length(plots)){
      ggsave(paste0(path, "/", names[i], ".png"), plots[[i]], width=width, height=height)
    }
  }

}