In Euphrasiologist/GOL: Functions for exploring ideas in Games of Life by Karl Sigmund (ISBN: 978-0198547839)

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

Overview

This is a work in progress investigating some of the ideas and concepts in the book, Games of Life by Karl Sigmund. The idea is to get a visual impression of some of the basic and fundamental processes in evolutionary biology. Usually, the function (like random_drifts()) will output a ggplot object at the end, from which you can extract all of the simulation data or fiddle with the plot to make it prettier.

Installation

# Install this development version from GitHub: (I don't think it will ever go on CRAN)
# install.packages("devtools")
devtools::install_github("Euphrasiologist/GOL")

Dependencies

So far, the only dependencies are data.table and ggplot2. Install them as follows:

install.packages("data.table"); install.packages("ggplot2")
library(data.table); library(ggplot2)

Usage

I hope that it's all very easy to work. Adjust the parameters in the function and you're away!

random_drifts <- function(colours = 5, trials, size, rel.freq = NULL){

  require(data.table); require(ggplot2)


  if(trials < 2){
    stop("Increase number of trials, try 100+")
  }

  if(size < colours){
    stop("Population size must be greater than the number of coloured balls!")
  }

  # generate some random numbers
  if(is.null(rel.freq)){

    gen.freq <- function(n) {
      m <- matrix(runif(n,0,1), ncol=n)
      m <- sweep(m, 1, rowSums(m), FUN="/")
      m <- as.vector(m)
    }

    rel.freq <- gen.freq(colours)

  }

  # if relative frequencies manually defined
  if(colours != length(rel.freq) & sum(rel.freq) != 1){
    stop("Relative frequencies of colours must equal the number of colours and sum to 1")
  }

  # starting data frame

  dat <- matrix(ncol = colours + 1, nrow = trials)
  colnames(dat) <- c("Trials", paste("colour", 1:colours))        
  dat <- as.data.frame(dat)

  # seed the data frame

  dat[1,] <- c(1, round(size*rel.freq))
  dat$Trials <- 1:trials

  # start the loop 

  for(i in 2:trials){

    # save each iteration as x
    x <- as.vector(table(sample(x = rep(x = paste("colour", 1:colours), times = dat[i-1, c(2:(colours+1))]*2),
                                replace = TRUE,
                                size = size))[c(paste("colour", 1:colours))])
    # remove NA's
    dat[i,] <- c(i, ifelse(test = is.na(x), 
                           yes = 0, 
                           no = x))
  }

  dat2 <- data.table::melt(dat, id.vars = 1)

  ggplot(dat2, aes(x = Trials, y = value))+
    geom_line(aes(colour = variable))+
    theme_bw()+
    theme(legend.position = "none")+
    xlab(label = "Generation")+
    ylab(label = "Proportion of colours")
}

random_drifts(colours = 5, trials = 500, size = 300)

Improvements

Hopefully at some point I will write a litte document explaining the functions and why they are interesting, but I will wait until there is a critical mass of sufficiently good functions before I do so!

Euphrasiologist/GOL documentation built on June 26, 2019, 10:58 a.m.