【问题标题】:R: Counting rows in a dataframe in which all values fall within individual rangesR:计算数据框中所有值都在单个范围内的行
【发布时间】:2021-03-19 23:27:19
【问题描述】:

我有一个数据框(A 行 x K 列)。对于每一列,我得到第 5 和第 95 个百分位值。我想知道 df 中有多少行在这 K 个第 5 和第 95 个百分位值的集合中具有所有 K 个值。

下面的示例代码有效,删除不属于边界的行(此处为 1 和 9,但实际上将是百分位数),然后计算剩余的行。但是 A 为 10K,K 为 40,我正在模拟这个数据帧 10K 次,所以我想知道是否有运行得更快的代码。

data <- rbind(c(1,2,3,4,5), c(3,5,7,8,5), c(2,8,9,5,9), c(9,1,1,8,9), 
        c(3,5,6,7,5))
Lower_Bound <- rbind(1,1,1,1,1)
Upper_Bound <- rbind(9,9,9,9,9)

for (i in c(1:5)) {
    data <- data[data[,i] > Lower_Bound[i,],]
    data <- data[data[,i] < Upper_Bound[i,],]
}

N <- nrow(data)

【问题讨论】:

  • 请展示您到目前为止所做的尝试,以及您当前代码的问题是什么
  • 如果您创建一个小的可重现示例以及预期的输出,这将更容易提供帮助。阅读how to give a reproducible example
  • 对我来说,不清楚您的具体目标是什么。请尝试更具体。谢谢。
  • 在每个循环中,第一个变量data 被第二个变量data 覆盖,在循环中,变量data 在每一步都被覆盖。最后,最后一列的逻辑向量仅小于上限!
  • 您好 dcarlson,感谢您的想法。当我运行此代码时会发生什么情况是从 df 数据中删除所有具有第一列值 Upper_Bound 第一行值的行;或具有第二列值 Upper_Bound 第二行值;等等。这是我想要的。我想知道是否有更有效的方法来解决这个问题。谢谢。

标签: r dataframe


【解决方案1】:

如果我理解正确,OP 只对满足条件的 行数 感兴趣。因此,实际上没有必要从data删除 不属于范围内的行。计算在界限内的行数就足够了。

此答案包含解决方案

  • 矩阵
  • data.frames
  • 和一个比较的基准
    • OP 的方法,
    • apply() 带有矩阵和 data.frames,
    • 一种使用purrrmap()reduce() 函数的方法。

apply() 带矩阵

让我们从提供的示例data 和固定的Lower_BoundUpper_Bound 开始。请注意,所有三个对象都是由rbind() 创建的矩阵。这与引用 数据框(A 行 x K 列) 的问题文本形成对比。无论如何,我们都会为这两种情况提供解决方案。

apply(data, 1, function(x) all(x > Lower_Bound & x < Upper_Bound))

返回一个逻辑类型的向量

[1] FALSE  TRUE FALSE FALSE  TRUE

满足条件的行数可由下式推导出

N <- sum(apply(data, 1, function(x) all(x > Lower_Bound & x < Upper_Bound)))
N
[1] 2

因为TRUE 被强制转换为1LFALSE 转换为0L


下一步也是计算每列的界限为第 5 和第 95 个百分位数。为此,我们必须创建一个新的样本数据集mat,再次作为矩阵

# create sample data
n_col <- 5
n_row <- 10
set.seed(42) # required for reproducible results
mat <- sapply(1:n_col, function(x) rnorm(n_row, mean = x))
mat
           [,1]       [,2]     [,3]     [,4]     [,5]
 [1,] 2.3709584  3.3048697 2.693361 4.455450 5.205999
 [2,] 0.4353018  4.2866454 1.218692 4.704837 4.638943
 [3,] 1.3631284  0.6111393 2.828083 5.035104 5.758163
 [4,] 1.6328626  1.7212112 4.214675 3.391074 4.273295
 [5,] 1.4042683  1.8666787 4.895193 4.504955 3.631719
 [6,] 0.8938755  2.6359504 2.569531 2.282991 5.432818
 [7,] 2.5115220  1.7157471 2.742731 3.215541 4.188607
 [8,] 0.9053410 -0.6564554 1.236837 3.149092 6.444101
 [9,] 3.0184237 -0.4404669 3.460097 1.585792 4.568554
[10,] 0.9372859  3.3201133 2.360005 4.036123 5.655648

为了演示,每列都有不同的平均值。

# count number of rows
probs <- c(0.05, 0.95)
bounds <- apply(mat, 2, quantile, probs)
idx <- apply(mat, 1, function(x) all(x > bounds[1, ] & x < bounds[2, ]))
N <- sum(idx)
N

15

如果需要,满足条件的mat的子集可以通过

mat[idx, ]
          [,1]     [,2]     [,3]     [,4]     [,5]
