R/general_purpose.R

In BillyEhrenberg/FTutilityfuncs:

#' A function written to be called in ungroup_all_dfs
#'
#' Collapses array into character string
#' @param df_name the name of the data.frame as a character string
#' @examples
#' ungroup_df()

ungroup_df <- function(df_name){

  get(df_name, envir = .GlobalEnv) %>%
    dplyr::ungroup %>%
    assign(df_name,., envir = .GlobalEnv)

}

#' A function  to ungroup_all_dfs in the global env
#'
#' uses ls to list all variables, then ungroups those that are data.frames
#' @examples
#' ungroup_all_dfs()

ungroup_all_dfs <- function(){

  data.frames.names <- Filter(function(x) is(x, "data.frame"),
                              mget(ls(envir = .GlobalEnv), envir = .GlobalEnv)) %>%
    names %>%
    purrr::map(ungroup_df)

}


#' A function to check if you have the latest R version installed
#'
#' Checks your current R version against the most up to date version from cran.
#' @export
#' @examples
#' checkRVersion()
#'
checkRVersion <- function(){

  current_version <- (version$major) %>% paste(version$minor,sep='.')

  url <- 'https://cran.r-project.org/bin/macosx/'

  page <- xml2::read_html(url)

  version_node <- page %>%
    rvest::html_nodes('body > table:nth-child(9) > tr > td > a') %>% .[1]


  version_url <- rvest::html_attr(version_node,'href') %>%
    paste0('https://cran.r-project.org/bin/macosx/',.)


  latest_version <- version_node %>%
    rvest::html_text(.) %>%
    stringr::str_remove_all('R-|\\.pkg')

  if(current_version == latest_version){
    print("You're up to date! Cran-tastic.")
  } else {
    warning(paste0('Please update R to version ', latest_version,'. You can find the files at ',
                   url, ' or you can download ',latest_version, ' directly from ', version_url, '.'))
  }

}


#' A shortcut to save the last value as avariable
#'
#' returns the last value, a wrapper around .Last.value
#' @export
#' @examples
#' lv()
#'

lv <- function(){

  .Last.value

}


df2clipboard <- function(df){
  print(df)
  write.table(df, sep="\t",pipe('pbcopy'), row.names =F)
}

#' Read a table from the clipboard into R
#'
#' Uses pbpaste so to read values from clipboard. Won't work in windows
#' @param header does your table have headers? Defaults to F
#' @param sep how are the values separated? Defaults to tab
#' @param csvName if given a csv will be written to this path
#' @export
#' @examples
#' readClipboard()
#'
readClipboard <- function(header=F,sep="\t",csvName = NULL){

  temp <- read.table(pipe("pbpaste"), sep=sep, header=header)

  if(!is.null(csvName)){
    readr::write_csv(temp,csvName)
  }

  return(temp)
}


#' List all the files in a folder and return their paths
#'
#' Use list.files to list all the files in a folder and paste the paths to them
#' @param dir where to look to list the files defaults to NULL (basically just runs list.files() unless given a folder)
#' @export
#' @examples
#' list_files()
#'

list_files <- function(dir = NULL){
  if(!is.null(dir)){
  list.files(dir) %>%
    paste0(dir,'/',.)
  } else {
    list.files()
  }
}

#' View a df and return it - you can view a df halfway through a chain
#'
#' Allows you to view a df halfway through a chain
#' @export
#' @examples
#' view()
#'

view <- function(df){
  View(df)
  return(df)
}


#' Return the unique values from a column of a data.frame
#'
#' Turns a data frame column into a vector and removes duplicate values
#' @param df a data.frame
#' @param ... an unquoted column name
#' @export
#' @examples
#' pu()
#'
pu <- function(df,...){

  df %>%
    dplyr::pull(...) %>%
    unique
}

#' call a function on an object and, if it errors, return the object
#'
#' Allows you to call a function on an  object and get a result even if it errors. Use with purrr::map()
#' @param obj an object
#' @param f a function
#' @export
#' @examples
#' seguramente()
#'
seguramente <- function(obj,f){
  sf <- purrr::safely(f,otherwise = NA)
  output <- sf(obj)
  result <- output$result

  if(is.na(result)){
    print(output$error)
    return(obj)
  } else {
    return(result)
  }
}

#' Round a number to its nearest integer
#'
#'  - n.5 will always round up, unlike with round
#' @param val an numeric value
#' @export
#' @examples
#' Round()
#'
Round <- function(val){
  if_else(val %% 1 == .5, ceiling(val), round(val))
}