第一个、第二个和第三个最高值的逐行总和答案

【问题标题】：Row-wise sum of first, second and third highest values第一个、第二个和第三个最高值的逐行总和
【发布时间】：2018-06-03 00:39:44
【问题描述】：

考虑以下示例数据：

"A" "B" "C" "D" "E" "F" "G" "H" "I" "L" "K"
"1" 2.59 23.08 4.61 10.32 5.61 0.05 0.34 24.04 19.34 5.76 4.27
"2" 23.31 1.84 15.34 1.23 0 0 6.13 12.88 6.13 17.18 15.95
"3" 9.47 0 13.68 9.47 0 0 0 2.11 5.26 6.32 53.68
"4" 2.16 29.99 4.58 7.92 0.92 0 0 8.97 16.57 12.05 16.83
"5" 5.4 76.35 2.06 8.87 0 0 0.26 0.39 0.9 2.7 3.08
"6" 8.24 30 7.65 0 1.18 0 0 4.71 22.94 23.53 1.76

我正在努力寻找逐行找到三个最高值并求和的解决方案。

有什么想法吗？

【问题讨论】：

使用apply，排序并选择前三个。
如何按行排序？
应用（数据，1，函数（x）排序（x，递减 = TRUE））

标签： r

【解决方案1】：

如果你有一个向量x，计算三个最大值之和的函数可能是

fun = function(x)
    sum(tail(sort(x), 3))

您想将此应用于对象的每一行m

apply(m, 1, fun)

一个稍快（例如，40%）的实现是

colSums(apply(m, 1, sort, decreasing = TRUE)[1:3, ])

或者使用部分排序

colSums(apply(m, 1, sort.int, partial = 9:11)[9:11, ])

为了性能，如果m 中有很多行，请避免使用apply() 隐含的对行的迭代。一个实现可能是

library(matrixStats)
rowSums(m * (rowRanks(m) > ncol(m) - 3))

但是当m 的行中有联系时，这会失败； rowRanks() 不支持 ties.method = "first"。相反，实现我们自己的rowRanks()

.rowRanks <- function(m) {
    m[] = sort.list(sort.list(m))
    rowRanks(m)
}
rowSums(m * (.rowRanks(m) > ncol(m) - 3))

对于一个 tidyverse 解决方案，似乎要从整洁的数据开始

tbl <- df %>%
  rowid_to_column() %>%
  gather("letter","value",-1) %>%
  group_by(rowid)

使用top_n() 的解决方案会产生不正确的结果，因此最好的选择似乎是

summarize(tbl, fun(value))

（fun 可以在这里扩展，但这似乎不是一个好主意，因为它使得单独修改和测试变得更加困难）。

比较方法

f0 = function(m) apply(m, 1, fun)
f0a = function(m) colSums(apply(m, 1, sort, decreasing=TRUE)[1:3, ])
f0b = function(m) colSums(apply(m, 1, sort.int, partial = 9:11)[9:11, ])
f1 = function(m) rowSums(m * (.rowRanks(m) > ncol(m) - 3))
f2 = function(tbl) summarize(tbl, fun(value))

与

> library(microbenchmark)
> identical(f0(m), f0a(m))
[1] TRUE
> identical(f0(m), f0b(m))
[1] TRUE
> identical(f0(m), f1(m))
[1] TRUE
> identical(f0(m), f2(tbl)$`fun(value)`)
[1] TRUE
> microbenchmark(f0(m), f0a(m), f0b(m), f1(m), f2(tbl), times=10)
Unit: microseconds
    expr      min       lq      mean    median       uq      max neval
   f0(m)  837.505  860.890  894.9245  905.9880  921.386  948.242    10
  f0a(m)  594.895  637.258  650.7217  653.1800  673.599  713.167    10
  f0b(m)  274.925  277.734  305.6551  296.2975  330.482  362.765    10
   f1(m)  166.416  169.290  192.8086  189.5945  215.491  219.478    10
 f2(tbl) 2265.451 2277.599 2425.6083 2327.7015 2359.896 3349.995    10

> m = m[sample(nrow(m), 1000, TRUE),]
> microbenchmark(f0(m), f0a(m), f0b(m), f1(m), times=10)
Unit: milliseconds
   expr        min         lq       mean     median         uq        max neval
  f0(m) 137.705781 139.793459 141.658415 141.821540 143.653272 144.428092    10
 f0a(m)  85.946679  86.663967  88.500392  87.513880  89.634696  94.458554    10
 f0b(m)  29.762981  30.890124  32.470553  32.649594  33.116767  36.686603    10
  f1(m)   2.034407   2.120689   2.137723   2.144328   2.176306   2.184712    10

【讨论】：

【解决方案2】：

