我正在寻找一种解决方案,将新列添加到现有数据框/数据表中,这是每个单独行中的第 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))
Run Code Online (Sandbox Code Playgroud)
我已经尝试添加一个索引列,然后使用 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])
Run Code Online (Sandbox Code Playgroud)
我已经更新了我的答案以提供三种解决方案;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]
}
Run Code Online (Sandbox Code Playgroud)
将此应用于 data.frame 的每一(数字)行
data$nth <- apply(data[,-1], 1, nth, nth_largest = 4)
Run Code Online (Sandbox Code Playgroud)
我做了一个大数据集
for (i in 1:20) data = rbind(data, data)
Run Code Online (Sandbox Code Playgroud)
然后做了一些基本的计时
> 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
Run Code Online (Sandbox Code Playgroud)
所以它随着行数线性扩展(并不奇怪......),每百万行大约有 15 秒。
为了比较,我将此解决方案写为
fun0 <-
function(df, nth_largest)
{
n <- ncol(df) - (nth_largest - 1L)
nth <- function(x)
sort(x, partial=n)[n]
apply(df, 1, nth)
}
Run Code Online (Sandbox Code Playgroud)
用作fun0(data[,-1], 4).
一种不同的策略是从数值数据创建一个矩阵
m <- as.matrix(data[,-1])
Run Code Online (Sandbox Code Playgroud)
然后对整个矩阵进行排序,将值的行索引按顺序排列
o <- order(m)
i <- row(m)[o]
Run Code Online (Sandbox Code Playgroud)
然后对于最大、次大、...值,将每行索引的最后一个值设置为 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)
Run Code Online (Sandbox Code Playgroud)
相应的值是m[o[idx]],按行顺序放置
m[o[idx]][order(i[idx])]
Run Code Online (Sandbox Code Playgroud)
因此,另一种解决方案是
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])]
}
Run Code Online (Sandbox Code Playgroud)
我们有
> 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
Run Code Online (Sandbox Code Playgroud)
一般来说,fun1()当nth_largest不是太大时,它似乎会更快。
for 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]]
}
Run Code Online (Sandbox Code Playgroud)
和
> 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
Run Code Online (Sandbox Code Playgroud)
剖析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
...
Run Code Online (Sandbox Code Playgroud)
表明大部分时间都花在了order();我不完全确定如何order()实现多个因素,但它可能具有与基数排序相关的复杂性。无论如何,它的速度非常快!