3

This is a tricky one to describe concisely in a headline (or to google). I have a taxonomy table where some columns may be listed as "dropped' based on a confidence level. I'd like to replace any column that says "dropped" with "Unidentified" followed by the value from the first column that doesn't say "dropped", in a row-wise fashion. So, the input would look like this:

#> # 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

And the output should look like this:

#> # 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

I've come up with a fine solution using purrr::pmap_dfr but I'm curious to know if there's a more "pure" dplyr way to do it? The one flaw in my method is that it doesn't work for columns where the first non-"dropped" column comes after one or more "dropped" columns (see row 21 in the output below). Here's my current solution:

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

Update:

Some good answers below. I've accepted the one with the most upvotes, but it turns out that after running all the suggestions through microbenchmark, the purrr solution is the fastest by almost an order of magnitude.

Luther Blissett
  • 373
  • 1
  • 10

3 Answers3

2

I think execution time for this is quite decent, however, you may try it for yourself. I would like to thank @IRTFM for his comment with regard to changing dropped values to NA. I actually used that idea but I decided to err on the side of dplyr than zoo so instead of na.locf I used coalesce for this purpose.

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
Anoushiravan R
  • 21,622
  • 3
  • 18
  • 41
2

Here's another approach, using rowwise() in combination with across().

  • We are using rowwise because it helps in using a row as a single vector through cur_data()
  • across(everything(), ~) helps us in mutating all columns at once
  • max.col(cur_data() != 'dropped', ties.method = 'last') will retrieve last column index where the value != 'dropped'
  • we store its column name in a temp variable say x
  • lastly we use if()..else from base R to mutate only those columns where value is dropped

Hope the answer is clear enough

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

Created on 2021-06-19 by the reprex package (v2.0.0)

AnilGoyal
  • 25,297
  • 4
  • 27
  • 45
1

Here's an approach using dplyr + tidyr::pivot_longer/wider. I think it reads cleanly but there's surely a more concise way.

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)
Jon Spring
  • 55,165
  • 4
  • 35
  • 53
  • That's nice! Although according to microbenchmark, it's a bit over 30 times slower than the `pmap` method. But, I had forgotten about both the fill and lag functions and those will come very much in handy! – Luther Blissett Jun 18 '21 at 23:21