Skip to content

Instantly share code, notes, and snippets.

View obrl-soil's full-sized avatar

obrl_soil obrl-soil

View GitHub Profile
@obrl-soil
obrl-soil / Int_to_ordinal_string.R
Last active November 1, 2016 11:11
R integer to ordinal string (1 = "1st", etc)
# Sometimes you just want your iterated filenames to look nice.
nth_fun <- function(x) {
x <- abs(x)
if (as.integer(substring(x, seq(nchar(x)), seq(nchar(x))))[nchar(x)] == 1) {
return(paste0(x, 'st'))
} else if (as.integer(substring(x, seq(nchar(x)), seq(nchar(x))))[nchar(x)] == 2) {
return(paste0(x, 'nd'))
} else if (as.integer(substring(x, seq(nchar(x)), seq(nchar(x))))[nchar(x)] == 3) {
return(paste0(x, 'rd'))
@obrl-soil
obrl-soil / relative_moving_window.R
Created November 8, 2016 02:02
relative values within a moving window
library(raster)
r <- raster('path\\to\\your\\file.ext')
winmin <- function(x) min(x, na.rm = T)
winmax <- function(x) max(x, na.rm = T)
focalmin <- focal(r, w = matrix(1, ncol = 3, nrow = 3), winmin)
focalmax <- focal(r, w = matrix(1, ncol = 3, nrow = 3), winmax)
@obrl-soil
obrl-soil / focalmode.R
Last active November 22, 2016 06:43
for calculating the mode of a focal window over a categorical raster
# for calculating the mode of a focal window over a categorical raster.
# Handling ties by retaining input cell value rather than default 'random'
winmode <- function(x) {
y <- modal(x, na.rm = T, ties = 'NA')
if (is.na(y)) { return(x[ceiling(length(x) / 2)]) } else {return(y)}}
# e.g.
# x <- raster(matrix(c(1:36), byrow = T, ncol = 6))
# f <- focal(x, w = matrix(1, ncol = 3, now = 3), fun = winmode)
@obrl-soil
obrl-soil / c50_usage_df.R
Created November 22, 2016 06:42
pull out attribute usage stats from c5.0 objects in R
c5_usage_df <- function(x) {
library(stringr)
xt <- substr(x$output,
str_locate(x$output, "usage:")[2] + 4,
str_locate(x$output, 'Time')[1] - 1)
xt <- gsub('\\n', '', xt)
xt <- gsub('\\t', ', ', xt)
xu <- as.data.frame(matrix(unlist(strsplit(xt, ", ")),
ncol =2, byrow=T),
@obrl-soil
obrl-soil / sql_r_stuff.R
Created November 22, 2016 12:49
some data prep stuff for pushing R variables to SQL queries
# for passing multiple variables to SQL in() queries
ids <- c(1,2,3)
idstring <- paste(ids, collapse=", ")
idstring <- paste0("'", idstring, "'")
#for a string of characters:
idch <- c("1", "2", "3")
idchstring <- paste0("'", idch, "'")
idchstring <- toString(idchstr)
# subset out polygons from x that intersect polygons in y
# should work for other geom types too
get_intersecting <- function(x, y) {
df <- as.data.frame(st_intersects(x, y, sparse = FALSE))
df$k <- apply(df, MARGIN = 1, FUN = function(x) ifelse(any(x) == TRUE, T, F))
x$k <- df$k
xout <- filter(x, k == TRUE)
x$k <- NULL
xout$k <- NULL
return(xout)
# a simplified version of the sampler used in https://github.com/obrl-soil/disaggregation
# takes n random samples in each polygon of a spatialpolygonsdataframe
# note that n samples may not be acheived if the polygon shape is particularly convoluted
# indata = spatialpolygonsdataframe
# sample_rate = positive integer
# pid_field = character string - column name. if omitted, rownames used instead
poly_sampler <- function(indata = NULL, sample_rate = NULL, pid_field = NULL) {
crs <- indata@proj4string
@obrl-soil
obrl-soil / Identify_multipolygons.R
Last active February 18, 2017 07:51
Identify Multipolygons in sp and sf class objects
### sp Polygon objects ###
# x = spatialPolygons or spatialPolygonsDataFrame object only
# by_id = where true, adds a column to @data with a part count for each polygon. Promotes sPolys to sPolydf.
find_mp <- function(x = NULL, id_rows = FALSE) {
nparts <- vector("list", length(x@polygons))
for (i in seq_along(1:length(x@polygons))) {
n <- vector("list", length(x@polygons[[i]]@Polygons))
for (j in seq_along(1:length(x@polygons[[i]]@Polygons))) {
# documenting some file.path quirks on windows
# gdal translate is used below to copy a file. its on the system PATH, enabling easy access via system2
infile <- 'C:/Data/test.tif'
> setwd('C:/Data/space\\ test')
Error in setwd("C:/Data/space\\ test") : cannot change working directory
> setwd('"C:/Data/space test"')
Error in setwd("\"C:/Data/space test\"") :
cannot change working directory
> setwd('C:/Data/space test')
library(tidyverse)
setwd('C:/DATA')
options(stringsAsFactors = FALSE)
# fake data
write.csv(tribble( ~col1, ~col2, ~col3,
1, 'a', T,
2, 'b', NA,
3, 'c', F),
file = file.path(getwd(), 'csv1.csv'),