R/tiny_helpers.R

Defines functions download.new.file tidyxls_sheet ghme shrink between lt

Documented in between download.new.file ghme lt shrink tidyxls_sheet

#' Length of the Trues
#'
#' @param x a logical vector
#' @return the proportion of \code{x} that is T
#' @export
lt <- function(x) sum(x)/length(x)

#' A point between two others
#' @param x The points between which the function should find a value
#' @param p How far between the two points
#' @param y Alternative way to specify the second point we should look between
#' @return a single value, 100*p% of the way between x[1] and x[2] or between x and y.
#' @export
between <- function(x, p, y=NULL){
   if(length(x)==2) x[1] + p*diff(x)
   else x + p*(y-x)
}

#' A smaller range
#' @param rng The original range
#' @param x How much to shrink it by
#' @return A new, smaller range
#' @export
shrink <- function(rng, x)
   c( sum( c(1-x/2, x/2)*rng ), sum(c(x/2, 1-x/2)*rng) )


#' show the current repo on github
#' @export
ghme <- function(){
  .url <- function(x) system2("open", x)

  file.path(here::here(), ".git/config") |>
    readLines() |>
    stringr::str_subset("url") |>
    stringr::str_replace("\\\turl = ", "") |>
    utils::browseURL()
}

#' Write an xls sheet to xlsx so you can open it with tidyxl
#' @param fn the filename of a .xls spreadsheet
#' @param sheet the worksheet to be xlsx_cells'ed. 
#' @export
tidyxls_sheet <- function(fn, sheet){
  tmp_fn <- tempfile(fileext=".xlsx")
  tmp <- readxl::read_excel(fn, sheet=sheet)
  writexl::write_xlsx(tmp, tmp_fn)
  tidyxl::xlsx_cells(tmp_fn)
}


#' Download a new version of a file
#'
#' Uses `curl -z` to check that the online file
#' has been updated more recently than the timestamp on the
#' destination file
#'
#' @param url the file to be downloaded
#' @param fn the filename where it will go. Won't download unless the online file has been updated more
#'   recently than this file has been modified. 
#' @export
#' 
download.new.file <- function(url, fn){
  fn <- safe_fn(fn)
  download.file(url, fn, method="curl",
    extra = paste("-z", fn))
}
bbcuffer/rcutils documentation built on Nov. 10, 2023, 12:08 p.m.