jasdumas / dumas

The Personal R Package of Jasmine Dumas :package:

👋 Hi, I'm Jasmine

Principal Consultant & Founder of Daly Analytics

dumas's Issues

Better open.this()?

open.this <- function (x) {
  stopifnot(is.data.frame(x) || is.matrix(x))
  file <- tempfile(fileext=".csv")
  write.csv(x, file=file, row.names=TRUE)
  on.exit(file.remove(file))
  system(command=paste("open", shQuote(file)))
  readline("press enter to continue...")
  invisible(NULL)
}

Function to add: compare_before_after()

#' Generate side-by-side histograms
#'
#' @param data_before a data.frame object of class numeric
#' @param data_after a data.frame object of class numeric
#' @param cols column names of the numeric parameter
#' @param filename default is getwd()
#' @param ... 
#'
#' @return
#' @export
#'
#' @examples
compare_before_after <- function(data_before, data_after, cols, filename = getwd(),...){
  # only create histograms of numeric value
  #data_before = data_before[, sapply(data_before, is.numeric)]
  #data_after = data_after[, sapply(data_after, is.numeric)]

  filename = paste0(filename, "/",  "compareplots.pdf", collapse = "/")

  if (file.exists(filename))  file.remove(filename)
  pdf(filename,width=14, onefile = TRUE)
  # set up color range based on how many columns / plots needed
  cl <- rainbow(length(cols))
  # initialize the color
  count = 1
  for (i in cols) {
    # ploting function goes here

     # make two plots side by side
    par(mfrow = c(1, 2))

    hist(data_before[, i], col = cl[count], main = paste0(i))

    hist(data_after[, i], col = cl[count], main = paste0(i))
    # advance the color count
    count = count + 1
  }


  if (sessionInfo()$ R.version$os == "mingw32") {
    cat("Viewing file...\n")

    cmd = "open compareplots.pdf"
    system(cmd)

    } else {
    cat("Check your working directory for the pdf file.")
    }

  dev.off()
  return()
  dev.off()

}

layout

Why not have "pkg" directory?

• Move R, man, tests, DESCRIPTION, NAMESPACE, LICENSE under it

Afterwards R package would be isolated from GitHub-related stuff.

super lazy functions to add

# # # # # # # # # # # # # # # # # #
#  Super lazy Function abbreviations
# # # # # # # # # # # # # # # # # #

# remove everything in your Global Environment except the function that does it
rm_ <- function(pattern = "rm_") {
  # http://stackoverflow.com/questions/4837477/remove-objects-in-globalenv-from-within-a-function
  objs <- ls(pos = ".GlobalEnv")
  # remove everything but this function
  rm(list = objs[-which(objs == pattern)], pos = ".GlobalEnv")
}

# opposite of %in% 
`%notin%` <- function (x, table) !match(x, table, nomatch = 0L) > 0L

# sometimes i leave the y off when typing this particular function
summar <- function(x) summary(x)

# type less words to create data frames
adf <- function(x) as.data.frame(x)

# make a code block like above
# example:: code_block2("Hello World!")
code_block2 <- function (text) {
  l = nchar(text)
  l = ifelse(l > 22, 20, l)

  cat(replicate(l, "#"), "\n", "# ",
      text, "\n", replicate(l, "#"))
}

Function to add: all_na()

# http://stackoverflow.com/a/11330265/4143444
all_na <-  function (x) {
  w <- sapply(x, function(x)all(is.na(x)))
  if (any(w)) {
    paste("All NA in columns", paste(which(w), collapse=", "))
  } else {
    paste0("There is no column with all NA")
  }
}

Function to add: same_same()

#' Find columns that are duplicates in a data frame
#'
#' @param df a object of class data.frame
#' @param message a object of class logical indicating to display a helper message
#'
#' @return return the data frame without duplicates
#'
#' @seealso \href{http://stackoverflow.com/questions/9818125/identifying-duplicate-columns-in-an-r-data-frame}{Stack Overflow Question}
#' @importFrom dplyr tbl_df
#' @examples a = data.frame(x=letters[1:5], y=letters[1:5], z=letters[6:10])
#' same_same(a)
#' @export
same_same <- function(df, message=TRUE){

 dups  = colnames(df[duplicated(as.list(df))])

 if(message){
   cat("The duplicate", length(dups) , "column(s) were: ", c(dups), "\n" )
 }

 if(nrow(df) < 500 & ncol(df) < 25) {
   # return a small data frame without duplicate columns
   return(df[!duplicated(as.list(df))])
  } else {
   # return a large data frame without duplicate columns
   #tbl_df for printing purposes
   return(tbl_df(df[!duplicated(as.list(df))]))
  }

}

