按顺序粘贴列名

Question

大家好，新年快乐。

我有一个棘手的任务（在我看来），我找不到解决它的方法。 请参阅以下玩具数据。原始数据集有数百列/行。

test<-data.frame(name=c("Amber","Thomas","Stefan","Zlatan"),
             US=c(8,2,NA,7),
             UK=c(5,4,1,7))

我想创建一个名为“origin”的新列，它粘贴由“|”分隔的每个单元格的列名（不带 NA）考虑到相应的值。应首先粘贴较高的值。至于相同的值（如 Zlatan），顺序不相关。 Zlatan 的输出可以是 US|UK 或 UK|US。

这是所需的输出：

我尝试了几个小时来解决它，但没有任何方法奏效。将值转换为.factor 可能有意义...

非常感谢您的帮助。提前谢谢！

Answer 1

这是dplyr 方法。首先，我们可以使用rowwise 独立处理各个行。接下来，我们可以使用c_across，它允许我们仅从该行中选择值。我们可以根据US 和UK 列是否不是NA 来子集c("US","UK") 的向量。

paste 和 collapse = "|" 允许我们将值与分隔符放在一起。我添加了一行，看看如果它们都是 NA 会发生什么。

library(dplyr)
test %>%
   rowwise() %>%
   mutate(origin = paste(c("US","UK")[rev(order(c_across(US:UK), na.last = NA))], collapse = "|"))
# A tibble: 5 x 4
# Rowwise: 
  name      US    UK origin 
  <chr>  <dbl> <dbl> <chr>  
1 Amber      8     5 "US|UK"
2 Thomas     2     4 "UK|US"
3 Stefan    NA     1 "UK"   
4 Zlatan     7     7 "UK|US"
5 Bob       NA    NA ""      

这也被简单地扩展为更多列：

test<-data.frame(name=c("Amber","Thomas","Stefan","Zlatan","Bob"),
                 US=c(8,2,NA,7,NA),
                 UK=c(5,4,1,7,NA),
                 AUS=c(1,2,NA,NA,1))

test %>%
   rowwise() %>%
   mutate(origin = paste(c("US","UK","AUS")[rev(order(c_across(US:AUS), na.last = NA))], collapse = "|"))
# A tibble: 5 x 5
# Rowwise: 
  name      US    UK   AUS origin   
  <chr>  <dbl> <dbl> <dbl> <chr>    
1 Amber      8     5     1 US|UK|AUS
2 Thomas     2     4     2 UK|AUS|US
3 Stefan    NA     1    NA UK       
4 Zlatan     7     7    NA UK|US    
5 Bob       NA    NA     1 AUS   

或者在 tidyselect 的帮助下执行除 name 之外的所有列：

test %>%
  rowwise() %>%
  mutate(origin = paste(names(across(-name))[rev(order(c_across(-name), na.last = NA))], collapse = "|"))

Answer 2

tidyverse 的另一种可能性。它比其他两种解决方案要长，但它应该可以直接使用包含所需列数的数据框。

我将数据框更改为长格式，过滤掉 NA，按名称分组，使用粘贴进行汇总，并与原始数据框连接以获得原始列（以及所有 NA 的行）。

library(tidyverse)

test<-data.frame(name=c("Amber","Thomas","Stefan","Zlatan","Bob"),
                 US=c(8,2,NA,7,NA),
                 UK=c(5,4,1,7,NA),
                 AUS=c(1,2,NA,NA,1))
test %>%
  # change to long format
  tidyr::pivot_longer(cols=-name, names_to = "country", values_to = "value") %>%
  # remove rows with NA
  dplyr::filter(!is.na(value)) %>%
  # group by name and sort
  dplyr::group_by(name) %>% dplyr::arrange(-value) %>%
  # create summary of countries for each name in column 'origin'
  dplyr::summarise(origin=paste(country, collapse = "|")) %>%
  # join with original data frame to include original columns (and names with only NA) and change NA to '' in origin
  dplyr::right_join(test, by='name') %>% dplyr::mutate(origin=ifelse(is.na(origin), '', origin)) %>%
  # move origin column to end
  dplyr::relocate(origin, .after = last_col())

结果

name      US    UK   AUS origin   
  <chr>  <dbl> <dbl> <dbl> <chr>    
1 Amber      8     5     1 US|UK|AUS
2 Bob       NA    NA     1 AUS      
3 Stefan    NA     1    NA UK       
4 Thomas     2     4     2 UK|US|AUS
5 Zlatan     7     7    NA US|UK

Answer 3

这是使用case_when 的不同tidyverse 解决方案：

library(tidyverse)
data <- data.frame (test<-data.frame(
    "name" =c("Amber","Thomas","Stefan","Zlatan"),
    "US" =c(8,2,NA,7),
    "UK" =c(5,4,1,7)))

data <- data %>% mutate(origin = case_when( US >  UK ~ "US|UK", 
                                    UK >= US ~ "UK|US",
                                    is.na(UK) & !is.na(US) ~ "US", 
                                    is.na(US) & !is.na(UK) ~ "UK"))
data
#>     name US UK origin
#> 1  Amber  8  5  US|UK
#> 2 Thomas  2  4  UK|US
#> 3 Stefan NA  1     UK
#> 4 Zlatan  7  7  UK|US

^{由reprex package (v0.3.0) 于 2021-01-06 创建}