Skip to content

Instantly share code, notes, and snippets.

Tim Riffe timriffe

Block or report user

Report or block timriffe

Hide content and notifications from this user.

Learn more about blocking users

Contact Support about this user’s behavior.

Learn more about reporting abuse

Report abuse
View GitHub Profile
@timriffe
timriffe / Lo_etal_2016.R
Created Dec 3, 2019
R implementation of lo et al (2016) supplementary material
View Lo_etal_2016.R
# First draft of this script by Markus Goehler, light edits by Tim Riffe
#################################### Preparation ###########################################
# Data from Lo et al supplementary material
# https://www.demographic-research.org/volumes/vol35/15/default.htm
mytable<- structure(
list(x = structure(
c(1L, 2L, 11L, 3L, 4L, 5L, 6L, 7L,
8L, 9L, 10L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L),
@timriffe
timriffe / to.greyvalue.R
Created Sep 14, 2018
What is the [0,1] equivalent gray value of a given hex color
View to.greyvalue.R
# I use this frequently enough .... helps
# with determining text value on top of given background color
to.greyvalue <- function(hexcolor, method = c("luminosity","average","lightness")[1]){
# https://www.johndcook.com/blog/2009/08/24/algorithms-convert-color-grayscale/
stopifnot(length(hexcolor) == 1)
rgbspec <- as.vector(col2rgb(hexcolor)) / 255
if (method == "luminosity"){
grayval <- sum(c(0.21, 0.72, 0.07) * rgbspec)
}
@timriffe
timriffe / rescaleAgeGroups.R
Created Aug 14, 2018
rescale single ages to a known prior in some larger age groups
View rescaleAgeGroups.R
install_github("timriffe/DemoTools")
library(DemoTools)
pop1 <- runif(20)
Age1 <- 0:19
pop2 <- DemoTools::groupAges(pop1,0:19) * c(1.1,1.05,.95,1.01)
Age2 <- seq(0,15,by=5)
# I'll use rescale.vector
@timriffe
timriffe / examplesurfaces.R
Created Jul 19, 2018
example code for getting surfaces with some good properties.
View examplesurfaces.R
load("/home/tim/Desktop/Hom_viv_muj.rdata")
ls()
library(RColorBrewer)
# select a suitable ramp (sequential for rates, divergent for differences or ratios)
# display.brewer.all()
ramp <- colorRampPalette(brewer.pal(9, "RdPu"), space = "Lab")
years <- 2000:2017
ages <- c(0,1,seq(5,105,by=5))
@timriffe
timriffe / blurpoint.R
Created Jul 18, 2018
quick code to draw points with a blur parameter that scales to some notion of a standard deviation.
View blurpoint.R
# blur point.
add_alpha <- function(col, alpha = .5){
if (all(col %in% colors())){
r.g.b. <- t(col2rgb(col))/255
} else {
r.g.b. <- as.matrix(colorspace::hex2RGB(col, gamma = FALSE)@coords)
}
cola <- apply(r.g.b., 1,
function(x)
rgb(x[1], x[2], x[3], alpha=alpha))
@timriffe
timriffe / GraduateCounts.R
Last active Jul 20, 2018
Some code to help solve the problem of negatives, which can happen in Sprague if the bottom age has a relatively low value.
View GraduateCounts.R
library(ungroup)
library(devtools)
install_github("timriffe/DemoTools")
library(DemoTools)
datapoints <- c(117,
382,
418,
490,
@timriffe
timriffe / LinesWithCI.R
Created May 4, 2018
draw lines with semitransparent confidence regions
View LinesWithCI.R
Dat <- read.csv("/home/tim/Desktop/Medias.csv")
head(Dat)
ymax <- ceiling(max(as.matrix(Dat[,3:5])))
Countries <- unique(Dat$Country)
years <- sort(unique(Dat$Year))
# a function to draw us a confidence region
polyCI <- function(chunk, col,years){
# chunk is a Country selection of the data.
if (col == "#000000"){
View Getting avg rate
#mx <- SWE$mx[SWE$Age >= 15 & SWE$Age <= 60 & SWE$Year == 1900]
mx <- c(0.00521, 0.00538, 0.00609, 0.00595, 0.00603, 0.00601, 0.00636,
0.0057, 0.00653, 0.00672, 0.00659, 0.00689, 0.0052, 0.00669,
0.00688, 0.00609, 0.00641, 0.00673, 0.0068, 0.00687, 0.00722,
0.00719, 0.00674, 0.00674, 0.00663, 0.00778, 0.00777, 0.00776,
0.0076, 0.00834, 0.00722, 0.00865, 0.00675, 0.00987, 0.00948,
0.01067, 0.0105, 0.01158, 0.01184, 0.01275, 0.01307, 0.01405,
0.0137, 0.01596, 0.01594, 0.01909)
plot(15:60, mx, log = 'y',type='l')
mavg <- exp(mean(log(mx)))
@timriffe
timriffe / LexisDiagramWithCounts.R
Created Mar 6, 2018
An example script for setting up diagrams with counts in Lexis triangles
View LexisDiagramWithCounts.R
library(devtools)
install_github("timriffe/LexisDiagram/LexisDiagram")
library(LexisDiagram)
# fake counts
upper <- matrix(rpois(100,1000),10,10)
lower <- matrix(rpois(110,1000),10,10)
# set up empty device
plot(NULL, type = "n", xlim = c(1900,1910),ylim = c(0,10),xlab = "Year", ylab = "Age",axes = FALSE,
@timriffe
timriffe / PoissonLE.R
Created Oct 23, 2017
how to simulate life expectancy from possion dist in R
View PoissonLE.R
dx <- c(15729.83, 1095.26, 740.18, 558.13, 430.11, 429.1, 380.09, 347.08,
349.08, 342.09, 391.1, 442.1, 462.11, 532.13, 726.17, 1019.25,
1492.37, 1951.48, 2441.59, 2794.68, 2812.69, 2858.7, 2647.65,
2548.62, 2510.62, 2405.58, 2349.58, 2483.6, 2563.63, 2818.69,
2764.67, 2894.71, 2918.71, 3162.77, 3535.86, 3862.94, 4276.54,
4625.63, 5098.24, 5392.31, 6005.47, 6294.54, 6730.64, 7340.79,
7688.87, 8166.99, 8586.1, 9016.19, 9538.33, 9819.39, 10261.5,
10612.58, 11493.8, 12377.01, 10546.57, 11510.3, 12333.51, 13593.31,
13365.26, 13648.03, 14153.75, 14663.57, 15844.86, 16512.02, 17746.32,
18614.54, 18959.62, 20666.03, 22098.39, 23628.75, 25691.26, 27010.59,
You can’t perform that action at this time.