Skip to content

Instantly share code, notes, and snippets.

@dsparks
dsparks / flatten_the_curve.R
Last active March 12, 2020 17:31
A simulation of viral transmission, and various measures to slow the spread
library(tidyverse)
library(colourlovers)
treatment_colors <- swatch(clpalette("1473"))[[1]]
sim_function <- function(
n_population = 10000,
n_days = 100,
time_to_quarantine = 14,
n_encounters = 50,
transmission_probability = 0.05,
@dsparks
dsparks / try loop.R
Created August 30, 2017 12:56
A function that sometimes fails, and a wrapper for that function that runs the first one until it does not fail
my_function <- function(x){ # This is a function that sometimes fails
doesItWork <- rnorm(1) > x
if(doesItWork){
return("You got a result")
} else {
stop("Did not work")
}
}
function_wrapper <- function(y){ # This function tries the first one until it works
@dsparks
dsparks / Super Bowl bingo card generator.R
Last active May 23, 2018 00:19
This script generates 5×5 bingo cards for the Super Bowl (or anything, really). Each randomly-generated card will be saved as a separate PNG for you to print. Use the provided word list, or edit to use your own. You can also modify the title, "rules" text, and "free space" text.
library(ggplot2)
new_theme_empty <- theme_bw()
new_theme_empty$line <- element_blank()
new_theme_empty$rect <- element_blank()
new_theme_empty$strip.text <- element_blank()
new_theme_empty$axis.text <- element_blank()
nCards <- 30
ruleText <- c("Look for these on the field, in the stands, or in the commercials.\n\"\" indicate that you should listen for the broadcast team to say this phrase.")
@dsparks
dsparks / population_density_map.R
Last active September 25, 2016 04:47
Global population density
library(rgdal)
library(maps)
library(viridis)
library(extrafont)
font_import(pattern = "GIL", prompt = FALSE) # Import Gill family
loadfonts(device="win") # Load them all
fonts() # See what fonts are available
library(tidyverse)
#devtools::install_github("hadley/ggplot2", force = TRUE)
1
@dsparks
dsparks / dplyr weirdness.R
Created October 16, 2014 17:25
Odd insistence on ungroup()
library(dplyr)
library(tidyr)
myDF <- data.frame(A = sample(LETTERS[1:4], 100, replace = TRUE),
B = sample(letters[5:9], 100, replace = TRUE),
C = rnorm(100))
summaryDF <- myDF %>% group_by(A, B) %>% dplyr::summarise(meanC = mean(C))
summaryDF %>% spread(B, meanC) # Error: index out of bounds
summaryDF %>% ungroup() %>% spread(B, meanC) # Works
@dsparks
dsparks / rationalFractionApproximator.R
Created October 7, 2014 14:07
Approximate any decimal with a rational fraction
rationalFractionApproximator <- function(dec, maxDenom = 1000){
denomSeq <- 1:maxDenom
impliedNumerator <- dec * denomSeq
roundNumerator <- round(impliedNumerator)
absError <- abs(roundNumerator / denomSeq - dec)
minMinimand <- which.min(absError * denomSeq)
minDenom <- denomSeq[minMinimand]
minNumer <- roundNumerator[minMinimand]
line2 <- paste0(minNumer, " / ", minDenom, " = ", minNumer / minDenom)
@dsparks
dsparks / colors.R
Last active December 23, 2020 22:12
Sunlight Foundation palettes, based on the Wes Anderson code
# Sunlight Foundation style guide: http://design.sunlightlabs.com/projects/Sunlight-StyleGuide-DataViz.pdf
# Ram's original Wes Anderson code: https://github.com/karthik/wesanderson/blob/master/R/colors.R
#' A Wes Anderson palette generator
#'
#' These are a handful of color palettes from Wes Anderson movies.
#' @param n Number of colors desired. Unfortunately most palettes now only have 4 or 5 colors. But hopefully we'll add more palettes soon. All color schemes are derived from the most excellent Tumblr blog: \href{http://wesandersonpalettes.tumblr.com/}{Wes Anderson Palettes}
#' @param name Name of desired palette. Choices are: \code{GrandBudapest}, \code{Moonrise1}, \code{Royal1}, \code{Moonrise2}, \code{Cavalcanti}, \code{Royal2}, \code{GrandBudapest2}, \code{Moonrise3}, \code{Chevalier}, \code{BottleRocket}, \code{darjeeling}, \code{darjeeling2}
#' @param type Set to continuous if you require a gradient of colors similar to how heat map works.
#' @export
@dsparks
dsparks / update R.R
Created April 12, 2014 12:02
Updating to a new version of R
# installing/loading the latest installr package:
install.packages("installr"); require(installr) #load / install+load installr
updateR()
# Then just follow the prompts...
@dsparks
dsparks / Custom font in ggplot2.R
Last active June 27, 2017 13:20
Load, then use any font on the system
require(extrafont)
require(ggplot2)
font_import(pattern = "GIL", prompt = FALSE) # Import Gill family
loadfonts(device="win") # Load them all
fonts() # See what fonts are available
zp1 <- ggplot(data = iris,
aes(x = Sepal.Length, y = Sepal.Width, label = Species))
zp1 <- zp1 + geom_text(family = "Gill Sans MT")
zp1 <- zp1 + theme(text=element_text(family="Gill Sans Ultra Bold"))
@dsparks
dsparks / manipulate example.R
Created March 12, 2014 16:36
An example using manipulate to modify a ggplot object. Requires RStudio.
aPlotFunction <- function(hh, ss, sz){
zp1 <- qplot(data = cars, x = dist, y = speed,
colour = I(hsv(hh/255, 1, 1)),
shape = I(ss),
size = I(sz))
print(zp1 + theme_bw())
}
manipulate(
aPlotFunction(hh, ss, sz),