使用dplyr和purrr函数模拟繁殖和继承

时间:2018-12-19 19:27:00

标签: r dplyr purrr

我正在尝试在R中建立一个基于个体的模型,该模型可以模拟鸟类的整个生命周期。因此,模拟的个体会繁殖,迁移,死亡等,并且这种循环持续了很多年。

我有一个初始的鸟类种群,它表示为每行包含一个个体及其属性的数据框。迁移,死亡率等被写成管道函数,将个人数据框作为输入。种群(下面的“代理商”数据框)繁殖,迁移,个体死亡等,看起来像这样:

agents <- agents %>%
    reproduce() %>%
    determine_migration_distance() %>%
    migrate() %>%
    mortality() %>%
    increment_age()

这将放置在for循环中,以使该循环每年重复50年,并且我将添加更多代码来存储每年感兴趣的数据。

我难以思考和创建的一个功能是模拟复制的功能。首先,雌性与雄性配对。其次,雌性决定产生的后代数量(基于基本的rmrm功能)。这仍然是我的“代理商”数据框,在此步骤中看起来像这样:

library(tidyverse)
agents <- structure(list(id = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 
101L, 102L, 103L, 104L, 105L, 106L, 107L, 108L, 109L, 110L), 
    mate = c(101L, 102L, 103L, 104L, 105L, 106L, 107L, 108L, 
    109L, 110L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L), sex = c("female", 
    "female", "female", "female", "female", "female", "female", 
    "female", "female", "female", "male", "male", "male", "male", 
    "male", "male", "male", "male", "male", "male"), ageClass = c("adult", 
    "adult", "adult", "adult", "adult", "adult", "adult", "adult", 
    "adult", "adult", "adult", "adult", "adult", "adult", "adult", 
    "adult", "adult", "adult", "adult", "adult"), migStrategy = c("migrant", 
    "resident", "resident", "migrant", "migrant", "resident", 
    "migrant", "resident", "migrant", "migrant", "resident", 
    "migrant", "resident", "migrant", "migrant", "migrant", "resident", 
    "resident", "resident", "resident"), numOffspring = c(4L, 
    5L, 5L, 5L, 5L, 3L, 4L, 4L, 4L, 4L, NA, NA, NA, NA, NA, NA, 
    NA, NA, NA, NA)), row.names = c(NA, -20L), class = c("tbl_df", 
"tbl", "data.frame"), spec = structure(list(cols = list(id = structure(list(), class = c("collector_integer", 
"collector")), mate = structure(list(), class = c("collector_integer", 
"collector")), sex = structure(list(), class = c("collector_character", 
"collector")), ageClass = structure(list(), class = c("collector_character", 
"collector")), migStrategy = structure(list(), class = c("collector_character", 
"collector")), numOffspring = structure(list(), class = c("collector_integer", 
"collector"))), default = structure(list(), class = c("collector_guess", 
"collector"))), class = "col_spec")) 

> agents
# A tibble: 20 x 6
      id  mate sex    ageClass migStrategy numOffspring
   <int> <int> <chr>  <chr>    <chr>              <int>
 1     1   101 female adult    migrant                4
 2     2   102 female adult    resident               5
 3     3   103 female adult    resident               5
 4     4   104 female adult    migrant                5
 5     5   105 female adult    migrant                5

“ id”是个人的标识符,“ mate”是伴侣的标识符。

然后,我可以创建仅包含后代的第二个数据框,我希望这些后代最终绑定到代理程序数据框,但是我需要让后代跟踪父母并从他们那里继承信息。现在,后代会照着母亲的身份证,像这样保持跟踪:

# function to determine sex
set_offspring_sex <- function(...) {
  randDraw <- runif(1, 0, 1)
  if (randDraw < 0.5) {
    val <- 'male'
  } else {
    val <- 'female'
  }
  return(val)
}

breedingFemales <- agents %>% 
  drop_na(numOffspring) # get rid of males

N <- as.vector(breedingFemales$numOffspring)

juv <- tibble(
  id = rep(seq(breedingFemales$id), times=N),
  mate = NA,
  sex = NA,
  ageClass = 'juvenile',
  migStrategy = NA,
  numOffspring = NA
)

juv <- juv %>%
  mutate(
    sex = pmap_chr(., set_offspring_sex)
  )
juv

但是,我希望雌性后代继承其母亲的迁移策略('migStrategy'),而雄性后代继承其父亲的迁移策略。链接这些数据帧是我遇到的困难。

在此步骤之前或之中,是否有更好的方法来构建数据帧?还有让后代继承此信息的dplyr或purrr方法吗?

1 个答案:

答案 0 :(得分:1)

以下是我在评论中说的一个实际例子:

library(dplyr)
library(tidyr)
library(purrr)

# join juv to agents table in order to get the parents ids
ag_juv <- breedingFemales %>% left_join(juv, by = "id", suffix = c("_ag", "_juv")) %>% 
  mutate(id_Mo = id, id_Fa = mate_ag) %>% 
  select(-contains("_ag"))

# join females to mothers to get mig strategy and give them a unique id
f_juv <- ag_juv %>% filter(sex_juv == "female") %>% 
  left_join(breedingFemales %>% select(id, migStrategy), by = c(id_Mo = "id")) %>% 
  mutate(migStrategy_juv = migStrategy,
         id = last(agents$id)+1:n()) %>% 
  select(-migStrategy) %>% 
  rename_at(vars(contains("_juv")), ~gsub("_juv", "", .))


# I will let you do the same for juv males


# append the juvs to the agents 

agents_gen2 <- agents %>% bind_rows(f_juv)