[1,] 2.3709584 3.304870 2.693361 4.455450 5.205999
[2,] 1.6328626 1.721211 4.214675 3.391074 4.273295
[3,] 0.8938755 2.635950 2.569531 2.282991 5.432818
[4,] 2.5115220 1.715747 2.742731 3.215541 4.188607
[5,] 0.9372859 3.320113 2.360005 4.036123 5.655648

界限是

bounds
        [,1]       [,2]     [,3]     [,4]     [,5]
5%  0.641660 -0.5592606 1.226857 1.899532 3.882318
95% 2.790318  3.8517060 4.588960 4.886484 6.135429

apply() 与 data.frames

如果数据集是 data.frame,我们可以使用相同的代码,即,

df <- as.data.frame(mat)
probs <- c(0.05, 0.95)
bounds <- apply(df, 2, quantile, probs)
idx <- apply(df, 1, function(x) all(x > bounds[1, ] & x < bounds[2, ]))
N <- sum(idx)

基准测试

OP 正在寻找比 OP 自己的方法更快的代码,因为 OP 想要复制模拟 10000 次。

所以,这是一个比较的基准

  • OP1:OP 自己使用矩阵的方法
  • OP2OP1 的略微修改版本
  • apply_mat:带有矩阵的apply() 函数
  • apply_df:带有 data.frames 的 apply() 函数
  • purrr:使用 purrr 包中的 map()pmap()reduce()

(请注意,方法列表并不详尽)

针对不同的问题大小(即 5、10 和 40 列以及 100、1000 和 10000 行)重复基准测试。最大的问题大小对应于 OP 模拟的大小。当一些代码修改输入数据集时,all 运行从输入数据的新副本开始。

library(bench)
library(purrr)
library(ggplot2)

bm <- press(
  n_col = c(5L, 10L, 40L)
  , n_row = 10L^(2:4)
  , {
    set.seed(42)
    mat0 <- sapply(1:n_col, function(x) rnorm(n_row, mean = x))
    df0 <- as.data.frame(mat0)
    mark(
      OP1 = {
        data <- data.table::copy(mat0)
        Lower_Bound <- as.matrix(apply(data, 2, quantile, probs = 0.05), ncol = 1L)
        Upper_Bound <- as.matrix(apply(data, 2, quantile, probs = 0.95), ncol = 1L)
        for (i in seq_len(ncol(data))) {
          data <- data[data[, i] > Lower_Bound[i, ], ]
          data <- data[data[, i] < Upper_Bound[i, ], ]
        }
        nrow(data)
      },
      OP2 = {
        data <- data.table::copy(mat0)
        Lower_Bound <- as.matrix(apply(data, 2, quantile, probs = 0.05), ncol = 1L)
        Upper_Bound <- as.matrix(apply(data, 2, quantile, probs = 0.95), ncol = 1L)
        for (i in seq_len(ncol(data))) {
          data <- data[data[, i] > Lower_Bound[i, ] & data[, i] < Upper_Bound[i, ], ]
        }
        nrow(data)
      },
      apply_mat = {
        mat <- data.table::copy(mat0)
        probs <- c(0.05, 0.95)
        bounds <- apply(mat, 2, quantile, probs)
        idx <- apply(mat, 1, function(x) all(x > bounds[1, ] & x < bounds[2, ]))
        sum(idx)
      },
      apply_df = {
        df <- data.table::copy(df0)
        probs <- c(0.05, 0.95)
        bounds <- apply(df, 2, quantile, probs)
        idx <- apply(df, 1, function(x) all(x > bounds[1, ] & x < bounds[2, ]))
        sum(idx)
      },
      purrr = {
        data.table::copy(df0) %>% 
          map2(map_dfc(., quantile, probs), ~ (.x > .y[1L] & .x < .y[2L])) %>% 
          pmap(all) %>% 
          reduce(`+`)
      }
    )
  }    
)

autoplot(bm)

注意对数时间刻度

print(bm[, 1:11], n = Inf)
# A tibble: 45 x 11
   expression n_col n_row      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time
   <bch:expr> <int> <dbl> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm>
 1 OP1            5   100   1.46ms   1.93ms    493.     88.44KB     0      248     0      503ms
 2 OP2            5   100   1.34ms   1.78ms    534.     71.56KB     0      267     0      500ms
 3 apply_mat      5   100   1.16ms   1.42ms    621.     26.66KB     2.17   286     1      461ms
 4 apply_df       5   100   1.41ms    1.8ms    526.     34.75KB     0      263     0      500ms
 5 purrr          5   100   2.34ms    2.6ms    374.     17.86KB     0      187     0      500ms
 6 OP1           10   100   2.42ms   2.78ms    344.    205.03KB     0      172     0      500ms
 7 OP2           10   100   2.37ms   2.71ms    354.    153.38KB     2.07   171     1      484ms
 8 apply_mat     10   100   1.76ms   2.12ms    457.     51.64KB     0      229     0      501ms
 9 apply_df      10   100   2.31ms   2.63ms    367.     67.78KB     0      184     0      501ms
