Question

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

1）如果繁殖季节的天数（“ day”）等于有雄性的日期（aDate），那么该雄性就可以在该天或之后的任何一天进行繁殖。

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

3）如果雌性已准备好繁殖，但没有雄性可用，则其可用日期将增加一（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。输出是id的列表，根据状态和性别，这些列表可用：

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

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

1 个答案: