r - 从行中选择第 i 个最高值并分配给新列的最快方法
问题描述
我正在寻找一种将新列添加到现有数据框/数据表的解决方案,这是每个单独行中的第 i 个最高值。例如,如果我想要第 4 个最高值,则新列的第一行将包含 1.9。
data <- data.frame(a = c("a","a","b","b","c","a"),
peak1 = c(1.1,2.5,2.4,2.1,2.5,2.6),
peak2 = c(1.2,2.5,2.4,2.1,2.5,2.6),
peak3 = c(1.3,2.5,2.4,2.1,2.5,2.6),
peak4 = c(1.4,2.5,2.5,2.1,2.5,2.6),
peak5 = c(1.5,2.5,2.46,2.1,2.5,2.6),
peak6 = c(1.6,2.5,2.4,2.1,2.5,2.6),
peak7 = c(1.7,2.5,2.4,2.1,2.5,2.0),
peak8 = c(1.8,2.5,2.4,2.1,2.5,2.1),
peak9 = c(1.9,2.2,2.4,2.1,2.5,2.2),
peak10 = c(2,2.5,2.4,2.1,2.5,2.3),
peak11 = c(2.1,2.5,2.4,2.1,2.5,2.4),
peak12 = c(2.2,2.5,2.4,2.99,3,2.5))
我尝试添加一个索引列,然后使用 lapply 函数选择值,但它在每个单元格中返回一个列表,并且在具有约 3.000.000 条记录的真实数据集上运行非常慢。理想情况下,我正在寻找一种能在几秒钟内解决这个问题的解决方案,因为它运行起来很闪亮。
data$index <- lapply(split(data[,c(-1)],seq(nrow(data))),FUN = order, decreasing = TRUE)
rank <- 4
data$result <- lapply(1:nrow(data), function(row) data[row, data$test[[row]][rank]+1])
解决方案
我已经更新了我的答案以提供三种解决方案;fun2()
回想起来是最好的(最快,最强大,易于理解)的答案。
有各种 StackOverflow 帖子可用于查找第 n 个最高值,例如https://stackoverflow.com/a/2453619/547331。这是实现该解决方案的功能
nth <- function(x, nth_largest) {
n <- length(x) - (nth_largest - 1L)
sort(x, partial=n)[n]
}
将此应用于 data.frame 的每个(数字)行
data$nth <- apply(data[,-1], 1, nth, nth_largest = 4)
我做了一个大数据集
for (i in 1:20) data = rbind(data, data)
然后做了一些基本的计时
> system.time(apply(head(data[,-1], 1000), 1, nth, 4))
user system elapsed
0.012 0.000 0.012
> system.time(apply(head(data[,-1], 10000), 1, nth, 4))
user system elapsed
0.150 0.005 0.155
> system.time(apply(head(data[,-1], 100000), 1, nth, 4))
user system elapsed
1.274 0.005 1.279
> system.time(apply(head(data[,-1], 1000000), 1, nth, 4))
user system elapsed
14.847 0.095 14.943
所以它随着行数线性扩展(不足为奇......),每百万行大约 15 秒。
为了比较,我将此解决方案写为
fun0 <-
function(df, nth_largest)
{
n <- ncol(df) - (nth_largest - 1L)
nth <- function(x)
sort(x, partial=n)[n]
apply(df, 1, nth)
}
用作fun0(data[,-1], 4)
.
另一种策略是从数值数据创建一个矩阵
m <- as.matrix(data[,-1])
然后对整个矩阵进行排序,将值的行索引按顺序排列
o <- order(m)
i <- row(m)[o]
然后对于最大,次大,...值,将每行索引的最后一个值设置为NA;第 n 个最大值是最后一次出现的行索引
for (iter in seq_len(nth_largest - 1L))
i[!duplicated(i, fromLast = TRUE)] <- NA_integer_
idx <- !is.na(i) & !duplicated(i, fromLast = TRUE)
对应的值为m[o[idx]]
,按行顺序排列
m[o[idx]][order(i[idx])]
因此,另一种解决方案是
fun1 <-
function(df, nth_largest)
{
m <- as.matrix(df)
o <- order(m)
i <- row(m)[o]
for (idx in seq_len(nth_largest - 1L))
i[!duplicated(i, fromLast = TRUE)] <- NA_integer_
idx <- !is.na(i) & !duplicated(i, fromLast = TRUE)
m[o[idx]][order(i[idx])]
}
我们有
> system.time(res0 <- fun0(head(data[,-1], 1000000), 4))
user system elapsed
17.604 0.075 17.680
> system.time(res1 <- fun1(head(data[,-1], 1000000), 4))
user system elapsed
3.036 0.393 3.429
> identical(unname(res0), res1)
[1] TRUE
一般来说,如果不是太大,它似乎fun1()
会更快。nth_largest
对于fun2()
,将原始数据按行再按值排序,只保留相关索引
fun2 <-
function(df, nth_largest)
{
m <- as.matrix(df)
o <- order(row(m), m)
idx <- seq(ncol(m) - (nth_largest - 1), by = ncol(m), length.out = nrow(m))
m[o[idx]]
}
和
> system.time(res1 <- fun1(head(data[, -1], 1000000), 4))
user system elapsed
2.948 0.406 3.355
> system.time(res2 <- fun2(head(data[, -1], 1000000), 4))
user system elapsed
0.316 0.062 0.379
> identical(res1, res2)
[1] TRUE
fun2()
对完整数据集进行分析
> dim(data)
[1] 6291456 13
> Rprof(); res2 <- fun2(data[, -1], 4); Rprof(NULL); summaryRprof()
$by.self
self.time self.pct total.time total.pct
"order" 1.50 63.56 1.84 77.97
"unlist" 0.36 15.25 0.36 15.25
"row" 0.34 14.41 0.34 14.41
"fun2" 0.10 4.24 2.36 100.00
"seq.default" 0.06 2.54 0.06 2.54
...
表明大部分时间都花在order()
; 我不完全确定如何order()
实现多个因素,但它可能具有与基数排序相关的复杂性。无论如何,它是相当快的!
推荐阅读
- php - 显示运费 WooCommerce
- react-native - 需要双击以从带有 KeyboardAvoidingView 的模态中释放对文本输入的关注
- python - 通过 numpy 和 pandas 读取 csv 文件的问题
- python - 推特广告 API。错误:- [{'code': 'INVALID_PARAMETER', 'message': 'Expected GeoId, got "JP" for country', 'parameter': 'country'}]>
- python - 如何在图像中跟踪我们想要的任何特定对象?
- c++ - 使用三元运算符“移动或抛出”
- laravel - 如何在 Laravel 的数据透视表中添加额外的列关系
- java - 如何组合来自 SQLite 和 PostgreSQL 的两个不同的表?
- go - 使用 Jaeger 在分布式应用程序中跟踪 Kafka 总线
- parse-platform - Xero-node 以 PDF 格式获取发票