提取 R 中列的最高值和最低值，以及行标识符答案

【问题标题】：extract highest and lowest values for columns in R, as well as row identifiers提取 R 中列的最高值和最低值，以及行标识符
【发布时间】：2017-02-02 18:34:53
【问题描述】：

假设我有以下类型的一些数据：

df<-as.data.frame(matrix(rnorm(10*10000, 1, .5), ncol=10))

我想要一个保留 10 个原始列的新数据框，但对于每一列，只保留最高 10 个和最低 10 个值。重要的是，行的名称与需要保存在新数据框中的 id 值相对应。

因此，最终结果 data.frame 的尺寸将是 m x 10，其中 m 很可能超过 20。但是对于每一列，我只需要 20 个有效值。

我能想到的唯一方法是每列手动执行此操作，使用dplyr 并排列，抓取顶部和底部行，然后从所有单独的向量创建一个矩阵。显然这是低效的。帮忙？

【问题讨论】：

首先，dplyr 用于 data.frames，而不是矩阵。另外，如果您想要保留行名，为什么不在示例中显示呢？
将修复对矩阵的引用，尽管我只想保留可能是数字的行标识符。
你能举个例子吗？我也对行名的事情感到困惑。
您可以将行号添加为变量；使用 reshape2::melt 或类似的东西转换为长格式；种类;切片/过滤到每个组中的顶行和底行。

标签： r dplyr

【解决方案1】：

假设您想保留原始数据集中的所有行，其中至少有一个值满足您的条件（给定列中最大的十个或最小的十个中的值），您可以这样做：

# create a data frame
df<-as.data.frame(matrix(rnorm(10*10000, 1, .5), ncol=10))
# function to find lowes 10 and highest 10 values
lowHigh <- function(x)
{
        test <- x
        test[!(order(x) <= 10 | order(x) >= (length(x)- 10))] <- NA
        test
}
# apply the function defined above
test2 <- apply(df, 2, lowHigh)
# use the original rownames
rownames(test2) <- rownames(df)
# keep only rows where there is value of interest
finalData <- test2[apply(apply(test2, 2, is.na), 1, sum) < 10, ]

请注意，肯定有一些更聪明的方法......

【讨论】：

这完全正确。它创建一个保留行名的新数据框，并且每一行至少有一个有效观察值。我的数据来自一种大规模因子分析，因此在新数据框中我可以看到哪些行正在加载到特定因子上。谢谢！
@ricatom 这如何准确？它不会每列返回 20 个值。它也将比我的方法慢得多。我会将基准添加到我的答案中。
没有人要求 20 行。请参阅原始问题的第 3 段。

【解决方案2】：

这里是每列10个最高和10个最低的数据矩阵，

x<-apply(df,2,function(k) k[order(k,decreasing=T)[c(1:10,(length(k)-9):length(k))]])

x 是您的 20 x 10 矩阵。您对行名的要求是逐列冲突的，这个矩阵中总共只有 20 个行名，并且所有 10 列不能相同。相反，这是您的订单矩阵，

x_roworder<-apply(df,2,function(k) order(k,decreasing=T)[c(1:10,(length(k)-9):length(k))])

这将为您在每列中的原始数据矩阵中提供相应的行。

【讨论】：

【解决方案3】：

我对此提供了几个答案。

一个基本的 R 实现（我使用了%>% 使其更易于阅读）

ix = lapply(df, function(x) order(x)[-(1:(length(x)-20)+10)]) %>%
  unlist %>% unique %>% sort

df[ix,]

这滥用了数据框是列表的事实，为每列找到满足条件的行 id，然后将唯一的按顺序作为您要保留的行索引。这应该保留附加到df的所有行名

使用dplyr 的替代方法（因为您提到过），如果我没记错的话，它并不特别喜欢行名

# add id as a variable
df$id = 1:nrow(df) # or row names
df %>% 
    gather("col",value,-id) %>% 
    group_by(col) %>% 
    filter(min_rank(value) <= 10 | min_rank(desc(value)) <= 10) %>%
    ungroup %>% 
    select(id) %>% 
    left_join(df)

已编辑：修复代码对齐并使filter更整洁

【讨论】：

【解决方案4】：

我不完全确定您对退货/输出的期望。但这将为您提供适当的索引

# example data
set.seed(41234L)
N <- 1000
df<-data.frame(id= 1:N, matrix(rnorm(10*N, 1, .5), ncol=10))

# for each column, extract ID's for top 10 and bottom 10 values
l1 <- lapply(df[,2:11], function(x,y, n) {
  xy <- data.frame(x,y)
  xy <- xy[order(xy[,1]),]
  return(xy[c(1:10, (n-9):n),2])
}, y= df[,1], n = N)

# check: 
xx <- sort(df[,2])
all.equal(sort(df[l1[[1]], 2]), xx[c(1:10, 991:1000)])
[1] TRUE

如果您想要一个具有这些唯一值的 m * 10 矩阵，其中 m 是唯一索引的数量，您可以这样做：

l2 <- do.call("c", l1)
l2 <- unique(l2)

df2 <- df[l2,] # in this case, m == 189

这不是0 / NA 您没有为每一行搜索的列。但目前尚不清楚您的问题试图做什么。

注意

这不如使用data.table 高效，因为您将获得xy <- data.frame(x,y) 中数据的副本

基准测试

library(microbenchmark)
microbenchmark(ira= {
  test2 <- apply(df[,2:11], 2, lowHigh);
  rownames(test2) <- rownames(df);
  finalData <- test2[apply(apply(test2, 2, is.na), 1, sum) < 10, ]
},
alex= {
  l1 <- lapply(df[,2:11], function(x,y, n) {
    xy <- data.frame(x,y)
    xy <- xy[order(xy[,1]),]
    return(xy[c(1:10, (n-9):n),2])
  }, y= df[,1], n = N);


  l2 <- unique(do.call("c", l1));
  df2 <- df[l2,]
}, times= 50L)

Unit: milliseconds
 expr      min       lq     mean   median       uq      max neval cld
  ira 4.360452 4.522082 5.328403 5.140874 5.560295 8.369525    50   b
 alex 3.771111 3.854477 4.054388 3.936716 4.158801 5.654280    50  a

【讨论】：