logo标签列表

保留每行中的前三个最大值，将其余数值更改为NA。

rdplyrtidyverse
13

使用 mtcars 进行可重复性分析。

(这是一种行操作)。我想根据值的大小保留每行的 3 个值 (所以基本上前三个值会有值，其余的都变为 NA)。

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

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

在mtcars数据集中，展示了三行样本输出below

注意：在mtcars数据集中，所有三行的列名值都相同且不为NA，但在原始数据集中可能会有所不同。（最好使用tidyverse解决方案）

5个回答
8

我知道您想要一个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
1
稍微简短一些：t(apply(mtcars, 1, function(x) {x[rank(-x) > 3] <- NA; x})) - s_baldur
8

你的整体思路是正确的。您可以切换到长数据并在使用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
谢谢您指导我找到这个解决方案，从两个答案中学到了很多。 - Vaibhav Singh
为什么使用slice_max而不是top_n，它们有什么区别吗？ - Vaibhav Singh
1
top_n()已被slice_max()取代，但本质上是相同的。 - Ritchie Sacramento
6

看到您对其他解决方案很感兴趣...

这里我给您留下了一个更加以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将列表或向量列表作为第一个参数。在这种情况下，它接受一个数据框，实际上是一个长度相同的向量列表。

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

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

该函数本身仅以非常类似于被接受的解决方案的方式替换该向量中的NA值。我使用rank，因为它对我来说更容易阅读，但我想这是一个风格问题。

pmap始终返回列表。 这就是您可以使用pmap_dfr返回数据框的原因。具体而言，您要通过将最终结果的每个向量绑定为行来创建数据框（这解释了末尾的r）。

查看?pmap获取更多信息。

我同意，我在复杂的（...）方面的专业知识非常有限。我能理解上述解决方案中的pmap_dfr :) 你能分享任何改善对于像你这样的复杂tidyverse解决方案的专业知识的链接吗？ - Vaibhav Singh
"更多功能性"? - s_baldur
“更具功能性”是指与函数式编程的概念更相关，因为解决方案更倾向于使用函数而不是硬编码分配和操作。你不这么认为吗？ - Edo
@Vaibhav Singh：我编辑了我的问题并添加了一些细节...希望有所帮助！ - Edo
2
一个完整性的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
# ...
1
一个 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 不要认为这超出了你的能力范围！一步步使用 ? 检查代码，你应该能够很快地将其拼凑起来。 - iamericfletcher
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接