deprecated/deprecated.R

#' upload_file
#'
#' @param file string that identify the path and file to upload
#' @param name string The filename. Default to \code{basename(file)}
#' @param path string the google drive path as root/../folder
#' @param public logical that indicate if sharing the file to anyone
#'
#' @return the web link to the file using the \code{drv.tw} service
#' @export
#'
upload_file <- function(file, name = basename(file), path = "", public = TRUE){

  upfile <- googledrive::drive_upload(media = file,
                                      overwrite = TRUE,
                                      name = name,
                                      path = path,
                                      verbose = FALSE)
  if(public){
    googledrive::drive_share(upfile,
                             role = "reader",
                             type = "anyone",
                             verbose = FALSE)
  }
  get_web_link(file, path)
}

#' get_web_link
#'
#' @param file string that identify the path and file to upload
#' @param path string the google drive path as root/../folder
#' @param account string with the google drive mail
#'
#' @return the web link to the file using the \code{drv.tw} service
#' @export
#'
#'
get_web_link <- function(file, path, account = "filippo.gambarota@gmail.com"){

  path <- ifelse(path == "", basename(file), paste0(path, "/", basename(file)))

  sprintf("https://drv.tw/~%s/gd/%s", account, path)

}

#' recode_vec
#' @description recode a vector based on a lookup table
#' @param col vector to recode
#' @param lookup a named vector where names = old name and
#' value = new name
#' @param keep_na logical. TRUE if missing matches should be
#' treated as NA. FALSE use the original value
#'
#' @return a vector
#' @export
#'
recode_vec <- function(col, lookup, keep_na = FALSE){
  if(is.factor(col)){
    col <- as.character(col)
    turn_to_fac <- TRUE
  }

  out <- unname(lookup[col])

  if(!keep_na){
    na <- is.na(out)
    out[na] <- col[na]
  }
  if(turn_to_fac){
    out <- factor(out)
  }
  return(out)
}
filippogambarota/filippoR documentation built on March 6, 2023, 4:22 a.m.