Keep top 3 values in a row, change everything else to NA

Question

Using mtcars for reproduciblity

(This is a row operation). I want to keep 3 values in a row based on their magnitude (so basically top 3 values would be having value, rest everything change to NA)

I tried using pivot_longer converting to long then filtering but problem is I want to convert again to wide cause I want to retain the structure of data.

   mtcars %>% 
    pivot_longer(cols = everything()) %>% 
    group_by(name) %>% top_n(3)

Sample Output on 3 rows of mtcars

Note: In mtcars, all 3 rows have same column name values as non NA but in original dataset it would be different. (Preferably tidyverse solution)

score 8 · Accepted Answer · answered Aug 13 '20 at 10:42

I know you would like a tidyverse solution, but this is a one-liner in base R:

t(apply(mtcars, 1, function(x) {x[order(x)[1:(length(x) - 3)]] <- NA; x}))
#>                      mpg cyl  disp  hp drat wt  qsec vs am gear carb
#> Mazda RX4           21.0  NA 160.0 110   NA NA    NA NA NA   NA   NA
#> Mazda RX4 Wag       21.0  NA 160.0 110   NA NA    NA NA NA   NA   NA
#> Datsun 710          22.8  NA 108.0  93   NA NA    NA NA NA   NA   NA
#> Hornet 4 Drive      21.4  NA 258.0 110   NA NA    NA NA NA   NA   NA
#> Hornet Sportabout   18.7  NA 360.0 175   NA NA    NA NA NA   NA   NA
#> Valiant               NA  NA 225.0 105   NA NA 20.22 NA NA   NA   NA
#> Duster 360            NA  NA 360.0 245   NA NA 15.84 NA NA   NA   NA
#> Merc 240D           24.4  NA 146.7  62   NA NA    NA NA NA   NA   NA
#> Merc 230              NA  NA 140.8  95   NA NA 22.90 NA NA   NA   NA
#> Merc 280            19.2  NA 167.6 123   NA NA    NA NA NA   NA   NA
#> Merc 280C             NA  NA 167.6 123   NA NA 18.90 NA NA   NA   NA
#> Merc 450SE            NA  NA 275.8 180   NA NA 17.40 NA NA   NA   NA
#> Merc 450SL            NA  NA 275.8 180   NA NA 17.60 NA NA   NA   NA
#> Merc 450SLC           NA  NA 275.8 180   NA NA 18.00 NA NA   NA   NA
#> Cadillac Fleetwood    NA  NA 472.0 205   NA NA 17.98 NA NA   NA   NA
#> Lincoln Continental   NA  NA 460.0 215   NA NA 17.82 NA NA   NA   NA
#> Chrysler Imperial     NA  NA 440.0 230   NA NA 17.42 NA NA   NA   NA
#> Fiat 128            32.4  NA  78.7  66   NA NA    NA NA NA   NA   NA
#> Honda Civic         30.4  NA  75.7  52   NA NA    NA NA NA   NA   NA
#> Toyota Corolla      33.9  NA  71.1  65   NA NA    NA NA NA   NA   NA
#> Toyota Corona       21.5  NA 120.1  97   NA NA    NA NA NA   NA   NA
#> Dodge Challenger      NA  NA 318.0 150   NA NA 16.87 NA NA   NA   NA
#> AMC Javelin           NA  NA 304.0 150   NA NA 17.30 NA NA   NA   NA
#> Camaro Z28            NA  NA 350.0 245   NA NA 15.41 NA NA   NA   NA
#> Pontiac Firebird    19.2  NA 400.0 175   NA NA    NA NA NA   NA   NA
#> Fiat X1-9           27.3  NA  79.0  66   NA NA    NA NA NA   NA   NA
#> Porsche 914-2       26.0  NA 120.3  91   NA NA    NA NA NA   NA   NA
#> Lotus Europa        30.4  NA  95.1 113   NA NA    NA NA NA   NA   NA
#> Ford Pantera L      15.8  NA 351.0 264   NA NA    NA NA NA   NA   NA
#> Ferrari Dino        19.7  NA 145.0 175   NA NA    NA NA NA   NA   NA
#> Maserati Bora       15.0  NA 301.0 335   NA NA    NA NA NA   NA   NA
#> Volvo 142E          21.4  NA 121.0 109   NA NA    NA NA NA   NA   NA

