连续保持前 3 个值，将其他所有值更改为 NA答案

【问题标题】：Keep top 3 values in a row, change everything else to NA连续保持前 3 个值，将其他所有值更改为 NA
【发布时间】：2020-12-03 04:31:26
【问题描述】：

使用 mtcar 实现可重复性

（这是一个行操作）。我想根据它们的大小连续保留 3 个值（所以基本上前 3 个值将具有价值，其余一切都更改为 NA）

我尝试使用 pivot_longer 转换为 long 然后过滤，但问题是我想再次转换为wide，因为我想保留数据的结构。

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

3 行 mtcars 上的示例输出

注意：在 mtcars 中，所有 3 行的列名值都与非 NA 相同，但在原始数据集中会有所不同。（最好是tidyverse解决方案）

【问题讨论】：

标签： r dplyr tidyverse

【解决方案1】：

我知道你想要一个 tidyverse 解决方案，但这是基本 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

【讨论】：

略短：t(apply(mtcars, 1, function(x) {x[rank(-x) > 3] <- NA; x}))

【解决方案2】：

您的总体思路是正确的。您可以在使用slice_max() 并重新调整为宽数据之前，转至长数据并按行号分组：

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

【讨论】：

感谢您指导我找到这个解决方案，从两个答案中学到了很多
为什么是 slice_max 而不是 top_n，会有什么不同吗？
top_n() 已被slice_max() 取代，但基本相同。

【解决方案3】：

看到您对其他解决方案感到好奇..

这里我留给你一个更面向tidyverse的解决方案。

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

作为一个概念，它类似于base R 解决方案，但它应该（或至少尝试）更具“功能性”并希望具有可读性。即使选择的解决方案看起来非常好。

编辑。

回答您关于更多信息的评论..

应该知道~可以帮助你编写更紧凑的匿名函数。

代替：

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

你也可以写：

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

这三个点基本上将您提供给函数的所有输入聚集在一起。我没有为每个输入编写一个变量，而是使用... 将它们全部包含在内。

pmap 将列表列表或向量列表作为第一个参数。在这种情况下，它需要一个 data.frame，它实际上是一个相同长度的向量列表。

然后，pmap 为函数提供列表中每个向量的第 i 个元素。

... 拦截所有第 i 个元素，c() 创建这些元素的唯一向量。

函数本身只会以与公认解决方案非常相似的方式替换该向量中的 NA。我使用了rank，因为在我看来它更容易阅读，但我想这是风格问题。

pmap 总是返回一个列表。那就是你可以使用pmap_dfr 来返回一个数据框。具体来说，您希望通过将最终结果的每个向量绑定为行来创建一个数据框（这解释了最后的 r）。

查看?pmap了解更多信息。

【讨论】：

我同意，我在复杂 (....) 方面的专业知识非常有限。我可以理解上述解决方案中的 pmap_dfr :) 你能否分享任何链接以提高像你这样的复杂 tidyverse 解决方案的专业知识
“更实用”？
与“更多功能”我的意思是与函数式编程的概念更相关，因为解决方案往往更倾向于使用函数而不是硬代码分配和操作。你不这么认为吗？
@Vaibhav Singh：我编辑了我的问题以添加一些细节。希望对您有所帮助！

【解决方案4】：

data.table 的完整性解决方案：

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

【讨论】：

【解决方案5】：

一个dplyr 选项可能是：

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

同样的逻辑使用purrr:

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

【讨论】：

@VaibhavSingh 不要以为这太过分了！一路上使用? 逐步执行代码，您应该能够立即将其拼凑在一起。