我有一个模拟的数据集，其中每一行都是一只单独的鸟，并且我编写了一些函数来确定每个单独的鸟是死还是死。个人是否生存的条件取决于其年龄段（AHY或HY）和性别（M或F）。我为每个年龄/性别组合创建了一个函数，并在mutate / case_when内使用pmap_chr，该函数应填写一个称为status的列。在我的代码中，这提供了“实时”或“死亡”的值。这是我的数据集的缩写版本：
library(tidyverse)
agents <- structure(list(id = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12,
13, 14, 15, 16, 17, 18), sex = c("F", "F", "F", "F", "F", "M",
"M", "M", "M", "M", "F", "F", "M", "M", "M", "M", "M", "M"),
class = c("AHY", "AHY", "AHY", "AHY", "AHY", "AHY", "AHY",
"AHY", "AHY", "AHY", "HY", "HY", "HY", "HY", "HY", "HY",
"HY", "HY"), hDateCtr = c(-0.84852029241304, 0.558881154137435,
-0.909711659654365, 1.21158907137824, -0.56296057862019,
-0.0938267631033649, -1.54202245448139, -0.216209497586015,
1.33397180586089, 1.06880921448181, -0.935414346693485, -0.935414346693485,
-0.935414346693485, -0.935414346693485, 0.935414346693485,
0.935414346693485, 0.935414346693485, 0.935414346693485),
aDateCtr = c(-1.13245629117638, 1.13245629117638, -0.490731059509763,
1.13245629117638, -0.641725231666613, 1.13245629117638, -1.13245629117638,
1.13245629117638, -0.490731059509763, -0.641725231666613,
NA, NA, NA, NA, NA, NA, NA, NA), selfOrig = c("imm", "imm",
"imm", "imm", "imm", "imm", "imm", "imm", "imm", "imm", "local",
"local", "local", "local", "local", "local", "local", "local"
), sameSexOrig = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
"imm", "imm", "imm", "imm", "imm", "imm", "imm", "imm"),
success = c(TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, TRUE,
TRUE, FALSE, FALSE, NA, NA, NA, NA, NA, NA, NA, NA), paired = c(TRUE,
TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE,
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE)), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -18L))
# A tibble: 18 x 9
id sex class hDateCtr aDateCtr selfOrig sameSexOrig success paired
<dbl> <chr> <chr> <dbl> <dbl> <chr> <chr> <lgl> <lgl>
1 1 F AHY -0.849 -1.13 imm NA TRUE TRUE
2 2 F AHY 0.559 1.13 imm NA TRUE TRUE
3 3 F AHY -0.910 -0.491 imm NA FALSE TRUE
4 4 F AHY 1.21 1.13 imm NA FALSE TRUE
5 5 F AHY -0.563 -0.642 imm NA FALSE TRUE
6 6 M AHY -0.0938 1.13 imm NA FALSE TRUE
7 7 M AHY -1.54 -1.13 imm NA TRUE TRUE
8 8 M AHY -0.216 1.13 imm NA TRUE TRUE
9 9 M AHY 1.33 -0.491 imm NA FALSE TRUE
10 10 M AHY 1.07 -0.642 imm NA FALSE TRUE
11 11 F HY -0.935 NA local imm NA FALSE
12 12 F HY -0.935 NA local imm NA FALSE
13 13 M HY -0.935 NA local imm NA FALSE
14 14 M HY -0.935 NA local imm NA FALSE
15 15 M HY 0.935 NA local imm NA FALSE
16 16 M HY 0.935 NA local imm NA FALSE
17 17 M HY 0.935 NA local imm NA FALSE
18 18 M HY 0.935 NA local imm NA FALSE
这是我编写的死亡率函数的一个示例，该函数已写入pmap_chr。如果我在具有单个年龄段或性别的数据集上运行以下代码，则所有这些都可以正常工作：
hDateEffect <- TRUE
winterTemp <- -3
# hatchling mortality -----------------------------------------------------
hatchMortInt <- -4.67
hatchMortIntSD <- 0.39
hatchMortBeta1 <- 0.6
hatchMortBeta1SD <- 0.27
hatchMortBeta2 <- 1.12
hatchMortBeta2SD <- 0.36
hatchMortBeta3 <- -0.3
hatchMortBeta3SD <- 0.16
hatchMortBeta4 <- -0.3
hatchMortBeta4SD <- 0.16
# male mortality ----------------------------------------------------------
maleMortInt <- -2.09
maleMortIntSD <- 0.32
maleMortBeta1 <- 0.81
maleMortBeta1SD <- 0.34
maleMortBeta2 <- -1.36
maleMortBeta2SD <- 0.84
maleMortBeta3 <- 1.67
maleMortBeta3SD <- 0.32
# female mortality --------------------------------------------------------
femMortInt <- -0.93
femMortIntSD <- 0.87
femMortBeta1 <- 1.59
femMortBeta1SD <- 0.35
femMortBeta2 <- -1.77
femMortBeta2SD <- 0.78
# hatch-year female
HY_female_mortality <- function(hDateCtr, sameSexOrig, ...) {
intercept <- rnorm(1, hatchMortInt, hatchMortIntSD)
beta2 <- rnorm(1, hatchMortBeta2, hatchMortBeta2SD)
beta4 <- rnorm(1, hatchMortBeta4, hatchMortBeta4SD)
if(hDateEffect == TRUE) {
beta3 <- rnorm(1, hatchMortBeta3, hatchMortBeta3SD)
} else {
beta3 <- 0
}
if (sameSexOrig == 'local') {
linSurv <- intercept + beta2 + (beta3 * hDateCtr) + (beta4 * winterTemp)
} else {
linSurv <- intercept + (beta3 * hDateCtr) + (beta4 * winterTemp)
}
probSurv <- plogis(linSurv)
randDraw <- runif(1, 0, 1)
if (randDraw > probSurv) {
val <- 'die'
return(val)
} else {
val <- 'live'
return(val)
}
}
# hatch-year male
HY_male_mortality <- function(hDateCtr, sameSexOrig, ...) {
intercept <- rnorm(1, hatchMortInt, hatchMortIntSD)
beta1 <- rnorm(1, hatchMortBeta1, hatchMortBeta1SD)
beta2 <- rnorm(1, hatchMortBeta2, hatchMortBeta2SD)
beta4 <- rnorm(1, hatchMortBeta4, hatchMortBeta4SD)
if(hDateEffect == TRUE) {
beta3 <- rnorm(1, hatchMortBeta3, hatchMortBeta3SD)
} else {
beta3 <- 0
}
if (sameSexOrig == 'local') {
linSurv <- intercept + beta1 + beta2 + (beta3 * hDateCtr) + (beta4 * winterTemp)
} else {
linSurv <- intercept + beta1 + (beta3 * hDateCtr) + (beta4 * winterTemp)
}
probSurv <- plogis(linSurv)
randDraw <- runif(1, 0, 1)
if (randDraw > probSurv) {
val <- 'die'
return(val)
} else {
val <- 'live'
return(val)
}
}
# after-hatch-year mortality functions
# after-hatch-year male
AHY_male_mortality <- function(aDateCtr, success, selfOrig, ...) {
intercept <- rnorm(1, maleMortInt, maleMortIntSD)
beta1 <- rnorm(1, maleMortBeta1, maleMortBeta1SD)
beta3 <- rnorm(1, maleMortBeta3, maleMortBeta3SD)
if(hDateEffect == TRUE) {
beta2 <- rnorm(1, hatchMortBeta3, hatchMortBeta3SD)
} else {
beta2 <- 0
}
if (success == TRUE) {
linSurv <- intercept + beta1 + (beta2 * aDateCtr)
} else {
linSurv <- intercept + (beta2 * aDateCtr)
}
if (selfOrig == 'local') {
linSurv <- linSurv + beta3
} else {
linSurv <- linSurv
}
probSurv <- plogis(linSurv)
randDraw <- runif(1, 0, 1)
if (randDraw > probSurv) {
val <- 'die'
return(val)
} else {
val <- 'live'
return(val)
}
}
# after-hatch-year female
AHY_female_mortality <- function(aDateCtr, success, ...) {
intercept <- rnorm(1, femMortInt, femMortIntSD)
beta1 <- rnorm(1, femMortBeta1, femMortBeta1SD)
beta2 <- rnorm(1, femMortBeta2, femMortBeta2SD)
if (success == TRUE) {
linSurv <- intercept + beta1 + (beta2 * aDateCtr)
} else {
linSurv <- intercept + (beta2 * aDateCtr)
}
probSurv <- plogis(linSurv)
randDraw <- runif(1, 0, 1)
if (randDraw > probSurv) {
val <- 'die'
} else {
val <- 'live'
}
return(val)
}
这是pmap_chr部分，该部分不适用于所有年龄和性别类别组合：
agents %>%
mutate(
status = case_when(
class == 'HY' & sex == 'F' ~ pmap_chr(., HY_female_mortality),
class == 'HY' & sex == 'M' ~ pmap_chr(., HY_male_mortality),
class == 'AHY' & sex == 'M' ~ pmap_chr(., AHY_male_mortality),
class == 'AHY' & sex == 'F' ~ pmap_chr(., AHY_female_mortality)
)
)
但是，如果我对另一个称为“成功”的逻辑（例如，如果（success == TRUE））执行相同的操作，则我实际上需要该条件基于该逻辑，它将产生错误：
Error in mutate_impl(.data, dots) :
Evaluation error: missing value where TRUE/FALSE needed.
我不知道为什么这些功能分开工作，而不是在包含所有年龄和性别类别的整个数据集上起作用。我有不同过程（复制，移民）的示例，在这些过程中我做类似的事情（获取数据集，编写在pmap中使用的函数，这些函数又在case_when和mutate中）。
答案 0 :(得分：0)
按年龄段拆分并采用类似的方法可以解决问题，但仍不确定为什么它无法按原始方式工作...
agents <- agents %>%
split(.$class)
agents$HY <- agents$HY %>%
mutate(
status = case_when(
sex == 'F' ~ pmap_chr(., HY_female_mortality),
sex == 'M' ~ pmap_chr(., HY_male_mortality)
)
)
agents$AHY <- agents$AHY %>%
mutate(
status = case_when(
sex == 'F' ~ pmap_chr(., AHY_female_mortality),
sex == 'M' ~ pmap_chr(., AHY_male_mortality)
)
)
agents <- agents %>%
bind_rows()
答案 1 :(得分：0)
针对A. Suliman的评论，我更改了功能，以便您可以看到它们为每个年龄段和性别提供了特定的值：
# hatch-year female
HY_female_mortality <- function(hDateCtr, sameSexOrig, ...) {
if(hDateEffect == TRUE) {
val <- 'hatch effect on'
} else {
val <- 'hatch effect off'
}
if (sameSexOrig == 'local') {
val <- paste0(val, ' and local')
} else {
val <- paste0(val, ' and immigrant')
}
return(paste0(val, ' and female HY'))
}
# hatch-year male
HY_male_mortality <- function(hDateCtr, sameSexOrig, ...) {
if(hDateEffect == TRUE) {
val <- 'hatch effect on'
} else {
val <- 'hatch effect off'
}
if (sameSexOrig == 'local') {
val <- paste0(val, ' and local')
} else {
val <- paste0(val, ' and immigrant')
}
return(paste0(val, ' and male HY'))
}
# after-hatch-year mortality functions
# after-hatch-year male
AHY_male_mortality <- function(aDateCtr, success, selfOrig, ...) {
if(hDateEffect == TRUE) {
val <- 'hatch effect on'
} else {
val <- 'hatch effect off'
}
if (success == TRUE) {
val <- paste0(val, ' and successful')
} else {
val <- paste0(val, ' and failed')
}
if (selfOrig == 'local') {
val <- paste0(val, ' and local')
} else {
val <- paste0(val, ' and immigrant')
}
return(paste0(val, ' and male AHY'))
}
# after-hatch-year female
AHY_female_mortality <- function(aDateCtr, success, ...) {
if(hDateEffect == TRUE) {
val <- 'hatch effect on'
} else {
val <- 'hatch effect off'
}
if (success == TRUE) {
val <- paste0(val, ' and successful')
} else {
val <- paste0(val, ' and failed')
}
return(paste0(val, ' and female AHY'))
}
agents <- agents %>%
split(.$class)
agents$HY %>%
mutate(
status = case_when(
sex == 'F' ~ pmap_chr(., HY_female_mortality),
sex == 'M' ~ pmap_chr(., HY_male_mortality)
)
)
agents$AHY %>%
mutate(
status = case_when(
sex == 'F' ~ pmap_chr(., AHY_female_mortality),
sex == 'M' ~ pmap_chr(., AHY_male_mortality)
)
)
这不正确吗？
> agents$HY
# A tibble: 8 x 10
id sex class hDateCtr aDateCtr selfOrig sameSexOrig success paired status
<dbl> <chr> <chr> <dbl> <dbl> <chr> <chr> <lgl> <lgl> <chr>
1 11 F HY -0.935 NA local imm NA FALSE hatch effect on and immigrant and female HY
2 12 F HY -0.935 NA local imm NA FALSE hatch effect on and immigrant and female HY
3 13 M HY -0.935 NA local imm NA FALSE hatch effect on and immigrant and male HY
4 14 M HY -0.935 NA local imm NA FALSE hatch effect on and immigrant and male HY
5 15 M HY 0.935 NA local imm NA FALSE hatch effect on and immigrant and male HY
6 16 M HY 0.935 NA local imm NA FALSE hatch effect on and immigrant and male HY
7 17 M HY 0.935 NA local imm NA FALSE hatch effect on and immigrant and male HY
8 18 M HY 0.935 NA local imm NA FALSE hatch effect on and immigrant and male HY
> agents$AHY
# A tibble: 10 x 10
id sex class hDateCtr aDateCtr selfOrig sameSexOrig success paired status
<dbl> <chr> <chr> <dbl> <dbl> <chr> <chr> <lgl> <lgl> <chr>
1 1 F AHY -0.849 -1.13 imm NA TRUE TRUE hatch effect on and successful and female AHY
2 2 F AHY 0.559 1.13 imm NA TRUE TRUE hatch effect on and successful and female AHY
3 3 F AHY -0.910 -0.491 imm NA FALSE TRUE hatch effect on and failed and female AHY
4 4 F AHY 1.21 1.13 imm NA FALSE TRUE hatch effect on and failed and female AHY
5 5 F AHY -0.563 -0.642 imm NA FALSE TRUE hatch effect on and failed and female AHY
6 6 M AHY -0.0938 1.13 imm NA FALSE TRUE hatch effect on and failed and immigrant and male AHY
7 7 M AHY -1.54 -1.13 imm NA TRUE TRUE hatch effect on and successful and immigrant and male AHY
8 8 M AHY -0.216 1.13 imm NA TRUE TRUE hatch effect on and successful and immigrant and male AHY
9 9 M AHY 1.33 -0.491 imm NA FALSE TRUE hatch effect on and failed and immigrant and male AHY
10 10 M AHY 1.07 -0.642 imm NA FALSE TRUE hatch effect on and failed and immigrant and male AHY