├── figures └── mobility.png ├── loogetal2017.Rproj ├── 2D-sim-analysis.R ├── .gitignore ├── README.md ├── LICENSE ├── 2D-sim_model.v └── 2D-sim-model.R /figures/mobility.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/nevrome/loogetal2017/master/figures/mobility.png -------------------------------------------------------------------------------- /loogetal2017.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: XeLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | -------------------------------------------------------------------------------- /2D-sim-analysis.R: -------------------------------------------------------------------------------- 1 | library(magrittr) 2 | 3 | #### load data #### 4 | load("2D-sim-results.RData") 5 | sim_results <- final_output 6 | 7 | #### create distance matrizes #### 8 | 9 | # temporal distance 10 | time <- sim_results$n25 11 | temporal_distance_matrix <- time %>% dist %>% as.matrix 12 | 13 | # spatial distance 14 | space <- sim_results %>% dplyr::select(x, y) 15 | spatial_distance_matrix <- space %>% dist %>% as.matrix 16 | 17 | # genetic distance 18 | genes <- sim_results %>% dplyr::select(tidyselect::starts_with("X", ignore.case = F)) 19 | genetic_distance_matrix <- genes %>% dist %>% as.matrix 20 | 21 | #### measuring correlation #### 22 | tT <- vegan::mantel(genetic_distance_matrix, temporal_distance_matrix) 23 | sT <- vegan::mantel(genetic_distance_matrix, spatial_distance_matrix) 24 | 25 | 26 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Session Data files 6 | .RData 7 | 8 | # Example code in package build process 9 | *-Ex.R 10 | 11 | # Output files from R CMD build 12 | /*.tar.gz 13 | 14 | # Output files from R CMD check 15 | /*.Rcheck/ 16 | 17 | # RStudio files 18 | .Rproj.user/ 19 | 20 | # produced vignettes 21 | vignettes/*.html 22 | vignettes/*.pdf 23 | 24 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 25 | .httr-oauth 26 | 27 | # knitr and R markdown default cache directories 28 | /*_cache/ 29 | /cache/ 30 | 31 | # Temporary files created by R markdown 32 | *.utf8.md 33 | *.knit.md 34 | 35 | # Shiny token, see https://shiny.rstudio.com/articles/shinyapps.html 36 | rsconnect/ 37 | .Rproj.user 38 | 39 | # simulation results 40 | 2D-sim-results.RData 41 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | In this repository I'm playing with data and code provided by Loog et al 2017 for their paper 2 | 3 | Loog, L., Lahr, M. M., Kovacevic, M., Manica, A., Eriksson, A., & Thomas, M. G. (2017). Estimating mobility using sparse data: Application to human genetic variation. Proceedings of the National Academy of Sciences, 114(46), 12213–12218. https://doi.org/10.1073/pnas.1703642114 4 | 5 | Code and data are available here: https://github.com/LiisaLoog/SpaceTime-Framework (@LiisaLoog) 6 | Supplementary material: https://www.pnas.org/highwire/filestream/624605/field_highwire_adjunct_files/0/pnas.1703642114.sapp.pdf 7 | 8 | The result of my examination might be an interactive document like the one [here](https://github.com/nevrome/neiman1995). 9 | 10 | ### What I have done so far: 11 | 12 | - Translation of the 2D mobility model with constant migration rate from Python to R. 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | -------------------------------------------------------------------------------- /2D-sim_model.v: -------------------------------------------------------------------------------- 1 | import rand 2 | 3 | fn main() { 4 | 5 | rand.seed(time.now().uni) 6 | 7 | // ########################### 8 | // ### CONSTANT PARAMETERS ### 9 | // ########################### 10 | 11 | x_min := -4000 12 | x_max := 4000 13 | y_min := -4000 14 | y_max := 4000 15 | 16 | // population parameters 17 | generations := 20001 // number of steps in random walk 18 | in_entities := 1 // initial number of entities 19 | max_entities := 10000 // carrying capacity - maximum number of entities the modelled domain can sustain 20 | 21 | // craniometric (CM) measurement parameters 22 | num_CM_meas := 50 // total number of CM measurements considered 23 | 24 | // gaussian distribution parameters - for CM measurements 25 | CM_mu := 1000 // mean 26 | CM_sigma_frac := 0.05 // standard deviation of CM gaussian - proportion of mean (CM_mu): 0.005, 0.05, 0.5 27 | CM_sigma_val := CM_mu*CM_sigma_frac // standard deviation of CM gaussian - value (CM_mu*CM_sigma_frac) 28 | 29 | prob_fis := 0.1 // probability with which each entity fissions at each generation 30 | prob_dep := 0.00001 // probability with which each entity is sampled (data recorded to output) 31 | 32 | // ########################### 33 | // ### VARIABLE PARAMETERS ### 34 | // ########################### 35 | 36 | // gaussian distribution parameters - for migration 37 | mut mig_mu := 0 // mean 38 | // mut mig_sigma = random.randint(1,125) // 2.5 # # standard deviation: 2.5, 5, 7.5, 10 39 | mut mig_sigma := 18.72 // runif(1, 0, 100) 40 | 41 | // ################## 42 | // ### INITIALISE ### 43 | // ################## 44 | 45 | // initial (empty) array for storing population density values in 46 | mut entities := [0].repeat(generations) 47 | 48 | // initial positions 49 | x <- matrix(runif(entities, x_min, x_max), entities, 1) 50 | y <- matrix(runif(entities, y_min, y_max), entities, 1) 51 | 52 | x_original <- x 53 | y_original <- y 54 | 55 | // initial CM measurements 56 | CM_matrix <- matrix(CM_mu, entities, num_CM_meas) 57 | CM_sigma <- matrix(CM_sigma_val, num_CM_meas, 1) 58 | 59 | } 60 | -------------------------------------------------------------------------------- /2D-sim-model.R: -------------------------------------------------------------------------------- 1 | ########################### 2 | ### CONSTANT PARAMETERS ### 3 | ########################### 4 | 5 | # world parameters 6 | x_min <- -4000 7 | x_max <- 4000 8 | y_min <- -4000 9 | y_max <- 4000 10 | 11 | # population parameters 12 | generations <- 20001 # number of steps in random walk 13 | in_entities <- 1 # initial number of entities 14 | max_entities <- 10000 # carrying capacity - maximum number of entities the modelled domain can sustain 15 | 16 | # craniometric (CM) measurement parameters 17 | num_CM_meas <- 50 # total number of CM measurements considered 18 | 19 | # gaussian distribution parameters - for CM measurements 20 | CM_mu <- 1000 # mean 21 | CM_sigma_frac <- 0.05 # standard deviation of CM gaussian - proportion of mean (CM_mu): 0.005, 0.05, 0.5 22 | CM_sigma_val <- CM_mu*CM_sigma_frac # standard deviation of CM gaussian - value (CM_mu*CM_sigma_frac) 23 | 24 | prob_fis <- 0.1 # probability with which each entity fissions at each generation 25 | prob_dep <- 0.00001 # probability with which each entity is sampled (data recorded to output) 26 | 27 | 28 | ########################### 29 | ### VARIABLE PARAMETERS ### 30 | ########################### 31 | 32 | # gaussian distribution parameters - for migration 33 | mig_mu <- 0 # mean 34 | # mig_sigma = random.randint(1,125) # 2.5 # # standard deviation: 2.5, 5, 7.5, 10 35 | mig_sigma <- runif(1,0,100) 36 | 37 | 38 | ################## 39 | ### INITIALISE ### 40 | ################## 41 | 42 | # initial (empty) array for storing population density values in 43 | entities <- in_entities 44 | 45 | # initial positions 46 | x <- matrix(runif(entities, x_min, x_max), entities, 1) 47 | y <- matrix(runif(entities, y_min, y_max), entities, 1) 48 | 49 | x_original <- x 50 | y_original <- y 51 | 52 | # initial CM measurements 53 | CM_matrix <- matrix(CM_mu, entities, num_CM_meas) 54 | CM_sigma <- matrix(CM_sigma_val, num_CM_meas, 1) 55 | 56 | 57 | ########################### 58 | ### START OF SIMULATION ### 59 | ########################### 60 | 61 | rm("final_output") 62 | for (n in 0:generations) { 63 | 64 | print(paste('generation: ', n, ' ', 'number of entities: ', entities)) 65 | 66 | ### walk iteration ### 67 | xmove <- matrix(rnorm(entities, mig_mu, mig_sigma), entities, 1) # amount to move by in x direction 68 | ymove <- matrix(rnorm(entities, mig_mu, mig_sigma), entities, 1) # amount to move by in y direction 69 | 70 | # calculate new positions and check viability (geographical) 71 | xnew <- x + xmove # proposed x position 72 | xpos <- ifelse(xnew < x_min | xnew > x_max, x, xnew) # check geographical viability of proposed x position 73 | x <- xpos # new x position 74 | 75 | ynew <- y + ymove # proposed y position 76 | ypos <- ifelse(ynew < y_min | ynew > y_max, y, ynew) # check geographical viability of proposed y position 77 | y <- ypos # new y position 78 | 79 | 80 | ### fission / extinction iteration ### 81 | # entities undergo fission with probability == prob_fis 82 | CM_matrix_original <- CM_matrix 83 | fis <- runif(entities) # entities undergo fission if value in corresponding fis array <= prob_fis 84 | 85 | # FISSION PROCESS - duplicate data for entities that undergo fission in x, y and CM_matrix 86 | fis_entities_ind <- which(fis <= prob_fis) # indices of entities undergoing fission 87 | 88 | if (length(fis_entities_ind) > 0) { 89 | x <- rbind(x, x[fis_entities_ind, , drop = FALSE]) 90 | y <- rbind(y, y[fis_entities_ind, , drop = FALSE]) 91 | CM_matrix <- rbind(CM_matrix, CM_matrix_original[fis_entities_ind, , drop = FALSE]) 92 | } 93 | 94 | entities <- nrow(x) 95 | 96 | # check if number of entities has reached max_entities; if so: 97 | # EXTINCTION PROCESS - delete data for entities that undergo extinction from x, y and CM_matrix 98 | # if entities>max_entities: print 'THERE ARE MORE ENTITIES THAN MAX ENTITIES - AN EXTINCTION PROCESS SHOULD BE HAPPENING HERE!' 99 | CM_matrix_original <- CM_matrix 100 | 101 | if (entities > max_entities) { 102 | ext_entities_ind <- sample(0:entities, ifelse(entities >= max_entities, abs(entities - max_entities), 0)) # indices of surplus # of entities selected (random sampling) to undergo extinction 103 | 104 | if (length(ext_entities_ind) > 0) { 105 | x <- x[-ext_entities_ind, , drop = F] 106 | y <- y[-ext_entities_ind, , drop = F] 107 | CM_matrix = CM_matrix_original[-ext_entities_ind, , drop = F] 108 | entities = nrow(x) 109 | } 110 | 111 | } 112 | 113 | # check if all entities extinct 114 | if (entities == 0) { 115 | print(paste("All entities have gone extinct at iteration", n)) 116 | break 117 | } 118 | 119 | 120 | ### mutation iteration ### 121 | # NOTE! each CM measurement of each entity mutates (varies slightly) between generations 122 | # CM measurements vary according to gaussian distribution with mean CM_matrix and s.d. CM_sigma 123 | CM_matrix <- matrix( 124 | data = rnorm(entities * num_CM_meas, as.vector(CM_matrix), as.vector(CM_sigma)), 125 | entities, 126 | num_CM_meas 127 | ) 128 | CM_matrix <- abs(CM_matrix) 129 | 130 | 131 | ### feature depositing iteration ### 132 | # entities sampled with probability == prob_dep 133 | # for sampled entities, data recoded to output: 25*n, x, y, CM_matrix values 134 | if (n > generations/2) { 135 | dep <- rbinom(entities, 1, prob_dep) 136 | dep_entities_ind <- which(dep == 1) # indices of entities sampled 137 | if (length(dep_entities_ind) > 0) { 138 | dep_matrix <- data.frame( 139 | n25 = matrix(25*n, length(dep_entities_ind), 1), 140 | x = x[dep_entities_ind,], 141 | y = y[dep_entities_ind,], 142 | CM_matrix[dep_entities_ind, , drop = F] 143 | ) # 25*n (25 is the generation length in years?) , x, y and CM_matrix values for entities sampled 144 | if (!exists("final_output")) { 145 | final_output <- dep_matrix 146 | } else { 147 | final_output <- rbind(final_output, dep_matrix) 148 | } 149 | } 150 | } 151 | 152 | } 153 | 154 | ############################### 155 | ### SAVE SIMULATION RESULTS ### 156 | ############################### 157 | 158 | save(final_output, file = "2D-sim-results.RData") 159 | 160 | --------------------------------------------------------------------------------