R/conway.R

In corona: Coronavirus ('Rona') Data Exploration

# Generated by LaTeX DogWagger Version 4.0.5 from file <NCTLL_904.tex>
# Date: [2020-9-17 13:16:5] 
# Do NOT edit this file. Edit the LaTeX source!!

# - <Section 26> - 
#' Animate Conway's Game of Life
#' 
#'  The canvas (arena) wraps around vertically and horizontally!  
#'  Execution will take some time. Results will be viewed differently
#'  depending on your system's default viewer for animated GIF files. 
#' 
#' @param pattern Defaults to 'soup' but there are many other well-known options:
#'    blinker ttetromino rpentomino toad beehive 
#'    beacon clock pulsar pentadecathlon galaxy spaceship 
#'    glidergun piheptomino switchengine conway acorn rabbits 
#'  boring static patterns: block snake eater 
#' @param side The number of elements on the area's side (width or height)
#' @param steps The number of frames
#' @param density 0.0--1 The density of the initial, random items ('soup')
#' @param filename writes to this file name e.g. foo.gif (NULL for current GIF device)
#' @param wrap Wrap around 
#' @param fps Frames per second
#' @param pause Initial pause 
#' @keywords corona Conway game of life animation frames 
#' @export 
#' @importFrom gganimate transition_states anim_save 
#' @import ggplot2 
#' @import reshape2 
#' @importFrom utils flush.console 
#' @importFrom stats rbinom
#' @examples
#'\dontrun{
#' corona_life( filename='animation.gif', side=50, steps=500, density=0.2 ) 
#' corona_life( side=100, steps=1000, pattern='rpentomino', wrap=FALSE ) 
#' corona_life( side=30, steps=120, pattern='spaceship' ) 
#' corona_life( side=100, steps=400, pattern='switchengine' ) 
#' corona_life( side=20, steps=30, pattern='clock' ) 
#' corona_life( side=20, steps=30, pattern='galaxy' ) 
#' corona_life( side=100, steps=200, pattern='glidergun' ) 
#' corona_life( side=45, steps=130, pattern='conway', fps=8, pause=40)
#'}

corona_life <- function (pattern='soup', side=50, steps=100, density=0.3, 
                         filename=NULL, wrap=TRUE, fps=20, pause=10)
{ ARENA <- matrix(nrow=side, ncol=side); 
if(!requireNamespace('gganimate', quietly = TRUE)) { stop('Missing gganimate') }; 
if(pattern == 'soup')
  { ARENA[] <- rbinom(side^2,1,density);
  } else
  { mid <- as.integer(side/2); 
    ARENA[] <- rep(0, times=side*side); 
    ARENA <- corona_pattern(ARENA, pattern, x=mid, y=mid);
  }; 
  STORE <- melt( game_of_life(ARENA, steps, wrap) ); 
  names(STORE) <- c('x', 'y', 'frame', 'on');
  STORE <- STORE[ STORE$on==1, ]; 
  print( paste('Starting ', side, 'x', side, 'animation...', steps, 'frames') ); 
  flush.console();

  p <- ggplot(STORE, aes(x = .data$x, y = .data$y)) + 
         geom_tile(color = "green") +
         scale_x_continuous(limits=c(0, side), expand = c(0, 0)) + 
         scale_y_continuous(limits=c(0, side), expand = c(0, 0)) + 
         coord_equal(); 
  p <- corona_unlabelled(p); 

  anim <- p + ggtitle('Frame {frame} of {nframes}') + 
  gganimate::transition_states(.data$frame,
                    transition_length = 1,
                    state_length = 1); # [or have a delay variable]
if( is.null(filename) )
  { print(anim, nframes=steps, fps=fps, start_pause=pause); 
    print('Animation written to default output'); 
  } else
  { pth = './images/'; 
  if(! dir.exists(pth) )
    { stop( paste("The directory", pth, "doesn't exist, can't write", filename) );
    }; 
    pathname = paste (pth, filename, sep=''); 
    gganimate::anim_save( pathname, animation=anim, nframes=steps, fps=fps, start_pause=pause );  
    print( paste('Animation written to ', pathname) ); # ^^ defaults to last_animation()
  }; 
  flush.console(); 
} 

# - <Section 27> - 
game_of_life <- function(ARENA, steps=50, wrap=TRUE)
{ side <- nrow(ARENA); # assumes side x side square matrix
  q <- side-1; 
  STORE <- array(0, c(side, side, steps));
  rotR <- function(A, L)
    { return( c(A[L], A[1:L-1]) ); 
    };
  rotL <- function(A, L)
    { return( c(A[2:L], A[1]) );
    }; 
      # fix: the initial pattern must be put in STORE[,,1]
  STORE[,,1] <- ARENA; 
                              
for (i in 2:steps)
  { # rows/columns Top Right Bottom Left: 
  if(wrap)
    { T <- ARENA[1,];
      R <- ARENA[,side];
      B <- ARENA[side,];
      L <- ARENA[,1]; 
    } else
    { T <- R <- B <- L <- rep(0, times=side);
    }; 
        # make 8 shifted copies of the original array
    allW <- cbind(R, ARENA[,-side] ); # West is shifted 'right'
    allN <- rbind(B, ARENA[-side,]);  # North is shifted 'down' etc. 
    allE <- cbind(ARENA[,-1], L);
    allS <- rbind(ARENA[-1,], T);
    allNW <- rbind(rotR(B,side),cbind(R[1:q],ARENA[-side,-side]));
    allNE <- rbind(rotL(B,side),cbind(ARENA[-side,-1],L[1:q]));
    allSE <- rbind(cbind(ARENA[-1,-1],L[2:side]),rotL(T,side));
    allSW <- rbind(cbind(R[2:side],ARENA[-1,-side]),rotR(T,side)); 
        # Add matrices
    ARENA2 <- allW + allNW + allN + allNE + allE + allSE + allS + allSW;     
        # Apply GoL rules: 
    ARENA3 <- ARENA; 
    ARENA3[ARENA==0 & ARENA2==3] <- 1; 
    ARENA3[ARENA==1 & ARENA2<2] <- 0;
    ARENA3[ARENA==1 & ARENA2>3] <- 0;
    ARENA <- ARENA3;
    STORE[,,i] <- ARENA; 
  }
  return(STORE); 
}

# - <Section 28> - 
corona_pattern <- function(ARENA, pattern, x=5, y=5)
{ PTN <- life[ life$pattern == pattern, ]; 
for( i in 1:nrow(PTN) )
  { ARENA[ x+PTN$x[i], y+PTN$y[i] ] <- 1;
  }; 
  return(ARENA); 
}
# -END OF FILE-