Skip to content

Instantly share code, notes, and snippets.

View bbolker's full-sized avatar

Ben Bolker bbolker

View GitHub Profile
@bbolker
bbolker / persist.rmd
Last active January 4, 2016 18:56
runr test with persistent python3
---
title: "runr test"
date: "`r format(Sys.time(), '%H:%M %d %B %Y ')`"
author: Ben Bolker
---
```{r opts,message=FALSE,echo=FALSE,warning=FALSE}
library("knitr")
library("runr")
py <- proc_python()
@bbolker
bbolker / xapply.R
Created June 29, 2017 16:43
a "factorial apply" function
#' apply a function to a factorial combination of elements of lists
#' returns (if \code{FLATTEN=TRUE}) a flat list (with length equal to the product of the
#' lengths of the input lists) of results, along with a \code{grid} attribute containing
#' a data frame giving the values used for each element in the list
#' @param FUN function to apply
#' @param ... list of vectors to apply to
#' @param FLATTEN
#' @param MoreArgs additional arguments to pass to \code{FUN}
#' @param GlobalVars list of names of variables in global environment needed for parallel runs
#' @param .progress progress bar?
@bbolker
bbolker / geom_cstar
Created July 28, 2018 17:18
a ggplot geom that connects points to the centroid
##'
##' @examples
##' dd <- data.frame(x=rnorm(10),y=rnorm(10))
##' ggplot(dd,aes(x,y))+
##' geom_point() +
##' stat_centseg()
##' ggplot(dd,aes(x,y))+
##' geom_point() +
##' stat_centseg(cfun=median)
##' data("Gasoline",package="nlme")
@bbolker
bbolker / lme4_gamma_profile
Created August 21, 2018 16:53
example of profiling a gamma model in lme4
library(lme4)
set.seed(101)
dd <- data.frame(x=rnorm(200),f=factor(rep(1:10,each=20)))
dd$y <- simulate(~x+(1|f),
newdata=dd,
newparams=list(beta=c(10,1),
theta=1,
sigma=5),
family=Gamma(link="identity"))[[1]]
## NB not sure what sigma really is here??? must be shape parameter
@bbolker
bbolker / lme4_gamma_profile
Created August 21, 2018 16:53
example of profiling a gamma model in lme4
library(lme4)
set.seed(101)
dd <- data.frame(x=rnorm(200),f=factor(rep(1:10,each=20)))
dd$y <- simulate(~x+(1|f),
newdata=dd,
newparams=list(beta=c(10,1),
theta=1,
sigma=5),
family=Gamma(link="identity"))[[1]]
## NB not sure what sigma really is here??? must be shape parameter
bigcorPar <- function(x, nblocks = 10, verbose = TRUE, ncore="all", ...){
library(ff, quietly = TRUE)
require(doMC)
if(ncore=="all"){
ncore = multicore:::detectCores()
registerDoMC(cores = ncore)
} else{
registerDoMC(cores = ncore)
}
@bbolker
bbolker / scientific_10.R
Last active September 25, 2023 12:26
scientific notation with plotmath superscripts in ggplot
scientific_10 <- function(x,suppress_ones=TRUE) {
s <- scales::scientific_format()(x)
## substitute for exact zeros
s[s=="0e+00"] <- "0"
## regex: [+]? = "zero or one occurrences of '+'"
s2 <- gsub("e[+]?", " %*% 10^", s )
## suppress 1 x
if (suppress_ones) s2 <- gsub("1 %\\*% +","",s2)
parse(text=s2)
}
@bbolker
bbolker / covid_ItUK.R
Last active March 22, 2020 22:57
Italy/UK death slope comparison
## adapted from https://rviews.rstudio.com/2020/03/05/covid-19-epidemiology-with-r/
## CC-BY-SA 3.0 https://creativecommons.org/licenses/by-sa/3.0/
library(tidyverse)
library(lubridate)
library(directlabels)
library(colorspace)
library(emmeans)
library(broom)
f1 <- expression(eps/(2-x/eps))
f2 <- expression(eps*log(exp(x/eps)+1))
flist <- list(f1,f2)
dfun <- function(x,e,n=0,eps=0.001) {
alt_less <- switch(n+1,
eval(e),
eval(D(e,"x")),
eval(D(D(e,"x"),"x")))
library(nlme)
packageVersion('nlme')
## the values are fixed for all models
rho <- 0.3
fixform <- distance ~ age + factor(Sex)
## remove the grouping and other classes to keep it simple
## full balanced data set
Obal<-as.data.frame(Orthodont)
## create unbalanced Orthodont data set with no singletons