Skip to content

Instantly share code, notes, and snippets.

View dblodgett-usgs's full-sized avatar

David Blodgett dblodgett-usgs

View GitHub Profile
@dblodgett-usgs
dblodgett-usgs / remove_gpkg_layer.R
Created October 3, 2022 22:14
remove gpkg layer with R using RSQLite
remove_gpkg_table <- function(db, table) {
con <- RSQLite::dbConnect(RSQLite::SQLite(), db)
on.exit(RSQLite::dbDisconnect(con))
o <- RSQLite::dbRemoveTable(con, table)
o <- RSQLite::dbSendQuery(con, sprintf("DELETE FROM gpkg_contents where table_name='%s';", table))
RSQLite::dbClearResult(o)
@dblodgett-usgs
dblodgett-usgs / pull_gagesii_dv.R
Created May 14, 2022 19:32
nwis dv to netcdf-dsg with the ncdfgeom package.
library(sf)
library(dplyr)
library(dataRetrieval)
library(RNetCDF)
# https://water.usgs.gov/GIS/metadata/usgswrd/XML/gagesII_Sept2011.xml
gagesii <- sf::read_sf("R/nexus_locations/gagesII_9322_point_shapefile/gagesII_9322_sept30_2011.shp")
# Just look at reference gages with recent active status and more than 80 years of record.
ref <- dplyr::filter(gagesii, CLASS == "Ref" & ACTIVE09 == "yes" & FLYRS1900 > 80)
@dblodgett-usgs
dblodgett-usgs / unnest.R
Created February 4, 2022 04:26
unnest a data.frame in base R
#' Unnest a data.frame with one list column
#' @description Will unnest a data.frame that has one list column such that each element
#' of each list has its own row and all other observations are repeated.
#' @param x data.frame
#' @param col character pointing to the list column
unnest <- function(x, col = "set") {
times <- lengths(x[[col]])
base_names <- names(x)[!names(x) == col]
@dblodgett-usgs
dblodgett-usgs / demo_aggregation.R
Created December 15, 2021 16:31
Experiment to find main-flowpaths through catchment aggregates.
# start at upstream most head water nexus and trace downstream
# find groups bound by outlets and
# mark visited catchments in catchment topology vector
# keep going until all outlets and headwaters have been consumed
demo_aggregation <- function() {
library(dplyr)
library(sf)
load("testing.rda")
@dblodgett-usgs
dblodgett-usgs / nldas_rods.R
Created May 20, 2021 00:37
Pull NLDAS Data Rods
httr::GET("https://ldas.gsfc.nasa.gov/sites/default/files/ldas/nldas/NLDAS_masks-veg-soil.nc4",
httr::write_disk("NLDAS_masks-veg-soil.nc"))
f <- "NLDAS_masks-veg-soil.nc"
meta <- ncmeta::nc_meta(f)
meta$variable
mask <- stars::read_ncdf(f, var = "NLDAS_mask")
reprex::reprex({
#' @example
#' p <- sf::st_point(x = c(-73.82705, 43.29139), dim = "XY")
#' make_json_input(p)
#'
make_json_input <- function(p) {
jsonlite::toJSON(list(inputs = list(list(id = "lat",
type = "text/plain",
value = p[2]),
list(id = "lng",
@dblodgett-usgs
dblodgett-usgs / convert.R
Last active December 8, 2020 20:11
Convert NHDPlus elevation derivatives into standalone mreged tif files. See comment for README.
# Usage:
# docker run --mount type=bind,source="$(pwd)",target=/data -w /data dblodgett/hydrogeoenv-custom:latest Rscript ./convert.R
temp_source <- tempfile(fileext = ".R")
download.file("https://raw.githubusercontent.com/dblodgett-usgs/hyRefactor/master/R/download_fdr_fac.R",
temp_source)
library("rvest")
library("xml2")
@dblodgett-usgs
dblodgett-usgs / hr_demo.R
Last active October 1, 2020 13:18
mr/hr subset function
subset_hr_mr <- function(lon, lat, out_dir) {
dir.create(out_dir, recursive = TRUE, showWarnings = FALSE)
point <- sf::st_sfc(sf::st_point(c(lon, lat)),
crs = 4326)
mr_gpkg <- file.path(out_dir, "mr.gpkg")
hr_gpkg <- file.path(out_dir, "hr.gpkg")
@dblodgett-usgs
dblodgett-usgs / animate_accumulate_wbd.R
Created December 10, 2018 17:20
A visualization script to create frames of an animated gif of WBD accumulation where all paths terminate on the last time step.
# https://github.com/dblodgett-usgs/nhdplusTools
library(nhdplusTools)
# https://github.com/USGS-R/HUCAgg
library(HUCAgg)
library(sf)
library(dplyr)
library(snow)
wbd_gdb <- "WBD_National_GDB.gdb"
@dblodgett-usgs
dblodgett-usgs / find_upstream_gages.R
Last active December 2, 2018 20:41
Script to determine what stream gages are upstream of each streamgage in the gage layer included in the NHDPlus V2 database. See comments below for description.
library(nhdplusTools)
library(sf)
library(igraph)
library(dplyr)
library(tidyr)
library(readr)
library(jsonlite)
nhdplus_path("../../4_data/NHDPlusNationalData/NHDPlusV21_National_Seamless.gdb/")
nhd_paths <- stage_national_data()