Slightly shorter: `t(apply(mtcars, 1, function(x) {x[rank(-x) > 3] <- NA; x}))` — s_baldur, Aug 13 '20 at 11:44

Ritchie Sacramento · Answer 2 · 2020-08-13T11:10:42.577

Your general idea was in the right direction. You can pivot to long data and group by the row number before using slice_max() and reshaping back to wide:

library(dplyr)
library(tidyr)
library(tibble)

mtcars %>% 
  rowid_to_column() %>%
  pivot_longer(-rowid) %>% 
  group_by(rowid) %>%
  mutate(value = replace(value, !value %in% tail(value[order(value)], 3), NA)) %>%
  pivot_wider(names_from = name, values_from = value)

# A tibble: 32 x 11
     mpg cyl    disp    hp drat  wt     qsec vs    am    gear  carb 
   <dbl> <lgl> <dbl> <dbl> <lgl> <lgl> <dbl> <lgl> <lgl> <lgl> <lgl>
 1  21   NA     160    110 NA    NA     NA   NA    NA    NA    NA   
 2  21   NA     160    110 NA    NA     NA   NA    NA    NA    NA   
 3  22.8 NA     108     93 NA    NA     NA   NA    NA    NA    NA   
 4  21.4 NA     258    110 NA    NA     NA   NA    NA    NA    NA   
 5  18.7 NA     360    175 NA    NA     NA   NA    NA    NA    NA   
 6  NA   NA     225    105 NA    NA     20.2 NA    NA    NA    NA   
 7  NA   NA     360    245 NA    NA     15.8 NA    NA    NA    NA   
 8  24.4 NA     147.    62 NA    NA     NA   NA    NA    NA    NA   
 9  NA   NA     141.    95 NA    NA     22.9 NA    NA    NA    NA   
10  19.2 NA     168.   123 NA    NA     NA   NA    NA    NA    NA   
# ... with 22 more rows

thank you for guiding me to this solution, learnt a lot from both answers — Vaibhav Singh, Aug 13 '20 at 10:52
`top_n()` has been superseded by `slice_max()` but it is essentially the same. — Ritchie Sacramento, Aug 13 '20 at 11:02

Edo · Answer 3 · 2020-08-13T12:25:22.147

Seeing that you were curious about other solutions..

Here I leave you a more tidyverse-oriented solution.

library(purrr)
library(dplyr)

mtcars %>% pmap_dfr(~c(...) %>% replace(rank(desc(.)) > 3, NA))

#> # A tibble: 32 x 11
#>      mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
#>    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#>  1  21      NA  160    110    NA    NA  NA      NA    NA    NA    NA
#>  2  21      NA  160    110    NA    NA  NA      NA    NA    NA    NA
#>  3  22.8    NA  108     93    NA    NA  NA      NA    NA    NA    NA
#>  4  21.4    NA  258    110    NA    NA  NA      NA    NA    NA    NA
#>  5  18.7    NA  360    175    NA    NA  NA      NA    NA    NA    NA
#>  6  NA      NA  225    105    NA    NA  20.2    NA    NA    NA    NA
#>  7  NA      NA  360    245    NA    NA  15.8    NA    NA    NA    NA
#>  8  24.4    NA  147.    62    NA    NA  NA      NA    NA    NA    NA
#>  9  NA      NA  141.    95    NA    NA  22.9    NA    NA    NA    NA
#> 10  19.2    NA  168.   123    NA    NA  NA      NA    NA    NA    NA
#> # ... with 22 more rows

As a concept, it's similar to the base R solution, but it should (or at least tries to) be more "functional" and hopefully readable. Even if the chosen solution looks very good.

EDIT.

To answer your comment about more info..

It should be known that ~ helps you writing more compact anonymous functions.

instead of:

mtcars %>% pmap_dfr(~c(...) %>% replace(rank(desc(.)) > 3, NA))

you could also write:

mtcars %>% pmap_dfr(function(...) c(...) %>% replace(rank(desc(.)) > 3, NA))

Those three dots basically gather all together the input you're providing to your function. Instead of writing a variable for each input, I use ... to include them all.

pmap takes a list of lists or a list of vectors as first argument. In this case, it takes a data.frame which is actually a list of vector of the same length.

Then, pmap provides the function with the i-th element of each vector of the list.

... intercept all those i-th elements and c() create a unique vector of those elements.

The function itself will just replace NAs in that vector in very similar way to the accepted solution. I used rank because it seemed to me a bit easier to read, but I guess it's a matter of style.

pmap always returns a list. That's you can use pmap_dfr to return a dataframe instead. Specifically you want to create a dataframe by binding each vector of the final result as rows (that explains the r at the end).

Check out ?pmap for more info.

I agree, my expertise in complex (....) is extremely limited. I can understand till pmap_dfr in above solution :) Can you share any link for improving expertise in complex tidyverse solution like yours — Vaibhav Singh, Aug 13 '20 at 11:22
with "more functional" I mean a bit more relatable to the concept of functional programming, because the solution tend to be more prone to favor the use of function instead of hard-code assign and manipulation.. don't you think so? — Edo, Aug 13 '20 at 12:11
@Vaibhav Singh: I edited my question to add some details.. hope it helps! — Edo, Aug 13 '20 at 12:31

score 2 · Answer 4 · answered Aug 13 '20 at 11:37

A data.table solution for completeness:

DT <- as.data.table(mtcars)
DT[, 
   {
    t3 <- sort(unlist(.SD), decreasing = TRUE)[1:3]
    lapply(.SD, function(x) if (x %in% t3) x else NA_real_)
   }, 
   by = seq_len(nrow(DT))]

#    seq_len  mpg cyl  disp  hp drat wt  qsec vs am gear carb
# 1:       1 21.0  NA 160.0 110   NA NA    NA NA NA   NA   NA
# 2:       2 21.0  NA 160.0 110   NA NA    NA NA NA   NA   NA
# 3:       3 22.8  NA 108.0  93   NA NA    NA NA NA   NA   NA
# 4:       4 21.4  NA 258.0 110   NA NA    NA NA NA   NA   NA
# 5:       5 18.7  NA 360.0 175   NA NA    NA NA NA   NA   NA
# 6:       6   NA  NA 225.0 105   NA NA 20.22 NA NA   NA   NA
# ...

tmfmnk · Answer 5 · 2020-08-13T11:23:49.893

One dplyr option could be:

mtcars %>% 
 rowwise() %>%
 mutate(temp = list(tail(sort(c_across(everything())), 3))) %>%
 ungroup() %>%
 mutate(across(everything(), ~ replace(.x, !.x %in% unlist(temp), NA))) %>%
 select(-temp)

     mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
 1  21      NA  160    110    NA    NA  NA      NA    NA    NA    NA
 2  21      NA  160    110    NA    NA  NA      NA    NA    NA    NA
 3  22.8    NA  108     93    NA    NA  NA      NA    NA    NA    NA
 4  21.4    NA  258    110    NA    NA  NA      NA    NA    NA    NA
 5  18.7    NA  360    175    NA    NA  NA      NA    NA    NA    NA
 6  NA      NA  225    105    NA    NA  20.2    NA    NA    NA    NA
 7  NA      NA  360    245    NA    NA  15.8    NA    NA    NA    NA
 8  24.4    NA  147.    62    NA    NA  NA      NA    NA    NA    NA
 9  22.8    NA  141.    95    NA    NA  22.9    NA    NA    NA    NA
10  19.2    NA  168.   123    NA    NA  NA      NA    NA    NA    NA

The same logic using purrr:

mtcars %>% 
 pmap_dfr(~ replace(c(...), !c(...) %in% tail(sort(c(...)), 3), NA))

@VaibhavSingh Don't think it is over your head! Step through the code using `?` along the way and you should be able to piece it together in no time. — Eric, Aug 15 '20 at 21:27

Keep top 3 values in a row, change everything else to NA

5 Answers5