您可以在每列上进行转置和maptop_n(3) 和sum：

library(tidyverse)

tdf <- as.data.frame(t(df)) 
var_names <- names(tdf)

var_names %>%
  map_dfc(~tdf %>% select(.x) %>% top_n(3) %>% sum()) %>% 
  t()

    [,1]
V1 66.46
V2 56.44
V3 86.30
V4 63.39
V5 90.62
V6 76.47

感觉有点笨拙，但完成了工作。

更新来自 Moody_Mudskipper 的更好方法：

var_names %>% 
  map_dfc(~tdf %>% select(.x) %>% top_n(3) %>% summarize_all(sum)) %>% 
  gather

数据：

df <- read.table(text='"A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "L"
2.59 23.08 4.61 10.32 5.61 0.05 0.34 24.04 19.34 5.76 4.27
23.31 1.84 15.34 1.23 0 0 6.13 12.88 6.13 17.18 15.95
9.47 0 13.68 9.47 0 0 0 2.11 5.26 6.32 53.68
2.16 29.99 4.58 7.92 0.92 0 0 8.97 16.57 12.05 16.83
5.4 76.35 2.06 8.87 0 0 0.26 0.39 0.9 2.7 3.08
8.24 30 7.65 0 1.18 0 0 4.71 22.94 23.53 1.76', header=TRUE)

^ 注意：数据与 OP 略有不同，行号被删除。

【讨论】：

我接受你的回答，因为它是唯一的一个并且可以完成工作，虽然我不是tidyverse 的乐趣，因为我不太了解它。首选dplyr
很高兴它解决了您的问题。 FWIW，dplyr 是 tidyverse 的一部分 - 这里唯一额外的 tidyverse 包是 purrr::map，而不是使用基本 R apply()。
另外 - 请接受您认为最适合您的问题的任何答案。第一个答案并不总是最好的——尤其是在这种情况下！
为了避免第二次转置和类型更改，我建议var_names %>% map_dfc(~tdf %>% select(.x) %>% top_n(3) %>% summarize_all(sum)) %>% gather
正如另一个回复中指出的，top_n() 包含平局，因此会生成不正确的结果，例如第三行。

【解决方案3】：

使用tidyverse:

df %>%
  rowid_to_column() %>%
  gather("letter","value",-1) %>%
  group_by(rowid) %>%
  arrange(desc(value)) %>%
  slice(1:3) %>%
  summarize(value= sum(value))

# # A tibble: 6 x 2
#   rowid value
#   <int> <dbl>
# 1     1  66.5
# 2     2  56.4
# 3     3  76.8
# 4     4  63.4
# 5     5  90.6
# 6     6  76.5

替代解决方案，灵感来自@andrew_reece 的解决方案：

tdf <- setNames(as.data.frame(t(df)),seq(nrow(df)))
tdf %>%
  summarize_all(~sum(tail(sort(.),3))) %>%
  gather(rowid,value)

#   rowid value
# 1     1 66.46
# 2     2 56.44
# 3     3 76.83
# 4     4 63.39
# 5     5 90.62
# 6     6 76.47

注意：

真正的tidyverse 实现setNames(as.data.frame(t(df)),seq(nrow(df))) 的方式如下：

df %>%
  rowid_to_column %>%
  gather("letter","value",-1) %>%
  spread("rowid","value")

【讨论】：

非常不错的多样化 tidyverse 解决方案。
最后一个真的是你的，我试着做更多的“tidyverse”
使用top_n() 的解决方案会产生不正确的结果，因为它们包含平局；见第三行。
谢谢我修复了它，我删除了最后一个解决方案，因为修复后它看起来不再好

【解决方案4】：

df <- read.table('"A" "B" "C" "D" "E" "F" "G" "H" "I" "L" "K"
"1" 2.59 23.08 4.61 10.32 5.61 0.05 0.34 24.04 19.34 5.76 4.27
"2" 23.31 1.84 15.34 1.23 0 0 6.13 12.88 6.13 17.18 15.95
"3" 9.47 0 13.68 9.47 0 0 0 2.11 5.26 6.32 53.68
"4" 2.16 29.99 4.58 7.92 0.92 0 0 8.97 16.57 12.05 16.83
"5" 5.4 76.35 2.06 8.87 0 0 0.26 0.39 0.9 2.7 3.08
"6" 8.24 30 7.65 0 1.18 0 0 4.71 22.94 23.53 1.76')

根据@Soheil 的建议，一个 R Base 解决方案：

rowSums(t(apply(df, 1, FUN = function(x) sort(x, decreasing = TRUE)))[ , c(1,2,3)])

【讨论】：

这是一个更紧凑的版本，主要是修改语法但也避免了换位：colSums(apply(df,1,sort,TRUE)[1:3,])