Skip to content

Instantly share code, notes, and snippets.

@k-barton
k-barton / textbox.R
Last active June 27, 2023 01:04
Draw a rectangle surrounding text in a plot
# All arguments as in `graphics::text`, except pad which specifies padding (optionally
# for vertical and horizontal) around the text as a fraction of a character width.
# `...` is passed to `rect`
textbox <-
function(x, y, labels, adj = NULL,
pos = NULL,
offset = 0.5,
pad = c(0, 0),
vfont = NULL,
cex = par("cex"),
@k-barton
k-barton / pdfcombine.bat
Last active March 16, 2023 14:57
Windows batch script to combine mutiple pdfs into one using Ghostscript
@echo off
setlocal EnableDelayedExpansion
set result=
set outfile=
set nextisoutfile=
set "self=%~n0"
:startHelp
@k-barton
k-barton / MuMIn-methods-compar.gee.R
Last active December 8, 2022 15:47
Methods for `ape:compar.gee` needed to use these model types with MuMIn functions.
require("MuMIn")
local({
quasiLik.compar.gee <-
function (object, ...) {
scale <- object$scale
ret <- .qlik(object$residuals + object$fitted.values, object$fitted.values,
get(object$family, envir = asNamespace("stats"))(),
1, scale)
@k-barton
k-barton / MuMIn-methods-phylolm+pglmm_compare.R
Last active December 8, 2022 15:33
Standard methods for `phylo[g]lm` and `pglmm_compare` needed to use these model types with MuMIn functions.
local({
family.phylolm <-
function (object, ...) {
stop("???")
}
logLik.pglmm_compare <-
function (object, ...) {
rval <- object$logLik
@k-barton
k-barton / sd-ranef-avg.R
Last active May 13, 2022 12:37
Calculates model-averaged random effects std. dev.
sd.ranef.avg <-
function(object) {
if(!inherits(object, "averaging"))
stop("not an \"averaging\" object")
mo <- get.models(object, TRUE)
re <- lapply(mo, function(x) as.data.frame(ranef(x, condVar = TRUE)))
cols <- c("grpvar", "term", "grp")
@k-barton
k-barton / mscrwpath.R
Created February 17, 2021 11:03
Generate a Multistate Correlated Random Walk path (preliminary version)
#' @return a two-column matrix of turning angles `"ta"` and step lengths `"len"`.
#' @param Nstates the number of movement states.
#' @param tp a vector of transition probabilities for `Nstates == 2` or a
#' square transition matrix `[Nstates, Nstates]`. Ignored if `Nstates == 1`
#' @param mu,rho wrapped Cauchy distribution parameters for the turning angles. Should have a length of `Nstates`.
#' @param wscale,wshape Weibull distribution parameters for step length
# TODO: starting position and initial direction. Currently all are set to 0.
mscrwpath <-
function(N, Nstates = 2, tp = c(.05, .1),
mu = c(0, 0), rho = c(.5, .99),
@k-barton
k-barton / pairs.cor.R
Last active February 8, 2021 13:55
Scatterplot matrix with linear model fit and correlation (base graphics)
#' @param formula,data,subset,na.action arguments to `model.frame`. If the first argument is a data frame, the rest is ignored.
#' @param method argument to `cor.test`. A character string indicating which correlation coefficient is to be used for the test. One of "pearson", "kendall", or "spearman", can be abbreviated.
#' @param n integer; the number of x values at which to evaluate.
#' @param lty,col,cex graphical parameters fit line type, line colour, character expansion for labels.
#' @param \dots optional, additional arguments passed to `points`
#' @example
#' data <- data.frame(x = runif(100), x1 = rlnorm(100), x2 = rnorm(100))
#' pairs.cor(~ x + log(x1) + x2, data)
pairs.cor <-
function(formula, data = NULL, subset = NULL, na.action = na.fail,
@k-barton
k-barton / violplot.R
Last active October 7, 2020 12:54
Produce violin-plot using base graphics.
# The syntax is very much as in `boxplot` (a large portion of the code is taken
# from graphics::boxplot.default and graphics::bxp).
# The argument `density.args` should be a named list and is used to pass arguments to `density`.
violplot <-
function (x, ...)
UseMethod("violplot")
registerS3method("violplot", "formula",
function (formula, data = NULL, ..., subset, na.action = NULL,
@k-barton
k-barton / lrt.R
Last active November 20, 2020 11:00
Performs likelihood ratio test on `logLik` objects.
#' @param \dots two or more `logLik` objects
lrt <-
function(...) {
logL <- list(...)
nmodels <- length(logL)
rval <- matrix(rep(NA, 5 * nmodels), ncol = 5)
colnames(rval) <- c("#Df", "LogLik", "Df", "Chisq", "Pr(>Chisq)")
rownames(rval) <- 1:nmodels
rval[, 1] <- as.numeric(sapply(logL, function(x) attr(x, "df")))
@k-barton
k-barton / weighted.histogram.R
Last active November 20, 2020 11:03
Compute/plot a weighted histogram using base graphics.
weighted.histogram <-
function() {
cl <- match.call()
cl$w <- NULL
cl[[1L]] <- as.name("hist.default")
cl$plot <- FALSE
h <- eval.parent(cl)
f <- factor(findInterval(x, h$breaks, left.open = TRUE,
rightmost.closed = TRUE,
all.inside = TRUE),