Function to add: convert_factor_to_chr()

#' Convert factors to character
#'
#' @param df a object of class data.frame with a factor need for conversion to character
#' @param ... optional arguements
#'
#' @return a object of class data.frame
#'
#' @source \url{http://stackoverflow.com/a/2853231}
#' @examples iris2 <- convert_factor_to_chr(iris)
#' @export
convert_factor_to_chr <- function(df, ...) {
  # locate the logical position in the data.frame where the class is factor
  i <- sapply(df, is.factor)
  # apply through the list of factors to character class
  df[i] <- lapply(df[i], as.character)
  # return the new data frame
  return(df)
}

Function to add: missing_to_zero()

#'  Transform Missing NA values to Zeros
#'
#' @param df a data frame or indicated column of the data frame (named list)
#' @param ... a character vector optionally supplied as a c(...) vector
#' @source \url{http://stackoverflow.com/questions/2641653/pass-a-data-frame-column-name-to-a-function}
#' @return returns the column of interest with transformed missing NA values to 0
#'
#'
#' @examples
#' df = data.frame("x" = 1:3, "missings" = rep(NA, 3))
#' df$missings <- missing_to_zero(df, "missings")
#' @importFrom utils head
#' @export
missing_to_zero <- function(df, ...) {
  col = c(...)
  df[[col]][is.na(df[[col]])] <- 0

  cat("Confirming transformation...", head(df[[col]]))
  return(df[[col]])
}

Function to add: sanity_check()

#' Check your sanity and the length or rows for equality
#' @description After creating train and test datasets in ML, check to make
#'  sure that the correponsing weights, or response vectors are the same
#'  amount of observations as the dataset.
#' @param check1 a object of class data.frame, character, or numeric
#' @param check2 a object of class data.frame, character, or numeric
#' @param ... optional arguements passed through (TBD)
#'
#' @return a string indicating the success of the comparison or
#'  failure of equality of observations form both input objects
#' @export
#' 
#' @examples sanity_check(iris, iris)
#' sanity_check(iris, cars)
sanity_check <- function(check1, check2, ...){
  to_check = c(...)
  # compare two arguements are data frames
  if(is.data.frame(check1) & is.data.frame(check2)){

    if (nrow(check1) == nrow(check2)) {
      print("Good: Same number of rows.")
    } else{
      print("Bad: Not the same number of rows.")
    }
  # if the two arguements are character vectors  
  } else if (is.character(check1) & is.character(check2)){

    if (length(check1) == length(check2)) {
      print("Good: Same number of rows.")
    } else{
      print("Bad: Not the same number of rows.")
    }
  #  if there are mixed df and vector
  } else if (is.data.frame(check1) & is.character(check2)){

    if (nrow(check1) == length(check2)) {
      print("Good: Same number of rows.")
    } else{
      print("Bad: Not the same number of rows.")
    }
  #  if there are mixed df and vector
  } else if (is.data.frame(check2) & is.character(check1)) {

    if (nrow(check2) == length(check1)) {
      print("Good: Same number of rows.")
    } else{
      print("Bad: Not the same number of rows.")
    }

    # if the two arguements are numeric vectors  
  } else if (is.numeric(check1) & is.numeric(check2)){

    if (length(check1) == length(check2)) {
      print("Good: Same number of rows.")
    } else{
      print("Bad: Not the same number of rows.")
    }
    #  if there are mixed df and vector
  } else if (is.data.frame(check1) & is.numeric(check2)){

    if (nrow(check1) == length(check2)) {
      print("Good: Same number of rows.")
    } else{
      print("Bad: Not the same number of rows.")
    }
    #  if there are mixed df and vector
  } else if (is.data.frame(check2) & is.numeric(check1)) {

    if (nrow(check2) == length(check1)) {
      print("Good: Same number of rows.")
    } else{
      print("Bad: Not the same number of rows.")
    }

  } 

}

Function to add: has_negative()

#' Find All of the Negative Values a Data frame Has
#'
#' @param df a object of class data.frame
#'
#' @return a character string indicating how many and 
#'     what position the negative value are and if the object gets a name
#'     the position values are saved for further use.
#' @export
#'
#' @examples df = data.frame(x = rnorm(10), y = rnorm(10))
#' has_negative(df)
has_negative <- function(df) {
  # get logical values for any value below zero
  is_negative = apply(df, c(1, 2), function(row) any(row < 0))

  if (sum(c) == 0) {
    cat("There is no negative values in this dataset.")
  } else {
    cat("There are", sum(c), "negative values in this dataset.\n", 
        "Positioned at:", c(which(c)), ".")

  }
  return(c(which(c)))
}