logo标签列表

用dplyr替换“缺失”的列数据为第一个非“缺失”值

rdplyrreplacemissing-datarowwise
3

这是一个比较难以用简短的标题描述（或在谷歌搜索时找到）的问题。我有一个分类表格，在一些列中可能会出现“已删除”标记，基于置信水平。我想以逐行的方式将任何标记为“已删除”的列替换为“未知”，并且由第一列不为“已删除”的值跟在后面。因此，输入应如下所示：

#> # A tibble: 21 x 4
#>    domain    class       order           species
#>    <chr>     <chr>       <chr>           <chr>  
#>  1 Eukaryota dropped     dropped         dropped
#>  2 Eukaryota dropped     dropped         dropped
#>  3 Eukaryota dropped     dropped         dropped
#>  4 Eukaryota dropped     dropped         dropped
#>  5 Eukaryota dropped     dropped         dropped
#>  6 Eukaryota dropped     dropped         dropped
#>  7 Eukaryota Hexanauplia Calanoida       dropped
#>  8 Eukaryota dropped     dropped         dropped
#>  9 Eukaryota Dinophyceae Syndiniales     dropped
#> 10 Animals   Polychaeta  Terebellida     dropped
#> 11 Eukaryota Acantharia  Chaunacanthida  dropped
#> 12 Eukaryota dropped     dropped         dropped
#> 13 Animals   Ascidiacea  Stolidobranchia dropped
#> 14 Eukaryota Haptophyta  dropped         dropped
#> 15 Eukaryota dropped     dropped         dropped
#> 16 Eukaryota dropped     dropped         dropped
#> 17 Eukaryota dropped     dropped         dropped
#> 18 Animals   Ascidiacea  Stolidobranchia dropped
#> 19 Eukaryota dropped     dropped         dropped
#> 20 Eukaryota dropped     dropped         dropped

输出应该看起来像这样：

#> # A tibble: 21 x 4
#>    domain    class                order                species                  
#>    <chr>     <chr>                <chr>                <chr>                    
#>  1 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  2 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  3 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  4 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  5 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  6 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  7 Eukaryota Hexanauplia          Calanoida            Unidentified Calanoida   
#>  8 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  9 Eukaryota Dinophyceae          Syndiniales          Unidentified Syndiniales 
#> 10 Animals   Polychaeta           Terebellida          Unidentified Terebellida 
#> 11 Eukaryota Acantharia           Chaunacanthida       Unidentified Chaunacanth…
#> 12 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#> 13 Animals   Ascidiacea           Stolidobranchia      Unidentified Stolidobran…
#> 14 Eukaryota Haptophyta           Unidentified Haptop… Unidentified Haptophyta  
#> 15 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#> 16 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#> 17 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#> 18 Animals   Ascidiacea           Stolidobranchia      Unidentified Stolidobran…
#> 19 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#> 20 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota

我使用purrr::pmap_dfr找到了一个很好的解决方案，但是我想知道是否有更"纯粹"的dplyr方法可以做到这一点？ 我的方法唯一的缺陷是在第一个非“dropped”列位于一个或多个“dropped”列之后的列中不起作用（请参见下面输出的第21行）。这是我的当前解决方案：

library(tidyverse)
otu_table <- structure(list(domain = c("Eukaryota", "Eukaryota", "Eukaryota", 
"Eukaryota", "Eukaryota", "Eukaryota", "Eukaryota", "Eukaryota", 
"Eukaryota", "Animals", "Eukaryota", "Eukaryota", "Animals", 
"Eukaryota", "Eukaryota", "Eukaryota", "Eukaryota", "Animals", 
"Eukaryota", "Eukaryota", "dropped"), class = c("dropped", "dropped", 
"dropped", "dropped", "dropped", "dropped", "Hexanauplia", "dropped", 
"Dinophyceae", "Polychaeta", "Acantharia", "dropped", "Ascidiacea", 
"Haptophyta", "dropped", "dropped", "dropped", "Ascidiacea", 
"dropped", "dropped", "not dropped"), order = c("dropped", "dropped", 
"dropped", "dropped", "dropped", "dropped", "Calanoida", "dropped", 
"Syndiniales", "Terebellida", "Chaunacanthida", "dropped", "Stolidobranchia", 
"dropped", "dropped", "dropped", "dropped", "Stolidobranchia", 
"dropped", "dropped", "dropped"), species = c("dropped", "dropped", 
"dropped", "dropped", "dropped", "dropped", "dropped", "dropped", 
"dropped", "dropped", "dropped", "dropped", "dropped", "dropped", 
"dropped", "dropped", "dropped", "dropped", "dropped", "dropped", 
"dropped")), row.names = c(NA, -21L), class = c("tbl_df", "tbl", 
"data.frame"))

tax_data <- otu_table %>%
  pmap_dfr(~{
    items <- list(...)
    first_dropped = match("dropped",items)
    if (first_dropped > 1) {
      dropped_name <- str_c("Unidentified ",items[first_dropped-1])
    } else {
      dropped_name <- "Unidentified"
    }
    items[-c(1:first_dropped-1)] <- dropped_name
    items
  })
print(tax_data,n=30)
#> # A tibble: 21 x 4
#>    domain    class                order                species                  
#>    <chr>     <chr>                <chr>                <chr>                    
#>  1 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  2 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  3 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  4 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  5 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  6 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  7 Eukaryota Hexanauplia          Calanoida            Unidentified Calanoida   
#>  8 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#>  9 Eukaryota Dinophyceae          Syndiniales          Unidentified Syndiniales 
#> 10 Animals   Polychaeta           Terebellida          Unidentified Terebellida 
#> 11 Eukaryota Acantharia           Chaunacanthida       Unidentified Chaunacanth…
#> 12 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#> 13 Animals   Ascidiacea           Stolidobranchia      Unidentified Stolidobran…
#> 14 Eukaryota Haptophyta           Unidentified Haptop… Unidentified Haptophyta  
#> 15 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#> 16 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#> 17 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#> 18 Animals   Ascidiacea           Stolidobranchia      Unidentified Stolidobran…
#> 19 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#> 20 Eukaryota Unidentified Eukary… Unidentified Eukary… Unidentified Eukaryota   
#> 21 dropped   not dropped          dropped              dropped

