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

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)

Answer 1

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

Answer 2

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

Answer 3

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.

Answer 4

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

Answer 5

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