有条件地将数据框中的值更改为其列名

Question

我有一个看起来像这样的数据框

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) })

这个returns下面的错误。所以，可能不是最好的方法。

Error in 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) })

还有这个returns这个错误。

Error in ans[test & ok] <- rep(yes, length.out = length(ans))[test & ok] : replacement has length zero In addition: Warning message: In rep(yes, length.out = length(ans)) : 'x' is NULL so the result will be NULL

虽然我更喜欢使用 dplyr 或 purrr，但我愿意接受使用其他方法的建议。

Answer 1

这是来自 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

Answer 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...

Answer 3

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

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的开销应该不会太大。

Answer 4

这是一个使用 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]

或者另一个选项是 set 来自 data.table

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])
}

或者我们可以使用base 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

Answer 5

我会用这些台词来做，不确定，我是学徒，是不是太笨拙了：

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

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

有条件地将数据框中的值更改为其列名

Conditionally change values in a data frame to their column name

r

dplyr

purrr