R/tools.R

In DarkerThanEver/personalR: personalR

#' local helper function to determine if object == whichClass or a descendant
#'  of whichClass.
#'
#' @param object a data object of some class
#' @param whichClass character string: class name to be tested
#' @return TRUE or FALSE
#' @export
isClass <- function(object, whichClass){
  return(whichClass %in% class(object))
}


#' ifelse replacement for properly returning all datatypes.
#'
#' @param logicValue variable or expression resulting in TRUE or FALSE,
#'  if missing or not logical then the function will return NULL.
#' @param ifTrue variable or expression to be returned when logicValue == TRUE
#' @param ifFalse variable or expression to be returned when logicValue == FALSE
#'
#' @returns depending on logicValue, ifTrue ir ifFalse.
#' @note not vectorized
#' @export
ifelseProper <- function(logicValue = NULL, ifTrue = NULL, ifFalse = NULL){
  if (missing(logicValue)){
    return(NULL)
  } else {
    if (!is.logical(logicValue)){
      return(NULL)
    } else {
      if (logicValue){
        return(ifTrue)
      } else {
        return(ifFalse)
      }
    }
  }
}

#' programming tool to convert a vector in memory to code for inclusion
#'  into programs.
#'
#' @param vectorData can be vector of class character, integer, logical,
#'  numeric, etc. Note that custom data types may not work properly.
#' @param includeParenthesis boolean parameter defining if 'c()' should be
#'  included around the character vector returned.
#' @param trim if NA (default) nothing is done, else should be value "both",
#'  "left" or "right". It will then cause all vectors to be white space trimmed
#'  on the specified site. See ?stringr::str_trim for more details. Note that
#'  trimming is done after formatting, so may undo settings like wide = x'
#' @param ... is used to transfer settings to the base format() function. See
#'  ?format for more info
#'
#' @returns a character vector.
#' @export
vectorToCode <- function(vectorData, includeParenthesis = TRUE, trim = NA, ...){
  return(
    ifelse(class(vectorData) == "character",
            paste(c(ifelse(includeParenthesis,
                           "c(",
                           ""),
                    "'",
                    ifelse(identical(trim,NA),
                           paste(format(vectorData, ...), collapse = "','"),
                           paste(stringr::str_trim(format(vectorData, ...),
                                                   side = trim),
                                 collapse = "','")),
                    "'",
                    ifelse(includeParenthesis,
                                   ")",
                                   "")),
                  collapse = ""),
            paste(c(ifelse(includeParenthesis,
                           "c(",
                           ""),
                    ifelse(identical(trim,NA),
                           paste(format(vectorData, ...), collapse = ","),
                           paste(stringr::str_trim(format(vectorData, ...),
                                          side = trim),
                                 collapse = ",")),
                    ifelse(includeParenthesis,
                           ")",
                           "")),
                  collapse = ""))
  )
}

#' programming tool to convert a data.frame in memory to a character vector
#'  representing code for inclusion into programs.
#'
#' @param dataframe data.frame to be converted to code. Can be with and without
#'  data.
#' @param differentLines parameter that allows inclusion of new line and tab
#'  'characters' in the produced character vector. The intended effect is not
#'   seen when printing 'normally', use cat() for this.
#' @param includeData default is TRUE, it will then include the data itself in
#'  the produced character string. If FALSE, then it will not.
#' @param trim if NA (default) nothing is done, else should be value "both",
#'  "left" or "right". It will then cause all vectors to be white space trimmed
#'  on the specified site. See ?stringr::str_trim for more details. Note that
#'  trimming is done after formatting, so may undo settings like wide = x'
#' @param ... is used to transfer settings to the base format() function. See
#'  ?format for more info. Note that these settings are applied to all
#'  vector types!
#'
#' @returns a character vector.
#' @export
dataFrameToCode <- function(dataframe,
                            differentLines = "\n\t",
                            includeData = TRUE,
                            trim = NA,
                            ...){
  classes <- lapply(dataframe, class)
  if (!includeData){
    resultCode <- paste(
      c("data.frame(",
        paste(c(purrr::map2_chr(names(classes),
                                unname(classes),
                                ~paste(c(.x," = ",.y,"()"),collapse = ""))),
              collapse = paste(", ",differentLines, sep = "")),
        ")"),
      collapse = "")
  } else {
    resultCode <- "data.frame("
    for (counter in 1:ncol(dataframe)){
      resultCode <- paste(c(resultCode,
                            colnames(dataframe)[counter],
                            " = c(",
                            vectorToCode(dataframe[,counter],
                                         includeParenthesis = TRUE,
                                         trim = trim,
                                         ...),
                            ifelse(counter != ncol(dataframe),
                                   paste("), ", differentLines, sep = ""),
                                   ")"))
                          ,collapse = "")
    }
    resultCode <- paste(c(resultCode,")"), collapse = "")
  }
  return(resultCode)
}