Skip to content

Instantly share code, notes, and snippets.

@seasmith
seasmith / deleting-unused-r.snippets
Created January 11, 2022 21:26
unused r snippets that i am 'deleting'
snippet .arr
arrange(desc(${1:vars}))
snippet .group_sum
group_by(${1:vars}) %>%
summarize(${2:value} = ${3:expression}) %>%
ungroup()
snippet .group_mut
group_by(${1:vars}) %>%
@seasmith
seasmith / sql-like.R
Created October 15, 2020 20:08
Extra SQL-like functions for dplyr
# Symmetrical set-difference
# from: https://github.com/tidyverse/dplyr/issues/4811
symdiff <- function(x, y) {
setdiff(union(x, y), intersect(x, y))
}
# Inserting join
# from: https://github.com/tidyverse/dplyr/issues/1275
insert <- function(data, insertData, by) {
data %>%
@seasmith
seasmith / envs.R
Last active May 22, 2020 04:06
Understanding environments and frames
# What you need to know:
# * environments -- inheritance of definition
# * frames -- call reference
#
# What does that mean?
# * environments are inherited when a function is defined (i.e. f <- function () {})
# * frames refer to where a function was called from, not where it was defined
i <- 1
price_type <- c("henry_hub_spot", "future_contract_1",
"future_contract_2", "future_contract_3",
"future_contract_4")
make_proper_names <- function (x) {
stringr::str_replace_all(x, "_", " ") %>%
stringr::str_to_title()
}
make_proper_names(price_type)
@seasmith
seasmith / apply-funs.R
Created April 17, 2020 01:56
Apply aliases
apply_rows <- function (x, fun, ...) apply(x, 1, fun, ...)
apply_columns <- function (x, fun, ...) apply(x, 2, fun, ...)
apply_groups <- function (x, groups, fun, ...) tapply(x, groups, fun, ...)
@seasmith
seasmith / last-by-group.R
Created April 16, 2020 14:21
Last value per group
# Produces an 'unmatched length' error
last_by_group <- function (x, group = NULL, order_by = NULL, default = default_missing(x)) {
if (is.null(group)) {
return(last(x, order_by = order_by, default, default))
} else {
tapply(X = x, INDEX = group, FUN = last)
}
}
@seasmith
seasmith / options.R
Last active April 5, 2020 21:17
Setup an R package
options(
usethis.description = list(
`Authors@R` = 'person("Luke", "Smith", email = "lukedansmi@sbcglobal.net", role = c("aut", "cre"))',
License = "GPL-3"
)
)
@seasmith
seasmith / coord-sf-rewrite.R
Last active March 7, 2020 20:48
Re-write coord-sf to accept bbox
add_bbox_nudge_x <- function (b, i) {
if (length(i) == 1) {
b[c(1, 3)] <- b[c(1, 3)] + c(i, -i)
} else {
b[c(1, 3)] <- b[c(1, 3)] + c(i[1], i[2])
}
b
}