更新:

下面有一些不错的答案。我已经接受了最多赞成票的答案，但是事实证明，在使用 microbenchmark 运行所有建议后，purrr 解决方案速度几乎比其他方法快一个数量级。

1
将所有的“dropped”变为真正的R NA，然后使用zoo::na.locf。 - IRTFM
3个回答
2

我认为这个执行时间相当不错，但你可以自己尝试。我想感谢@IRTFM关于将dropped值更改为NA的评论。我确实使用了那个想法，但我决定在dplyr和zoo之间偏向dplyr，因此我使用coalesce代替na.locf来实现这个目的。

library(dplyr)
library(tidyr)

otu_table %>%
  mutate(across(!domain, ~ replace(.x, .x == "dropped", NA))) %>%
  rowwise() %>%
  mutate(output = list(coalesce(c_across(everything()), 
                                str_c("Unidentified", 
                                      last(c_across(everything())[!is.na(c_across(everything()))]), sep = " ")))) %>%
  select(output) %>%
  unnest_wider(output) %>%
  set_names(colnames(otu_table))


# A tibble: 21 x 4
   domain    class                  order                  species                 
   <chr>     <chr>                  <chr>                  <chr>                   
 1 Eukaryota Unidentified Eukaryota Unidentified Eukaryota Unidentified Eukaryota  
 2 Eukaryota Unidentified Eukaryota Unidentified Eukaryota Unidentified Eukaryota  
 3 Eukaryota Unidentified Eukaryota Unidentified Eukaryota Unidentified Eukaryota  
 4 Eukaryota Unidentified Eukaryota Unidentified Eukaryota Unidentified Eukaryota  
 5 Eukaryota Unidentified Eukaryota Unidentified Eukaryota Unidentified Eukaryota  
 6 Eukaryota Unidentified Eukaryota Unidentified Eukaryota Unidentified Eukaryota  
 7 Eukaryota Hexanauplia            Calanoida              Unidentified Calanoida  
 8 Eukaryota Unidentified Eukaryota Unidentified Eukaryota Unidentified Eukaryota  
 9 Eukaryota Dinophyceae            Syndiniales            Unidentified Syndiniales
10 Animals   Polychaeta             Terebellida            Unidentified Terebellida
# ... with 11 more rows
2
这里是另一种方法，使用rowwise()和across()的组合。
  • 我们使用rowwise，因为它有助于将行作为单个向量通过cur_data()
  • across(everything(), ~)帮助我们同时变异所有列
  • max.col(cur_data() != 'dropped', ties.method = 'last')将检索值！= 'dropped'的最后一列索引
  • 我们将其列名存储在临时变量x中
  • 最后，我们使用基本R中的if()..else来仅变异值为dropped的那些列
希望答案足够清楚。
library(tidyverse)

otu_table %>% rowwise() %>%
  mutate(across(everything(), ~ {x<- names(cur_data())[max.col(cur_data() != 'dropped', ties.method = 'last')]; 
  if (. == 'dropped') paste0('unidentified ', get(x)) else . }))

#> # A tibble: 21 x 4
#> # Rowwise: 
#>    domain    class                 order                 species                
#>    <chr>     <chr>                 <chr>                 <chr>                  
#>  1 Eukaryota unidentified Eukaryo~ unidentified Eukaryo~ unidentified Eukaryota 
#>  2 Eukaryota unidentified Eukaryo~ unidentified Eukaryo~ unidentified Eukaryota 
#>  3 Eukaryota unidentified Eukaryo~ unidentified Eukaryo~ unidentified Eukaryota 
#>  4 Eukaryota unidentified Eukaryo~ unidentified Eukaryo~ unidentified Eukaryota 
#>  5 Eukaryota unidentified Eukaryo~ unidentified Eukaryo~ unidentified Eukaryota 
#>  6 Eukaryota unidentified Eukaryo~ unidentified Eukaryo~ unidentified Eukaryota 
#>  7 Eukaryota Hexanauplia           Calanoida             unidentified Calanoida 
#>  8 Eukaryota unidentified Eukaryo~ unidentified Eukaryo~ unidentified Eukaryota 
#>  9 Eukaryota Dinophyceae           Syndiniales           unidentified Syndinial~
#> 10 Animals   Polychaeta            Terebellida           unidentified Terebelli~
#> # ... with 11 more rows

由reprex包 (v2.0.0)于2021年06月19日创建

1
这里提供一种使用dplyr + tidyr::pivot_longer/wider的方法。我认为它很清晰易懂，但肯定还有更简洁的方式。
otu_table %>%
  mutate(across(class:species, ~if_else(.x == "dropped", NA_character_, .x))) %>%
  mutate(row = row_number()) %>%
  pivot_longer(cols = -row) %>%
  group_by(row) %>%
  mutate(value = if_else(is.na(value) & !is.na(lag(value)), paste("Unidentified", lag(value)), value)) %>%
  fill(value) %>%
  ungroup() %>%
  pivot_wider(names_from = name, values_from = value)
很好！虽然根据微基准测试，它比“pmap”方法慢了30多倍。但是，我忘记了“fill”和“lag”函数，它们非常有用！ - Luther Blissett
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接