Skip to content

Instantly share code, notes, and snippets.

Avatar

David Holstius dholstius

  • Bay Area Air Quality Management District
  • San Francisco Bay Area
  • Twitter @dholstius
View GitHub Profile
@dholstius
dholstius / write_geojson.R
Last active Aug 29, 2015
Write a Spatial* object to a GeoJSON file
View write_geojson.R
write_geojson <- function (
spobj,
dsn = getwd(),
layer = deparse(substitute(spobj)),
pretty = TRUE,
digits = 6,
...,
quiet = FALSE
) {
require(rgdal)
@dholstius
dholstius / read_dusttrak.R
Last active Aug 29, 2015
Import records from a DustTrak log
View read_dusttrak.R
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
dholstius / rbindapply.R
Created Sep 22, 2014
lapply() mixed with rbind()
View rbindapply.R
rbindapply <- function (
X,
FUN,
...
) {
results <- lapply(X, FUN, ...)
if (!is.null(names(X))) {
names(results) <- names(X)
} else {
if (is.character(X))
@dholstius
dholstius / unzip_url.R
Last active Aug 29, 2015
Download and extract a zipped file (that may not have .zip at the end of the URL)
View unzip_url.R
unzip_url <- function (
url,
exdir,
zipfile = basename(url),
keep_zipfile = TRUE,
quiet = FALSE
) {
require(httr)
if (missing(exdir)) {
# FIXME: platform-dependent
@dholstius
dholstius / cached.R
Last active Aug 29, 2015
Evaluate an expression and save the result to a file
View cached.R
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
dholstius / extract_layer.R
Last active Aug 29, 2015
Extract a layer from an (unzipped) shapefile
View extract_layer.R
extract_layer <- function (
dsn,
layer,
datum,
quiet = FALSE,
...
) {
require(rgdal)
if (missing(layer)) {
layer <- ogrListLayers(dsn)
@dholstius
dholstius / tsreg.R
Created Sep 23, 2014
Theil-Sen regression
View tsreg.R
# 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
dholstius / optim_lag.R
Last active Aug 29, 2015
Optimize alignment of "zoo" objects
View optim_lag.R
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
dholstius / layer_abline.R
Created Sep 24, 2014
layer_abline() for ggvis
View layer_abline.R
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
dholstius / global.R
Last active Aug 29, 2015
Fetch, display, and download data from ARB
View global.R
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")
})