Initial commit of HPC materials

content/HPC/Code/Demographic.R

@@ -0,0 +1,95 @@
+# CMEE 2024 HPC exercises R code provided 
+# Stochastic and deterministic demographic model
+
+deterministic_step <- function(state,projection_matrix){
+  new_state = projection_matrix %*% state
+  return(new_state)
+}
+
+deterministic_simulation <- function(initial_state,projection_matrix,simulation_length){
+  population_size <- numeric(simulation_length + 1) # list as long as sim length + 1 
+  population_size[1] <- sum(initial_state) # first value = sum initial state
+  for (i in 1:simulation_length) { 
+    initial_state <- deterministic_step(initial_state, projection_matrix) # step through
+    population_size[i + 1] <- sum(initial_state) # add to index
+  }
+  return(population_size)
+}
+
+multinomial <- function(pool, probs) {
+  if (sum(probs) > 1) { # check probability
+    print("Sum of probabilities is greater than 1")
+  }
+  death = 1 - sum(probs) # death prob
+  probd = c(probs, death) # merge them
+  x = as.vector(rmultinom(n=11, pool, probd)) # sample
+  return(x[1:length(probs)])
+}
+
+survival_maturation <- function(state,growth_matrix){
+  new_state <- rep(0, length(state)) # 1. new population state
+  for (i in 1:length(state)){
+    current_individuals <- state[i] # 2.1 individuals in life stage i
+    transition_probs <- growth_matrix[,i] # 2.2 initialise probabilities from matrix
+    individuals_count <- multinomial(current_individuals, transition_probs) # 2.2 individuals that remain in stage i
+    new_state <- sum_vect(new_state, individuals_count)
+  }
+  return(new_state) # 3. return new_state
+}
+
+random_draw <- function(probability_distribution) {
+  draw <- sample(1:length(probability_distribution), size = 1, prob = probability_distribution, replace = TRUE)
+  return(draw)
+}
+
+stochastic_recruitment <- function(reproduction_matrix,clutch_distribution){
+  recruitment_rate <- reproduction_matrix[1, ncol(reproduction_matrix)] # get recruitment rate
+  expected_clutch_size <- sum(clutch_distribution * (1:length(clutch_distribution))) # get mean clutch size
+  recruitment_probability <- recruitment_rate / expected_clutch_size # recruitment probability
+  if (recruitment_probability > 1) { # check probability
+    stop("Inconsistency in model parameters: Recruitment probability cannot exceed 1.") 
+  }
+  return(recruitment_probability)
+}
+
+offspring_calc <- function(state, clutch_distribution, recruitment_probability) {
+  offspring = 0 
+  x = state[length(state)] # number of adults
+  number_clutch = rbinom(1, x, recruitment_probability) # number of recruiting adults
+
+  if (number_clutch > 0) { # check for population collapse
+    for (i in 1:number_clutch) {
+      clutch = random_draw(clutch_distribution) # get clutch size
+      offspring = offspring + clutch # sum number of offspring
+    }
+  }
+
+  return(offspring) # total number of offspring
+}
+
+stochastic_step <- function(state,growth_matrix,reproduction_matrix,clutch_distribution,recruitment_probability){
+  new_state = survival_maturation(state, growth_matrix) # survival and maturation
+  total_offspring = offspring_calc(state, clutch_distribution, recruitment_probability) # number of offspring produced
+  new_state[1] = new_state[1] + total_offspring # add to new state
+  return(new_state)
+}
+
+stochastic_simulation <- function(initial_state,growth_matrix,reproduction_matrix,clutch_distribution,simulation_length){
+  population_size <- numeric(simulation_length + 1) # population of length sim + 1
+  population_size[1] = sum(initial_state) # first value sum of initial state
+  recruitment_probability = stochastic_recruitment(reproduction_matrix, clutch_distribution) # recruitment probability
+
+  for(i in 1:simulation_length){
+    new_state = stochastic_step(initial_state, growth_matrix, reproduction_matrix, clutch_distribution, recruitment_probability) # one step of stochastic model
+    population_size[i + 1] = sum(new_state) # update population time series
+    if (sum(new_state) == 0){break} # stop if the population is zero
+    initial_state = new_state # update for next iter
+  }
+
+  if (length(population_size) < simulation_length + 1){ # fill remaining entries with 0
+    population_size[(length(population_size) + 1):(simulation_length + 1)]
+  }
+
+  return(population_size)
+}
+