10 purrr         10   100   3.44ms    4.1ms    222.     34.89KB     2.09   106     1      477ms
11 OP1           40   100    9.4ms  10.57ms     92.9   955.41KB     0       47     0      506ms
12 OP2           40   100   9.18ms  10.08ms     96.8   638.92KB     0       49     0      506ms
13 apply_mat     40   100   5.44ms   6.46ms    146.    429.95KB     2.12    69     1      472ms
14 apply_df      40   100   6.12ms   6.75ms    141.    608.66KB     0       71     0      503ms
15 purrr         40   100  10.43ms   11.8ms     84.9   149.53KB     0       43     0      507ms
16 OP1            5  1000   1.75ms   1.94ms    478.    837.55KB     2.10   228     1      477ms
17 OP2            5  1000   1.69ms   1.94ms    487.    674.36KB     0      244     0      501ms
18 apply_mat      5  1000   4.84ms   5.62ms    176.    255.17KB     0       89     0      506ms
19 apply_df       5  1000   6.37ms   7.66ms    122.    333.58KB     0       62     0      506ms
20 purrr          5  1000   9.86ms  11.22ms     87.7   165.52KB     2.14    41     1      467ms
21 OP1           10  1000   3.35ms   3.91ms    253.      1.89MB     0      127     0      503ms
22 OP2           10  1000   3.33ms   3.72ms    256.      1.41MB     2.06   124     1      484ms
23 apply_mat     10  1000   5.86ms   6.93ms    142.    491.09KB     0       72     0      508ms
24 apply_df      10  1000   7.74ms  10.08ms     99.2   647.86KB     0       50     0      504ms
25 purrr         10  1000  14.55ms  15.44ms     62.5   323.17KB     2.23    28     1      448ms
26 OP1           40  1000   13.8ms  16.28ms     58.8     8.68MB     2.18    27     1      459ms
27 OP2           40  1000  13.29ms  14.72ms     67.9     5.84MB     0       34     0      501ms
28 apply_mat     40  1000  12.17ms  13.85ms     68.5      4.1MB     2.14    32     1      467ms
29 apply_df      40  1000  14.61ms  15.86ms     62.9     5.78MB     0       32     0      509ms
30 purrr         40  1000  41.85ms  43.66ms     22.7     1.25MB     0       12     0      529ms
31 OP1            5 10000   5.57ms   6.55ms    147.      8.15MB     2.07    71     1      482ms
32 OP2            5 10000   5.38ms   6.27ms    157.      6.55MB     2.06    76     1      485ms
33 apply_mat      5 10000  43.98ms   46.9ms     20.7     2.48MB     0       11     0      532ms
34 apply_df       5 10000  53.59ms  56.53ms     17.8     3.24MB     3.57     5     1      280ms
35 purrr          5 10000  86.32ms  88.83ms     11.1      1.6MB     0        6     0      540ms
36 OP1           10 10000  12.03ms  13.63ms     72.3    18.97MB     2.07    35     1      484ms
37 OP2           10 10000  11.66ms  12.97ms     76.5    14.07MB     4.25    36     2      471ms
38 apply_mat     10 10000  50.31ms  51.77ms     18.5     4.77MB     0       10     0      541ms
39 apply_df      10 10000  62.09ms  65.17ms     15.1      6.3MB     0        8     0      528ms
40 purrr         10 10000 125.82ms  128.3ms      7.35    3.13MB     2.45     3     1      408ms
41 OP1           40 10000  53.38ms  56.34ms     16.2    87.79MB     5.41     6     2      369ms
42 OP2           40 10000  46.24ms  47.43ms     20.3    58.82MB     2.25     9     1      444ms
43 apply_mat     40 10000  78.25ms  83.79ms     11.4    40.94MB     2.85     4     1      351ms
44 apply_df      40 10000  95.66ms  97.02ms     10.3    57.58MB     2.06     5     1      486ms
45 purrr         40 10000 361.26ms 373.23ms      2.68   12.31MB     0        2     0      746ms

结论

令我惊讶的是,尽管有重复的复制操作,OPs 方法确实表现得非常好。事实上,对于 OP 的 10000 行和 40 列的问题大小,修改后的版本 OP2 几乎比 apply_mat 快了两倍。

一种可能的解释(不过需要验证)是 OP 方法是一种递归方法,其中在遍历列时减少了要检查的行数。

有趣的是,purrr 变体的内存要求最低。

从该基准中获取 OP2 方法的中位运行时间约为 50 毫秒,10000 次重复模拟可能需要不到 10 分钟。

【讨论】:

  • 优秀。非常感谢 Uwe。
猜你喜欢
  • 2018-03-19
  • 2017-10-19
  • 2018-12-20
  • 1970-01-01
  • 2020-07-22
  • 2023-03-26
  • 1970-01-01
  • 2022-11-15
  • 1970-01-01
相关资源
最近更新 更多