我有一个数据帧df，第一行是row1：
df <- data.frame(x = c(1,1,1,1,0,0,1), y = c(0,0,0,0,1,1,0), z = c(1,0,0,0,0,1,1))
> df
x y z
1 1 0 1
2 1 0 0
3 1 0 0
4 1 0 0
5 0 1 0
6 0 1 1
7 1 0 1
> row1 <- df[1,]
> row1
x y z
1 1 0 1
对于第1行，我想在与row1中的其他列（x和y）具有相同值的行中提取列z的平均值。我想将此值存储在名为prob_z的新列中。
在这个例子中，由于有5行，x和y分别为1和0，其中2行有z = 1，3行有z = 0，我会在第1行附加一列prob_z值2 /（2 + 3）= 0.4。我会类似地计算每行和相应列的prob_x，prob_y和prob_z的值，并将它们存储为df中的列。因此，在每行和每列进行所有这些计算之后，我想最终得到：
x y z prob_x prob_y prob_z
1 1 0 1 1.0 0.0 0.4
2 1 0 0 1.0 0.0 0.4
3 1 0 0 1.0 0.0 0.4
4 1 0 0 1.0 0.0 0.4
5 0 1 0 0.0 1.0 0.5
6 0 1 1 0.0 1.0 0.5
7 1 0 1 1.0 0.0 0.4
我还需要通过名称引用列，因为在＆＃34; z＆＃34;中，因为在我的实例中，我有大量的列。
我尝试过使用base R和dplyr的不同方法，但是很难按预期获得结果。
答案 0 :(得分：2)
好吧，我想我有。这是一系列有趣的挑战，虽然比我预期的更具挑战性。我相信它对任意数量的列和任何类型的名称都很健壮，但我肯定是错的。
首先，我定义了一个函数，它检查所有列除了感兴趣的列以查看它们是否匹配。请注意，它显式调用df和row1，而不是尝试将这些值作为变量传递。可能不理想，但应该适用于这种情况：
myFunction <-
function(thisCol){
apply(select_(df, paste0("-`", thisCol,"`"))
, 1
, function(thisRow) {
all(thisRow == select_(row1, paste0("-`", thisCol,"`")))
})
}
然后，我使用interp中的lazyeval来生成一个列，告知是否存在匹配项。回想一下，“匹配”实际检查是否所有其他列都匹配第一行，而不是这一列是否匹配。
library(lazyeval)
forMatchID <-
lapply(names(df), function(thisColName){
interp(~myFunction(colName), colName = thisColName)
}) %>%
setNames(paste("Match", names(df)))
返回：
$`Match x`
~myFunction("x")
<environment: 0x110feb20>
$`Match y`
~myFunction("y")
<environment: 0x11103da8>
$`Match z`
~myFunction("z")
<environment: 0x111080c8>
然后，我用它生成一个data.frame，表示该列是否有可接受的匹配（同样，匹配第1行的所有其他匹配）：
dfWithMatchCols <-
df %>%
mutate_(.dots = forMatchID)
返回：
x y z Match x Match y Match z
1 1 0 1 TRUE TRUE TRUE
2 1 0 0 FALSE FALSE TRUE
3 1 0 0 FALSE FALSE TRUE
4 1 0 0 FALSE FALSE TRUE
5 0 1 0 FALSE FALSE FALSE
6 0 1 1 FALSE FALSE FALSE
7 1 0 1 TRUE TRUE TRUE
然后，我生成一组要生成的新列，这里生成与第一行（在其他列上）匹配的行的比例 - 或那些不具有值1的行的比例该专栏：
forProb <-
paste0("ifelse(`Match ", names(df), "`"
, ", mean(`", names(df), "`[`Match ", names(df), "`])"
, ", mean(`", names(df), "`[!`Match ", names(df), "`]) )") %>%
setNames(paste0("prob_", names(df)))
返回
prob_x
"ifelse(`Match x`, mean(`x`[`Match x`]), mean(`x`[!`Match x`]) )"
prob_y
"ifelse(`Match y`, mean(`y`[`Match y`]), mean(`y`[!`Match y`]) )"
prob_z
"ifelse(`Match z`, mean(`z`[`Match z`]), mean(`z`[!`Match z`]) )"
最后，我将其传递到mutate_并删除“Match”列（请注意，如果列开始时可能会意外删除列，但这可能也会导致上面的冲突）：
dfWithProb <-
dfWithMatchCols %>%
mutate_(.dots = forProb) %>%
select(-starts_with("Match"))
返回：
x y z prob_x prob_y prob_z
1 1 0 1 1.0 0.0 0.4
2 1 0 0 0.6 0.4 0.4
3 1 0 0 0.6 0.4 0.4
4 1 0 0 0.6 0.4 0.4
5 0 1 0 0.6 0.4 0.5
6 0 1 1 0.6 0.4 0.5
7 1 0 1 1.0 0.0 0.4
在实践中，您可能不会生成中间步骤，而是像这样运行它：
df %>%
mutate_(.dots = forMatchID) %>%
mutate_(.dots = forProb) %>%
select(-starts_with("Match"))
现在，如果我误解了您的“匹配”参数，那么对myFunction定义的简单更改应该传播到流程中的所有其他步骤。
根据评论，您实际上只想要一个输出，仅预测那些与所有其他元素匹配的概率。我认为使用summarise_可能会更好，例如：
forSingProb <-
paste0("mean(`", names(df), "`[`Match ", names(df), "`])") %>%
setNames(paste0("prob_", names(df)))
df %>%
mutate_(.dots = forMatchID) %>%
summarise_(.dots = forSingProb)
返回：
prob_x prob_y prob_z
1 1 0 0.4
好的，在评论中有几处更新后，我认为这应该有效。我使用上面的summarise_方法，在lapply中分别循环遍历每一行，并从分析中删除正在调查的行（包含感兴趣的值不应该在结果），然后将所有内容与bind_rows绑定在一起并加入原始数据：
myFunction_updated <-
function(thisCol, rowIndex){
apply(select_(df[-rowIndex, ], paste0("-`", thisCol,"`"))
, 1
, function(thisRow) {
all(thisRow == select_(df[rowIndex, ], paste0("-`", thisCol,"`")))
})
}
forSingProb <-
paste0("mean(`", names(df), "`[`Match ", names(df), "`])") %>%
setNames(paste0("prob_", names(df)))
lapply(1:nrow(df), function(thisRowIndex){
forMatchID <-
lapply(names(df), function(thisColName){
interp(~myFunction_updated(colName, rowIndex)
, colName = thisColName
, rowIndex = thisRowIndex)
}) %>%
setNames(paste("Match", names(df)))
df[-thisRowIndex, ] %>%
mutate_(.dots = forMatchID) %>%
summarise_(.dots = forSingProb)
}) %>%
bind_rows(.id = "rowIndex") %>%
left_join(mutate(df, rowIndex = as.character(1:n()))
, .)
返回：
x y z rowIndex prob_x prob_y prob_z
1 1 0 1 1 1 0 0.25
2 1 0 0 2 1 0 0.50
3 1 0 0 3 1 0 0.50
4 1 0 0 4 1 0 0.50
5 0 1 0 5 NaN NaN 1.00
6 0 1 1 6 NaN NaN 0.00
7 1 0 1 7 1 0 0.25
请注意，NaN值是正确的，因为没有匹配的行。
如果你坚持在你的预测中包含观察到的值（我想强调几乎肯定是个坏主意），你可以像这样调整它：
myFunction_updated <-
function(thisCol, rowIndex){
apply(select_(df, paste0("-`", thisCol,"`"))
, 1
, function(thisRow) {
all(thisRow == select_(df[rowIndex, ], paste0("-`", thisCol,"`")))
})
}
forSingProb <-
paste0("mean(`", names(df), "`[`Match ", names(df), "`])") %>%
setNames(paste0("prob_", names(df)))
lapply(1:nrow(df), function(thisRowIndex){
forMatchID <-
lapply(names(df), function(thisColName){
interp(~myFunction_updated(colName, rowIndex)
, colName = thisColName
, rowIndex = thisRowIndex)
}) %>%
setNames(paste("Match", names(df)))
df %>%
mutate_(.dots = forMatchID) %>%
summarise_(.dots = forSingProb)
}) %>%
bind_rows(.id = "rowIndex") %>%
left_join(mutate(df, rowIndex = as.character(1:n()))
, .)
给出了：
x y z rowIndex prob_x prob_y prob_z
1 1 0 1 1 1 0 0.4
2 1 0 0 2 1 0 0.4
3 1 0 0 3 1 0 0.4
4 1 0 0 4 1 0 0.4
5 0 1 0 5 0 1 0.5
6 0 1 1 6 0 1 0.5
7 1 0 1 7 1 0 0.4
为什么我不能单独留下这个？无论如何，这是对逻辑下一步的扩展。我的猜测是，这将用于预测给定集合中的缺失变量。例如，这可能是在您的实际应用程序中生成的。具体来说，它对1或2个变量进行采样，并将每个变量随机设置为0或1。
productionData <-
lapply(1:10, function(idx){
nToSample <- sample(1:2, 1)
sample(c(0,1), nToSample, replace = TRUE) %>%
setNames(sample(c("x","y","z"), nToSample))
})
然后，我们可以遍历每个，将已知数据过滤到所有点上匹配的数据，然后计算所有剩余变量的概率。最后的bind_rows和select仅适用于漂亮的打印。根据使用情况，此步骤可能会或可能不会更有用。特别是，如果任何变量总是或永远不存在，这将失败（因为没有prob_*值或该变量列没有条目）
lapply(productionData, function(thisRowIn){
filtering <-
lapply(names(thisRowIn), function(thisCol){
paste0("`", thisCol, "` == ", thisRowIn[thisCol])
})
whichMissing <-
names(df)[!(names(df) %in% names(thisRowIn))]
df %>%
filter_(.dots = filtering) %>%
summarise_at(whichMissing, mean) %>%
setNames(paste0("prob_", names(.))) %>%
mutate_(.dots = as.list(thisRowIn))
}) %>%
bind_rows() %>%
select_(.dots = c(names(df), paste0("prob_", names(df))))
返回：
x y z prob_x prob_y prob_z
1 NA 1 NA 0.00 NA 0.5
2 NA 0 NA 1.00 NA 0.4
3 0 1 NA NA NA 0.5
4 NA 1 1 0.00 NA NA
5 1 NA 1 NA 0.00 NA
6 1 0 NA NA NA 0.4
7 NA NA 0 0.75 0.25 NA
8 1 0 NA NA NA 0.4
9 NA 0 NA 1.00 NA 0.4
10 1 NA 1 NA 0.00 NA
NA，其中缺少值且不需要预测。
答案 1 :(得分：1)
如果我们这样做会接受吗？
df %>% group_by(x) %>% mutate(prob_x = sum(x) / n(),
prob_y = sum(y) / n(),
prob_z = sum(z) / n())
Source: local data frame [7 x 6]
Groups: x [2]
x y z prob_x prob_y prob_z
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 0 1 1 0 0.4
2 1 0 0 1 0 0.4
3 1 0 0 1 0 0.4
4 1 0 0 1 0 0.4
5 0 1 0 0 1 0.5
6 0 1 1 0 1 0.5
7 1 0 1 1 0 0.4
答案 2 :(得分：0)
这个解决方案由Nathan Day的方法，Mark Peterson使用mutate_和this SO question组成 - 这应该很好地概括。
df <- data.frame(x = c(1,1,1,1,0,0,1), y = c(0,0,0,0,1,1,0), z = c(1,0,0,0,0,1,1))
for(i in 1:3) {
dots <- paste("mean(", names(df[i]), ")")
df <- df %>%
group_by_(.dots = lapply(names(df)[-i], as.symbol)) %>%
mutate_(.dots = setNames(dots, paste("prob_", names(df[i]) )))
}
df
x y z prob_x prob_y prob_z
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 0 1 1 0 0.4
2 1 0 0 1 0 0.4
3 1 0 0 1 0 0.4
4 1 0 0 1 0 0.4
5 0 1 0 0 1 0.5
6 0 1 1 0 1 0.5
7 1 0 1 1 0 0.4