content/HPC/Code/abc123_HPC_2024_demographic_cluster.R

@@ -0,0 +1,5 @@
+# CMEE 2024 HPC exercises R code pro forma
+# For stochastic demographic model cluster run
+
+rm(list=ls()) # good practice 
+source("Demographic.R")

content/HPC/Code/abc123_HPC_2024_main.R

@@ -0,0 +1,262 @@
+# CMEE 2024 HPC exercises R code main pro forma
+# You don't HAVE to use this but it will be very helpful.
+# If you opt to write everything yourself from scratch please ensure you use
+# EXACTLY the same function and parameter names and beware that you may lose
+# marks if it doesn't work properly because of not using the pro-forma.
+
+name <- "Your Name"
+preferred_name <- "Name"
+email <- "[email protected]"
+username <- "abc123"
+
+# Please remember *not* to clear the work space here, or anywhere in this file.
+# If you do, it'll wipe out your username information that you entered just
+# above, and when you use this file as a 'toolbox' as intended it'll also wipe
+# away everything you're doing outside of the toolbox.  For example, it would
+# wipe away any automarking code that may be running and that would be annoying!
+
+# Section One: Stochastic demographic population model
+
+# Question 0
+
+state_initialise_adult <- function(num_stages,initial_size){
+
+}
+
+state_initialise_spread <- function(num_stages,initial_size){
+
+}
+
+# Question 1
+question_1 <- function(){
+
+  png(filename="question_1", width = 600, height = 400)
+  # plot your graph here
+  Sys.sleep(0.1)
+  dev.off()
+
+  return("type your written answer here")
+}
+
+# Question 2
+question_2 <- function(){
+
+  png(filename="question_2", width = 600, height = 400)
+  # plot your graph here
+  Sys.sleep(0.1)
+  dev.off()
+
+  return("type your written answer here")
+}
+
+# Questions 3 and 4 involve writing code elsewhere to run your simulations on the cluster
+
+
+# Question 5
+question_5 <- function(){
+
+  png(filename="question_5", width = 600, height = 400)
+  # plot your graph here
+  Sys.sleep(0.1)
+  dev.off()
+
+  return("type your written answer here")
+}
+
+# Question 6
+question_6 <- function(){
+
+  png(filename="question_6", width = 600, height = 400)
+  # plot your graph here
+  Sys.sleep(0.1)
+  dev.off()
+
+  return("type your written answer here")
+}
+
+
+# Section Two: Individual-based ecological neutral theory simulation 
+
+# Question 7
+species_richness <- function(community){
+
+}
+
+# Question 8
+init_community_max <- function(size){
+
+}
+
+# Question 9
+init_community_min <- function(size){
+
+}
+
+# Question 10
+choose_two <- function(max_value){
+
+}
+
+# Question 11
+neutral_step <- function(community){
+
+}
+
+# Question 12
+neutral_generation <- function(community){
+
+}
+
+# Question 13
+neutral_time_series <- function(community,duration)  {
+
+}
+
+# Question 14
+question_8 <- function() {
+
+
+
+  png(filename="question_14", width = 600, height = 400)
+  # plot your graph here
+  Sys.sleep(0.1)
+  dev.off()
+
+  return("type your written answer here")
+}
+
+# Question 15
+neutral_step_speciation <- function(community,speciation_rate)  {
+
+}
+
+# Question 16
+neutral_generation_speciation <- function(community,speciation_rate)  {
+
+}
+
+# Question 17
+neutral_time_series_speciation <- function(community,speciation_rate,duration)  {
+
+}
+
+# Question 18
+question_18 <- function()  {
+
+  png(filename="question_18", width = 600, height = 400)
+  # plot your graph here
+  Sys.sleep(0.1)
+  dev.off()
+
+  return("type your written answer here")
+}
+
+# Question 19
+species_abundance <- function(community)  {
+
+}
+
+# Question 20
+octaves <- function(abundance_vector) {
+
+}
+
+# Question 21
+sum_vect <- function(x, y) {
+
+}
+
+# Question 22
+question_22 <- function() {
+
+  png(filename="question_22", width = 600, height = 400)
+  # plot your graph here
+  Sys.sleep(0.1)
+  dev.off()
+
+  return("type your written answer here")
+}
+
+# Question 23
+neutral_cluster_run <- function(speciation_rate, size, wall_time, interval_rich, interval_oct, burn_in_generations, output_file_name) {
+
+}
+
+# Questions 24 and 25 involve writing code elsewhere to run your simulations on
+# the cluster
+
+# Question 26 
+process_neutral_cluster_results <- function() {
+
+
+  combined_results <- list() #create your list output here to return
+  # save results to an .rda file
+
+}
+
+plot_neutral_cluster_results <- function(){
+
+    # load combined_results from your rda file
+
+    png(filename="plot_neutral_cluster_results", width = 600, height = 400)
+    # plot your graph here
+    Sys.sleep(0.1)
+    dev.off()
+
+    return(combined_results)
+}
+
+
+# Challenge questions - these are substantially harder and worth fewer marks.
+# I suggest you only attempt these if you've done all the main questions. 
+
+# Challenge question A
+Challenge_A <- function(){
+
+  png(filename="Challenge_A", width = 600, height = 400)
+  # plot your graph here
+  Sys.sleep(0.1)
+  dev.off()
+
+}
+
+# Challenge question B
+Challenge_B <- function() {
+
+  png(filename="Challenge_B", width = 600, height = 400)
+  # plot your graph here
+  Sys.sleep(0.1)
+  dev.off()
+
+}
+
+# Challenge question C
+Challenge_B <- function() {
+
+  png(filename="Challenge_C", width = 600, height = 400)
+  # plot your graph here
+  Sys.sleep(0.1)
+  dev.off()
+
+}
+
+# Challenge question D
+Challenge_D <- function() {
+
+  png(filename="Challenge_D", width = 600, height = 400)
+  # plot your graph here
+  Sys.sleep(0.1)
+  dev.off()
+}
+
+# Challenge question E
+Challenge_E <- function() {
+
+  png(filename="Challenge_E", width = 600, height = 400)
+  # plot your graph here
+  Sys.sleep(0.1)
+  dev.off()
+
+  return("type your written answer here")
+}
+

content/HPC/Code/abc123_HPC_2024_neutral_cluster.R

@@ -0,0 +1,5 @@
+# CMEE 2024 HPC exercises R code pro forma
+# For neutral model cluster run
+
+rm(list=ls()) # good practice 
+source("abc123_HPC_2024_main.R")

content/HPC/Code/abc123_HPC_2024_test.R

@@ -0,0 +1,15 @@
+# CMEE 2024 HPC excercises R code HPC run code proforma
+
+rm(list=ls()) # good practice 
+source("abc123_HPC_2024_main.R")
+# it should take a faction of a second to source your file
+# if it takes longer you're using the main file to do actual simulations
+# it should be used only for defining functions that will be useful for your cluster run and which will be marked automatically
+
+# do what you like here to test your functions (this won't be marked)
+# for example
+species_richness(c(1,4,4,5,1,6,1))
+# should return 4 when you've written the function correctly for question 1
+
+# you may also like to use this file for playing around and debugging
+# but please make sure it's all tidied up by the time it's made its way into the main.R file or other files.