遍历一个列表，同时对另一个列表进行采样

Question

我正在尝试模拟鸟类相互配对的过程。我模拟了一群男性和女性（'agents_for_pairing'），该过程的工作方式是：

1) 如果繁殖季节的日期（“day”）与雄性可繁殖日期（aDate）相同，则雄性可在当天或之后的任何一天繁殖。

2）如果女性也有空（aDate = day[i]），那么它会随机选择一个可用的男性（尚未配对并且也有空）。如果有多个女性和男性可用，则代码应循环遍历每个女性，并在该特定日期将其与男性配对。

3) 如果雌性已准备好繁殖，但没有雄性可用，则其可用日期增加 1 (aDate + 1)，并在第二天再次尝试（并重复该过程直到配对）。

4) 个人配对后，他们会获取其配偶的 ID，并且他们的状态会发生变化（配对 == TRUE）。

我将种群分为雌性和雄性，然后循环浏览繁殖季节的每一天，以及每个可用的雌性（如果有的话）。我的代码如下所示：

library(tidyverse)

'%ni%' <- Negate('%in%')

agents_for_pairing <- tribble(
  ~id, ~mateID, ~sex, ~paired, ~aDate,
  34, NA, 'F', FALSE, 86,
  56, NA, 'F', FALSE, 90,
  14, NA, 'F', FALSE, 90,
  113, NA, 'M', FALSE, 86,
  2, NA, 'M', FALSE, 89,
  23, NA, 'M', FALSE, 87
)  
agents_for_pairing

# split into list by sex
agents_for_pairing <- agents_for_pairing %>%
  mutate(mateID = as.numeric(mateID)) %>%
  split(.$sex)
agents_for_pairing

day <- seq(86, 90, by=1) # days to loop through

for (i in seq_along(day)) { # for each day

  print(day[i])

    if (nrow(agents_for_pairing$F %>% filter(aDate == day[i] & paired == FALSE)) < 1) { # if there are no females available

      print('no females available') # do nothing but print this message

    } else {

      for (j in 1:nrow(agents_for_pairing$F %>% filter(aDate == day[i] & paired == FALSE))) { # go through female that is ready to breed

        if (nrow(agents_for_pairing$M %>% filter(id %ni% (agents_for_pairing$F$mateID) & aDate <= day[i] & paired == FALSE)) > 0) { # find a male that hasn't been taken yet & available

        mate <- sample_n(agents_for_pairing$M %>% filter(id %ni% (agents_for_pairing$F$mateID) & aDate <= day[i] & paired == FALSE), size=1, replace=FALSE) # randomly sample one mate

        agents_for_pairing$F[j,]$mateID <- mate[[1]] # make it your mate
        agents_for_pairing$F[j,]$paired <- TRUE # change status to paired now

        agents_for_pairing$M <- agents_for_pairing$M %>% # make sure paired male has same status and adopts female id
          mutate(
            mateID = case_when(
              id == mate$id ~ agents_for_pairing$F[j,]$id,
              TRUE ~ mateID
            ),
            paired = case_when( 
              mateID > 0 ~ TRUE, # males without a mate remain unpaired
              TRUE ~ FALSE
              )
            )

      } else {

        agents_for_pairing$F[j,]$paired <- FALSE # if no males available, remain unpaired
        agents_for_pairing$F <- agents_for_pairing$F %>%
            mutate(
              aDate = case_when(
                aDate == day[i] & paired == FALSE ~ aDate + 1, # and increase date available by a day
                TRUE ~ aDate
                )
              )
      }
    }
  }
}

agents_for_pairing

代码中似乎存在错误...并非所有雌性都能配对，即使有足够多的雄性：

$F
# A tibble: 3 x 5
     id mateID sex   paired aDate
  <dbl>  <dbl> <chr> <lgl>  <dbl>
1    34     23 F     TRUE      86
2    56      2 F     TRUE      90
3    14     NA F     FALSE     90

$M
# A tibble: 3 x 5
     id mateID sex   paired aDate
  <dbl>  <dbl> <chr> <lgl>  <dbl>
1   113     34 M     TRUE      86
2     2     56 M     TRUE      89
3    23     34 M     TRUE      87

这是一个比我过去尝试过的更复杂的 for 循环，我想知道是否存在索引问题？我认为在第二个 for 循环中，我尝试将每个可用的雌性配对，我可能错误地分配了它的配偶……有什么建议吗？应该看起来像这样：

$F
# A tibble: 3 x 5
id mateID sex   paired aDate
<dbl>  <dbl> <chr> <lgl>  <dbl>
1    34     113 F     TRUE      86
2    56      2 F     TRUE      90
3    14     23 F     FALSE     90

$M
# A tibble: 3 x 5
id mateID sex   paired aDate
<dbl>  <dbl> <chr> <lgl>  <dbl>
1   113     34 M     TRUE      86
2     2     56 M     TRUE      89
3    23     14 M     TRUE      87

Answer 1

这是一个有趣的问题。我从来没有弄清楚你的代码有什么问题，但这是我的。

library(tidyverse)

我将您的agents for pairing 标记为state：

state1 <- tribble(
  ~id, ~sex, ~aDate, ~mateID,
  34, 'F', 86, NA,
  56, 'F', 90, NA,
  14, 'F', 90, NA,
  113, 'M', 86, NA,
  2, 'M', 89, NA,
  23, 'M', 87, NA
)

minday <- min(state1$aDate)
maxday <- max(state1$aDate)

days <- seq(minday, maxday, 1)

定义一个stateframe 对象来保存所有的进化：

stateframe <- rep(NA, length(days)) %>% as.list()

按“日”命名各州：

names(stateframe) <- c(minday:maxday)

第一个状态框是你给的初始df：

stateframe[[1]] <- state1

辅助函数whichAvailable。输出是给定状态和性别的ids 列表：

whichAvailable <- function(date, mysex){ # date is in seq_along(days), sex as character M / F
return(
  stateframe[[date]] %>%
  mutate(available = ifelse(aDate <= as.numeric(names(stateframe[date])) &
                              is.na(mateID), TRUE, FALSE)) %>%
  filter(sex == mysex, available == TRUE) %>%
    select(id) %>%
    unlist() %>%
    as.numeric()
  )
}

外部序列循环通过天，内部序列循环通过相同的数据帧，直到找不到更多的配对。

for (i in seq_along(days)) {
  availablePairings <- c(length(whichAvailable(i, "F")), length(whichAvailable(i, "M")))
  # loop through day `i` until no more pairings can be found
  if (all(availablePairings > 0)) {
    # mate all available males and females
    for (j in 1:max(availablePairings)) {
      maleid <- whichAvailable(i,"M")[[1]] # pick the first male in the list
      femaleid <- whichAvailable(i, "F")[[1]] # pick the first female in the list
      stateframe[[i]][stateframe[[i]]$id == maleid,]$mateID <- femaleid
      stateframe[[i]][stateframe[[i]]$id == femaleid,]$mateID <- maleid
    }
  } 
  stateframe[[i + 1]] <- stateframe[[i]]
}

结果：

> stateframe[[5]]
# A tibble: 6 x 4
     id sex   aDate mateID
  <dbl> <chr> <dbl>  <dbl>
1    34 F        86    113
2    56 F        90      2
3    14 F        90     23
4   113 M        86     34
5     2 M        89     56
6    23 M        87     14