logo标签列表

根据条件将数据框中的值更改为它们所在的列名

rdplyrpurrr
4

我有一个数据框，长这样

set.seed(123)
test_data <- data.frame(id   = 1:6,
                        var1 = rbinom(n = 6, size = 1, prob = .5),
                        var2 = rbinom(n = 6, size = 1, prob = .5),
                        age  = sample(18:30, size = 6, replace = T))

我想使用 dplyr 或 purrr 来将 var1 和 var2 中等于 1 的值更改为其列名，并保留 0 的数值不变。

结果应该是这样的。

id    var1  var2    age
1     0     var2    26
2     var1  var2    25
3     0     var2    19
4     var1  0       29
5     var1  var2    21
6     0     0       18

我尝试使用dplyr::mutate_at

。

mutate_at(test_data,
          vars(var1, var2), 
          function(var_x) { ifelse(var_x == 1, colnames(var_x), var_x) })

这会返回以下错误。所以，可能不是最好的方法。

evalq(sys.calls(), ) 中的错误: replacement has length zero In addition: Warning message: In rep(yes, length.out = length(ans)) : 'x' is NULL so the result will be NULL

我已经尝试使用 purrr:map_at

map_at(test_data, 
       c("var1", "var2"), 
       function(var_x) { ifelse(var_x == 1, colnames(var_x), var_x) })

而这会返回以下错误。

Error in ans[test & ok] <- rep(yes, length.out = length(ans))[test & ok] : 替换的长度为零此外：警告信息：在rep（yes，length.out = length(ans)）中：'x'为NULL，因此结果将是NULL

虽然我更倾向于使用dplyr或purrr，但我也愿意尝试使用其他方法。

5个回答
6

这里有一个使用tidyverse的想法。关键在于首先进行gather操作，然后替换值，最后再进行spread操作。

library(tidyverse)

test_data %>% 
  gather(var, val, -c(id, age)) %>% 
  mutate(val = ifelse(val == 1, var, val)) %>% 
  spread(var, val)

#  id age var1 var2
#1  1  26    0 var2
#2  2  25 var1 var2
#3  3  19    0 var2
#4  4  29 var1    0
#5  5  21 var1 var2
#6  6  18    0    0
4

如果您使用中间对象，这样就不会太混乱：

ix <- which(test_data[2:3]==1,arr.ind=TRUE)
test_data[2:3][ix] <- names(test_data[2:3])[ix[,"col"]]

#  id var1 var2 age
#1  1    0 var2  26
#2  2 var1 var2  25
#3  3    0 var2  19
#4  4 var1    0  29
#5  5 var1 var2  21
#6  6    0    0  18

如果你正在处理大数据，这个过程应该相对快速，因为只需要进行一次<-赋值操作来替换。制作ix的开销不应该太大。

2

以下是一些基于R语言的解决方案：

# Solution 1
test_data[, 2:3] <- sapply(2:3, function(x) ifelse(test_data[x]==1, names(test_data[x]), 0))

# Solution 2
test_data[, c("var1", "var2")] <- sapply(c("var1", "var2"), function(x) ifelse(test_data[x]==1, x, 0))

# Solution 3 
for (i in 2:3) {test_data[,i] <- ifelse(test_data[,i] == 1, colnames(test_data[i]), 0)}

# Solution 4 - probably the most traightforward. Most of the job is vectorised
# works also for other values than 0 and 1
for (i in 2:3) {test_data[test_data[,i]==1,i] <- colnames(test_data[i])}

# etc...
或者使用Map - test_data[2:3] <- Map(function(x,y) replace(x,x==1,y), test_data[2:3], names(test_data[2:3]) ) - thelatemail
1
这是一个使用 data.table 的选项。
library(data.table)
dcast(melt(setDT(test_data), id.var = c('id', 'age'))[, 
  value := as.character(value)
       ][value == 1, value := as.character(variable)],
               id + age ~variable, value.var = "value")
#   id age var1 var2
#1:  1  26    0 var2
#2:  2  25 var1 var2
#3:  3  19    0 var2
#4:  4  29 var1    0
#5:  5  21 var1 var2
#6:  6  18    0    0

或者是由@thelatemail建议的选项。
cols <- c("var1","var2")
test_data[, (cols) := Map(function(x,y) replace(x,x==1,y), .SD, cols), .SDcols=cols]

另一种选择是使用来自 data.table 的 set。
setDT(test_data)
for(j in seq_along(cols)){
  set(test_data, i = NULL, j = cols[j], value = as.character(test_data[[cols[j]]]))
  set(test_data, i = which(test_data[[cols[j]]] == 1), j = cols[j], value = cols[j])
}
或者我们可以使用基本R方法。
d1 <- `dim<-`(names(test_data)[2:3][col(test_data[, 2:3])], dim(test_data[, 2:3]))
d1[test_data[, 2:3]==0] <- 0
test_data[, 2:3] <- d1
其实，我完全不明白我是如何进行那个替换的。data.table 不应该拒绝将数字列更新为字符类吗？ - thelatemail
@thelatemail 谢谢，我注意到了。不确定为什么使用 Map 不会出现错误，而使用 set 或 melt/dcast 会出现错误。是因为 replace 将 test_data[, var1 := replace(var1, var1==1, 'var1')]; test_data # id var1 var2 age #1: 1 0 1 26 #2: 2 var1 1 25 这个操作将列转换为 character 类型，而在 set 等操作中，我们只是替换了已经是 integer 的元素的一部分。 - akrun
0

我会使用这些行来做那件事，但作为一名学徒，我不确定它们是否太笨拙了：

test_data[test_data$var1==1,]$var1='var1'

test_data[test_data$var2==1,]$var2='var2'
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接