dplyr使用其他列的复杂用户定义函数创建一个新列

我有一个包含40个问题答案的大数据框（reprex，下面有3个问题），需要计算一个新列，它是这40个答案的复杂函数。由于几乎不可能在

mutate

中写出函数，因此我尝试创建一个可以在

mutate

中使用的函数

f

df <- data.frame(Sex = c(rep("F", 5), rep("M", 5)),
                 Q1  = sample(0:10, 10, replace=T),
                 Q2  = sample(0:10, 10, replace=T),
                 Q3  = sample(0:10, 10, replace=T)
)

f <- function(q1, q2, q3){
  y <- q1 + (q2^2) - (q3^3)
  return(y)
} 

同样

 df$newcol <- mapply(f, df$Q1, df$Q2, df$Q3)

我马上就遇到了一场灾难：

df %>%
+   mutate(newcol = f(Q1, Q2, Q3))
   Sex Q1 Q2 Q3 newcol
1    F 10  6  3     19
2    F  0  9  9   -648
3    F  8  1  2      1
4    F  0  4  7   -327
5    F  6  4  1     21
6    M  8  3  3    -10
7    M  2  2  0      6
8    M 10  0  3    -17
9    M  6  9  3     60
10   M  1  7  2     42
Warning message:
Problem with `mutate()` input `newcol`.
i the condition has length > 1 and only the first element will be used
i Input `newcol` is `f(Q1, Q2, Q3)`. 

但是,

df$newcol <- mapply(f, df$Q1, df$Q2, df$Q3)
df
   Sex Q1 Q2 Q3 newcol
1    F 10  6  3     19
2    F  0  9  9    648
3    F  8  1  2      1
4    F  0  4  7    327
5    F  6  4  1     21
6    M  8  3  3     10
7    M  2  2  0      6
8    M 10  0  3     17
9    M  6  9  3     60
10   M  1  7  2     42

