timriffe

# This code does the Colatz problem- not that difficult to implement. 
# 'number' is the given number, i is the number of steps. Beware, doing 
# this for all numbers from 1 to a million can take a long time! If you reduce
# 1e6 to 1e4 you still get a pretty plot!

Colatz <- function(number){
	i <- 0
	while(number != 1){
		i <- i + 1
		number <- ifelse(number %% 2 == 0, {number / 2}, {3 * number + 1})

timriffe

# Axelrod culture formation
# Author: triffe
###############################################################################
# here are 2 functions to do the Axelrod culture emergence simulation
# they work like this:
# you have a matrix of person IDs, IDmat
# each person has a certain number of traits and a certain number of possible values for those traits
# in each iteration, each person looks up, down, left, right. calculate the proportion similar for each 
# neighbor, and choose a neighbor randomly, but with probabilities given by the proportion similar. I.e.
# if you're different on everything, you don't pick that person- if you're same then you probably do: this is

timriffe

# Author: triffe
###############################################################################

# the system will keep progressing until the change in the distribution from one period to another is < tol 
# or until max iterations is met
# x must be logical or character

Polya <- compiler:::cmpfun(function(x, tol = .0001, maxit = 1e5){
			if (!(is.logical(x) | is.character(x))){ 
				stop("specify x as a logical or character vector")

timriffe

# Author: triffe
###############################################################################

TentMap <- compiler:::cmpfun(function(x, steps = 1e3+1){
			for (i in 1:steps){
				(x <- ifelse(x <= .5,{2 * x},{2 - 2 * x}))
			}
			x
		})

timriffe

# plots inspired by Cox, 1970, Sex Differences in Age at marriage

# this conveys absolute numbers or proportions (converted to proportions internally)

MatrixProportionPlot <- function(Mat, ...){
  inner.sides <- as.vector(sqrt(Mat / sum(Mat)))
  x <- as.vector(col(Mat))
  y <- as.vector(row(Mat))
  plot(NULL, type = "n", xlim = c(0, ncol(Mat)),ylim = c(0, nrow(Mat)), axes = FALSE, asp = TRUE,
    xlab = "", ylab = "")

timriffe

# strange ternary plots for proportion cohabiting by educational group.

# triplot(), a function to 2 a 3-axis version of that funky graphic in the Economist:
# arguments:
# center:       a pairlist or named vector with elements "x" and "y", i.e. c(x = 0, y = 0)
# cex:          expansion factor. By default, spokes are 1 unit long. You can either arbitrarily resize the plot area or 
#               resize these data icons to fit.
# levs:         a vector of length 3: the 3 proportions (between 0 and 1- if in %, divide by 100 first) cohabiting (or whatever). 
#               These are plotted counter-clockwise over the spokes: top, lower left, lower right. Arrange data accordingly:
# spoke.col:    the color of the axis spokes and ticks.

timriffe

# by Tim Riffe, June 5th, 2012

# arguments:
# Mat, a matrix of z values as follows:
# leftmost edge of first column = 0 degrees, rightmost edge of last column = 360 degrees
# columns are distributed in cells equally over the range 0 to 360 degrees, like a grid prior to transform
# first row is innermost circle, last row is outermost circle

# outer.radius, By default everything scaled to unit circle 
# cols: color vector. default = rev(heat.colors(length(breaks)-1))

timriffe

PolarImageInterpolate <- function(x, y, z, outer.radius = 1, 
        breaks, col, nlevels = 20, contours = TRUE, legend = TRUE, 
        axes = TRUE, circle.rads = pretty(c(0,outer.radius))){
    
    minitics <- seq(-outer.radius, outer.radius, length.out = 1000)
    # interpolate the data
    Interp <- akima:::interp(x = x, y = y, z = z, 
            extrap = TRUE, 

timriffe

# Author: triffe
###############################################################################

# Stable marriage problem using the Gale-Shapely algorithm:
# example data below, and the motivation to check perturbations for instability from:
# http://rosettacode.org/wiki/Stable_marriage_problem

MakeMatches <- function(males, females, m.prefs, f.prefs, maxit = 1e3){
  
  MatchMat <- matrix(0, ncol = length(males), nrow = length(females), dimnames = list(females, males))

timriffe

TuftePyramid <- function(males, females, age, widths, gap = .05, 
        fill.args = list(), border.args = list(), grid.args = list(), 
        age.label.args = list(), x.label.args = list(), 
        grid = TRUE, labels = TRUE, add = FALSE){
    
    Total <- sum(males, females)
    males   <- males / Total
    females <- females / Total

    max.x <- max(abs(pretty(c(males, females), n = 25)))