This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# instructions: | |
#1) Register for the Human Fertility Database (http://www.humanfertility.org) | |
#2) Download the complete zip file from this page: http://www.humanfertility.org/cgi-bin/zipfiles.php (it's the #one labeled "All types of HFD data" | |
#3) make a folder whereever you keep your data, and call it something memorable, like, 'HFD' | |
#4) unpack the HFD zip file, which will have a couple nested folders, the last of which contains the text files #for each variable/series.- move these into your HFD directory. | |
# then the following function ought to work just fine for now: | |
HFDget <- function(abbrev = TRUE, countries = FALSE, years = FALSE, NoCohortNAs = TRUE, path) { |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
SqLexis <- function(Rates, | |
value = "ASFR", | |
col, | |
breaks, | |
guides = TRUE, | |
guide.int = 5, | |
legend = TRUE, | |
lab.breaks = NULL, | |
legend.args = NULL, | |
axis.args = NULL, |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# the code executes cellular automata 2^(2^3) experiments under 2^3 neighbor rules. Where each rule determines whether a cell turns on or off (TRUE-FALSE). Code is semi-efficient in turns of vectorizing processes, but there is plenty of room for improvement. | |
# first the rule matrix 8 rows (rules) by 3 columns (positions relative to middle) | |
ruleMatrix <- matrix(0,ncol=3,nrow=8) | |
ruleMatrix[2,3] <- 1 | |
ruleMatrix[3,2] <- 1 | |
ruleMatrix[4,2:3] <- 1 | |
ruleMatrix[5,1] <- 1 | |
ruleMatrix[6,c(1,3)] <- 1 | |
ruleMatrix[7,1:2] <- 1 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# define a set of functions for iterating through the Game of Life, as described (err, as I understood it) by Scott Page in the 2012 Model Thinking course: | |
# queenNeighbors() | |
# given the status of the cell located and index 'ind' | |
# in matrix 'M' with 'n' columns, what are the statuses | |
# of its neighbors | |
# *neighborhoods to NOT wrap left and right but they DO wrap up and down... | |
queenNeighbors <- function(ind,M,n){ | |
inds <- ind+outer(c(-1,0,1),c(-n,0,n),"+") | |
M[inds[inds > 0 & inds <= length(M) & inds != ind]] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# here's my hacky code for a Schelling segregation model. | |
# assumptions I've made in order to make life easier: | |
# 1) vacant cells have no influence. If a person happens to be totally surrounded by vacant cells, | |
# they don't move | |
# 2) when a person moves, they have no info about where they're going. This saves tons of computations | |
# about the preferability of all the vacant plots | |
# 3) a person knows perfectly well if their threshold is met or not (threshold is here is the | |
# minimum proportion same) | |
# 4) all movers have the same chances of landing in any of the vacant plots. |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Author: Tim Riffe: tim.riffe@gmail.com | |
# A basic implementation of the standing ovation model in R. | |
# The first part walks through the components, explaining the | |
# inputs and what's going on. It's a full example, start to finish | |
# this is follwed by a function StandingOvationSimple(), that just takes 3 inputs | |
# (with some other optional parameters) and will animate the process for you | |
# you may wish to modify the function to return a series of statistics taken | |
# along the progression of the model. Enjoy! |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# Game of Life, by Vadim Vinichenko https://github.com/vvinichenko | |
# I've pasted his 2 functions here with no experiment at the bottom in order to be able to source this code | |
# straight from R like this: | |
# source("http://raw.github.com/gist/1899814/881e5f92c9413a5e1800c8a274d177982d796a8c/life2.r") | |
# that line loads the 2 functions automatically. Experiment Gist to follow | |
shiftMatrix <- function(mx, dr, dc) { | |
#Shift the matrix by dr (delta r) rows and dc columns | |
#by adding e.g. dr rows of zeros and removing dr rows from the other side | |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# this code sources 2 functions from Vadim Vinichenko for the game of life. | |
# His functions were more convenient because they scale well. I'll make a 1000x1000 starting matrix, with | |
# 30% of cells initially on, remove the plotting and just get this one diagnostic: | |
# this line loads the 2 functions from an abdridged github gist: | |
source("http://raw.github.com/gist/1899814/881e5f92c9413a5e1800c8a274d177982d796a8c/life2.r") | |
# set parameters: | |
n_rows <- 1000 | |
n_cols <- 1000 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# this is an internal function just to make up block-like neighborhoods on a matrix with no natural borders. | |
# no need to tinker with it unless you're curious | |
DecideBLocks <- function(A,hoodsize){ | |
nhood_side <- floor(sqrt(hoodsize)) | |
Neighborhoods <- matrix(paste(ceiling(col(A)/nhood_side), ceiling(row(A)/nhood_side), sep="-"), nc=ncol(A)) | |
nhoods.out <- length(unique(c(Neighborhoods))) | |
return(Neighborhoods) | |
} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# these functions were already presented in gist 1885003, but are copied here | |
# so that they can be sourced directly from the R console. | |
# to do so, click on the 'raw' button, get rid of the 's' in https, and change the .R to .r, like this: | |
# source("http://raw.github.com/gist/1910183/cbc854b9f1de4495db6fbd7eba43c337a1a8922d/SchellingProcessFunctions.r") | |
queenNeighbors <- function(ind, M, n){ | |
inds <- ind+outer(c(-1, 0, 1), c(-n, 0, n), "+") | |
M[inds[inds > 0 & inds <= length(M) & inds != ind]] | |
} |