在數據幀的列有條件變化值命名

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更改等於1 var1和var2值的數據幀，到他們的列的名稱，並保持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（））：置換具有長度 零此外：警告消息：在代表（是的，length.out = 長度（ANS））： 'x' 爲NULL這樣的結果將是NULL

而且我一直在使用purrr:map_at

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

嘗試和這個返回此錯誤。

錯誤ANS [測試& OK] < - 代表（是的，length.out =長度（ANS））[試驗& OK]：更換具有長度零此外：警告消息：在 代表（是的，length.out =長度（ANS））：「x」爲NULL，那麼結果將是 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] 

建議的選項，或者另一種選擇是從setdata.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