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
View flatten_the_curve.R
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
View try loop.R
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.
View Super Bowl bingo card generator.R
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
View population_density_map.R
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()
View dplyr weirdness.R
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
View rationalFractionApproximator.R
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
View colors.R
# 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
View update R.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
View Custom font in ggplot2.R
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.
View manipulate example.R
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),