dholstius

cached <- function (
  file, 
  expr, 
  cache_dir = "cache", 
  compress = "xz", 
  verbose = TRUE, 
  force = FALSE
) {
  file <- normalizePath(file.path(cache_dir, file), mustWork = FALSE)
  if (!file.exists(file) || force) {

dholstius

unzip_url <- function (
  url, 
  exdir, 
  zipfile = basename(url), 
  keep_zipfile = TRUE, 
  quiet = FALSE
) {
  require(httr)
  if (missing(exdir)) {
    # FIXME: platform-dependent

dholstius

extract_layer <- function (
  dsn, 
  layer, 
  datum, 
  quiet = FALSE, 
  ...
) {
  require(rgdal)
  if (missing(layer)) {
    layer <- ogrListLayers(dsn)

dholstius

write_geojson <- function (
  spobj, 
  dsn = getwd(), 
  layer = deparse(substitute(spobj)), 
  pretty = TRUE,
  digits = 6,
  ...,
  quiet = FALSE
) {
  require(rgdal)

dholstius

read_dusttrak <- function(
  file, 
  header_rows = 18
) {
  header <- read.csv(file, nrow = header_rows, header = FALSE, stringsAsFactors = FALSE)
  header <- as.list(setNames(header$V2, header$V1))
  records <- read.csv(file, skip = header_rows + 1, header = TRUE, stringsAsFactors = FALSE)
  names(records) <- c("elapsed", "value", "alarm", "error")
  start_mdYHMSp <- with(header, paste(`Test Start Date`, `Test Start Time`))
  records <- data.frame(start = mdy_hms(start_mdYHMSp) + records$elapsed, 

dholstius

rbindapply <- function (
  X, 
  FUN, 
  ...
) {
  results <- lapply(X, FUN, ...)
  if (!is.null(names(X))) {
    names(results) <- names(X)
  } else {
    if (is.character(X))

dholstius

# Ported by David Holstius <dholstius@baaqmd.gov>
# from http://skip.ucsc.edu/leslie_MOUSE/programs/plotting/tsreg.r

# Module tsreg
# Author:  E. A. Houseman
# Last update July 2004

# AR(q) time series regression assuming regular intervals
# Support for cholesky residuals [Houseman, Ryan, Coull (2004, JASA)]

dholstius

optim_lag <- function (z1, z2, merit = cor, max_lag = 120, warn = FALSE) {
  require(zoo)
  ow <- as.integer(options("warn"))
  options(warn = -1 * as.integer(!warn))
  on.exit(options(warn = ow))
  f <- approxfun(x = index(z2), y = as.numeric(z2))
  t_start <- max(start(z1), start(z2))
  t_end <- min(end(z1), end(z2))
  z1 <- window(z1, start = t_start, end = t_end)         
  z2 <- window(z2, start = t_start, end = t_end)

dholstius

abline_data <- function (domain, intercept, slope) {
  data.frame(x = domain, y = domain * slope + intercept)
}

untick <- function (x) {
  stopifnot(all(sapply(x, is.name)))
  str_replace_all(as.character(x), "`", "")
}

layer_abline <- function (.vis, domain, intercept = 0, slope = 1, dash = 6, ...) {

dholstius

suppressPackageStartupMessages({
  library(dplyr)     # install.packages("dplyr")
  library(tidyr)     # install.packages("tidyr")
  library(httr)      # install.packages("httr")
  library(lubridate) # install.packages("lubridate")
  library(stringr)   # install.packages("stringr")
  library(ggvis)     # install.packages("ggvis")
  library(digest)    # install.packages("digest")
})