df$newcol=THRESHOLD\u MDD\u GAD）{
焦虑=阈值（MDD和GAD）{
担心您得到“条件的长度大于1，只使用第一个元素”警告的原因是，如果将
与向量组合使用（例如，请参见）。
dpylr
的
mutate
将值的“整个”向量传递给被调用的函数（即，不（行）元素）.这就是
if
语句被混淆的地方

这就解决了您的问题：

df <- data.frame(Sex = c(rep("F", 5), rep("M", 5)),
                 Q1  = sample(0:10, 10, replace=T),
                 Q2  = sample(0:10, 10, replace=T),
                 Q3  = sample(0:10, 10, replace=T)
)

f <- function(q1, q2, q3){
  y <- q1 + (q2^2) - (q3^3)
  y <- ifelse(y<0, -y, y)
  return(y)
} 

df %>%
  mutate(newcol = f(Q1, Q2, Q3))

基本上，带有
if
语句的函数没有矢量化。您有两个选项

使函数矢量化（使用
ifelse
或任何其他方式），并继续使用
mutate
，就像前面一样
如果条件太复杂，您无法对函数进行矢量化，请使用
rowwise
或
pmap
一次操作一行。这类似于您的
mappy
尝试
要进一步阐述我的上述评论：

f <- function(data, conditions) {
  columnNames <- names(conditions)
  for (colName in columnNames) {
    qName <- enquo(colName)
    data <- data %>% mutate(!!qName := eval(conditions[[colName]]))
  }
  data
}

df %>% f(list(bigQ1=expression(Q1 > 7), smallQ2=expression(Q2 < 2)))

将df作为函数的第一个参数进行传递可以进行管道处理。
y如果主要关注的是参数的数量（40确实太多了！）考虑你的数据：有两个列，一个是问号，一个是回答问题，另一个是，你可以把你的条件作为一个命名的列表，列出新的列名的列表的名称和给出表达式的列表的值，以评估在这个非常简单的C中填充新的列。如果确实如此-谢谢。但一般情况下有许多不同的条件以及它们的布尔组合。我如何解决一般问题？你能用适合你所遇到问题的MRE扩展你的问题吗？
questions <- c("df$Q1", "df$Q2", "df$Q3") 
df$newcol <- mapply(f, questions)

if(!is.na(df[i, "Q1_Daily_Mean"]) & df[i, "Q1_Daily_Mean"] >= THRESHOLD_MDD_GAD){
  anxiety <- TRUE
}

if(!is.na(df[i, "Q2_Daily_Mean"]) & df[i, "Q2_Daily_Mean"] >= THRESHOLD_MDD_GAD){
  worry <- TRUE
}

if(anxiety && worry){
  anxiety_and_worry <- TRUE
}

if(!is.na(df[i, "Q3_Daily_Mean"]) & df[i, "Q3_Daily_Mean"] >= THRESHOLD_MDD_GAD ){
  agitation <- TRUE
}

if(!is.na(df[i, "Q10_Daily_Mean"]) & df[i, "Q10_Daily_Mean"] >= THRESHOLD_MDD_GAD ){
  anger <- TRUE
}

if(!is.na(df[i, "Q2_Weekly"]) & df[i, "Q2_Weekly"] >= THRESHOLD_MDD_GAD ){
  physical_fatigue <- TRUE
}

if(!is.na(df[i, "Q5_Weekly"]) & df[i, "Q5_Weekly"] >= THRESHOLD_MDD_GAD ){
  no_concentration <- TRUE
}

if(!is.na(df[i, "Q7_Weekly"]) & df[i, "Q7_Weekly"] >= THRESHOLD_MDD_GAD ){
  disturbed_sleep <- TRUE
}

if(!is.na(df[i, "Q13_Weekly"]) & !is.na(df[i, "Q14_Weekly"]) &
   !is.na(df[i, "Q15_Weekly"]) & !is.na(df[i, "Q16_Weekly"]) & 
   !is.na(df[i, "Q17_Weekly"]) & 
   max( df[i, "Q13_Weekly"], df[i, "Q14_Weekly"],
        df[i, "Q15_Weekly"], df[i, "Q16_Weekly"],
        df[i, "Q17_Weekly"] ) >= THRESHOLD_MDD_GAD){
  max_function  <- TRUE
}

sum_of_symptoms_7 <- anxiety + worry + agitation + anger + 
                     physical_fatigue + no_concentration + disturbed_sleep

if (anxiety_and_worry && (sum_of_symptoms_7 >= CRITERIA_NEEDED_GAD) && max_function){
  # Generalized Anxiety Disorder
  df[i, GAD_DESCRIPTPR_EML] <- TRUE
}

df <- data.frame(Sex = c(rep("F", 5), rep("M", 5)),
                 Q1  = sample(0:10, 10, replace=T),
                 Q2  = sample(0:10, 10, replace=T),
                 Q3  = sample(0:10, 10, replace=T)
)

f <- function(q1, q2, q3){
  y <- q1 + (q2^2) - (q3^3)
  y <- ifelse(y<0, -y, y)
  return(y)
} 

df %>%
  mutate(newcol = f(Q1, Q2, Q3))

   Sex Q1 Q2 Q3 newcol
1    F  8  6  3     17
2    F  6  0  0      6
3    F  4  5  7    314
4    F  9  5  7    309
5    F  3  5  9    701
6    M  1 10  5     24
7    M 10  5  4     29
8    M  4  0  3     23
9    M  8  4  7    319
10   M  3  6  3     12

library(dplyr)
library(purrr)

df %>% mutate(newcol = f(Q1, Q2, Q3))

df %>% mutate(newcol = pmap_dbl(list(Q1, Q2, Q3), ~f(..1, ..2, ..3)))

f <- function(data, conditions) {
  columnNames <- names(conditions)
  for (colName in columnNames) {
    qName <- enquo(colName)
    data <- data %>% mutate(!!qName := eval(conditions[[colName]]))
  }
  data
}

df %>% f(list(bigQ1=expression(Q1 > 7), smallQ2=expression(Q2 < 2)))

   Sex Q1 Q2 Q3 bigQ1 smallQ2
1    F  2  9  9 FALSE   FALSE
2    F  2 10  6 FALSE   FALSE
3    F  9  4  9  TRUE   FALSE
4    F  1  2  8 FALSE   FALSE
5    F  5 10  2 FALSE   FALSE
6    M 10  8  3  TRUE   FALSE
7    M  4  8  0 FALSE   FALSE
8    M  3  8 10 FALSE   FALSE
9    M  5  2  6 FALSE   FALSE
10   M  8  7  4  TRUE   FALSE