我有一个时间序列数据集,其中包含在不同采样位置以不同频率测量的值(‘SITE_NO’).我想过滤这个数据集,以便快速连续地删除大量样本--在我的情况下是在15分钟内.以下是一个简化的示例:

library(lubridate)
set.seed(42)
n_sites <- 5
n_rows <- 100
df <- data.frame(
 Date_time = ymd_hms("2013-01-01 10:17:00", tz = "GMT") + minutes(0:(n_sites * n_rows - 1) * 2),
site_no = as.character(rep(1:n_sites, each = n_rows)),
 Value = rnorm(n_sites * n_rows))
df2 <- data.frame(Date_time = rep(ymd_hms("2013-01-02 05:00:00", tz = "GMT"),times=5),
              site_no = as.character(c(1:5)),
              Value = c(10,10,10,10,10))
df <- rbind(df,df2)
df <- df[order(df$site_no,df$Date_time),]

我想要做的是根据以下条件输出一个新的数据帧:

  • Select 每个SITE_NO的第一行(最早日期/时间)
  • 从每个SITE_NO的第一行开始搜索future 最多15分钟;
  • 识别时间差值最大且小于或等于15分钟的下一行;
  • 删除任何在此之间存在时差的行;
  • 为下一个时间步长重复该过程;

例如,对于site_no"1",第一个时间步长为上午10:17.然后,我想删除上午10:19-10:29之间的时间值(第2-7行),并保留第8行,其"date_time"时间戳为上午10:31.这是因为该值是15分钟窗口内与上午10:17的最大时差.从上午10:31(第8行)开始,我想删除第9-14行(上午10:33-10:43),并 Select 时间戳为上午10:45-上午10:31后14分钟的第15行(15分钟窗口内的最大时间差).

最后,如果该行与前一行之间的时间差是&>15分钟,我想同时保留这两个时间差.因此,在本例中,我希望将每个SITE_NO的最后一行保留在凌晨5:00

如果有可能以降低数据处理能力的方式实现这一点(即,向量化方法而不是显式循环),这将是伟大的,因为我有一个非常大的数据集.

在此之前,我非常感谢您.

推荐答案

我不知道你能不能在没有循环的情况下做到这点.下面是一个简单的函数,它以找到的日期为界限,尽可能高效地循环.最糟糕的情况是,所有diff都超过15分钟,在这种情况下,迭代遍历向量中的每个值.

备注:

  1. 每当我有一个while循环,我并不总是while%,它有一个明确的退出策略,我设置了迭代限制,以防止无限循环.我在这里使用了maxiters=length(tm),这意味着它的循环次数永远不会超过输入向量中的值.严格来说,这可能不是必须的,但我已经多次被"显然不会变得无限"(以及随后的"哎呀")咬了太多次,以至于不能在这里这样做,至少在dev中是这样.

  2. 数据必须按每个site_no组中的日期预先排序.

  3. 必须在函数外部处理site_no分组.

功能:


fun <- function(tm, mins = 15, maxiters = length(tm), debug = TRUE) {
  out <- replace(tm, -1, tm[1][NA])
  lastused <- which.max(!is.na(out))
  iter <- 0
  while (iter < maxiters) {
    if (lastused >= length(tm)) break
    iter <- iter + 1
    diffs <- as.numeric(tm[-(1:lastused)] - tm[lastused], units = "mins")
    if (any(found <- (diffs <= mins)) ) {
      nextused <- sum(found)
      out[(lastused+1):(lastused+nextused-1)] <- tm[lastused]
      out[lastused + nextused] <- tm[lastused + nextused]
      lastused <- lastused + nextused
    } else {
      out[lastused + 1] <- tm[lastused + 1]
      lastused <- lastused + 1
    }
  }
  if (debug) message("# took ", iter, " iterations")
  out
}

dplyr

library(dplyr)
df %>%
  mutate(prevtime = fun(Date_time), .by = site_no) %>%
  slice_head(n = 1, by = c("site_no", "prevtime"))
# # took 16 iterations
# # took 16 iterations
# # took 16 iterations
# # took 16 iterations
# # took 16 iterations
#              Date_time site_no        Value            prevtime
# 1  2013-01-01 10:17:00       1  1.370958447 2013-01-01 10:17:00
# 2  2013-01-01 10:31:00       1 -0.094659038 2013-01-01 10:31:00
# 3  2013-01-01 10:45:00       1 -0.133321336 2013-01-01 10:45:00
# 4  2013-01-01 10:59:00       1 -1.781308434 2013-01-01 10:59:00
# 5  2013-01-01 11:13:00       1  0.460097355 2013-01-01 11:13:00
# 6  2013-01-01 11:27:00       1 -1.717008679 2013-01-01 11:27:00
# 7  2013-01-01 11:41:00       1  0.758163236 2013-01-01 11:41:00
# 8  2013-01-01 11:55:00       1  0.655647883 2013-01-01 11:55:00
# 9  2013-01-01 12:09:00       1  0.679288816 2013-01-01 12:09:00
# 10 2013-01-01 12:23:00       1  1.399736827 2013-01-01 12:23:00
# 11 2013-01-01 12:37:00       1 -1.043118939 2013-01-01 12:37:00
# 12 2013-01-01 12:51:00       1  0.463767589 2013-01-01 12:51:00
# 13 2013-01-01 13:05:00       1 -1.194328895 2013-01-01 13:05:00
# 14 2013-01-01 13:19:00       1 -0.476173923 2013-01-01 13:19:00
# 15 2013-01-01 13:33:00       1  0.079982553 2013-01-01 13:33:00
# 16 2013-01-01 13:35:00       1  0.653204340 2013-01-01 13:35:00
# 17 2013-01-02 05:00:00       1 10.000000000 2013-01-02 05:00:00
# 18 2013-01-01 13:37:00       2  1.200965376 2013-01-01 13:37:00
# 19 2013-01-01 13:51:00       2 -0.122350172 2013-01-01 13:51:00
# 20 2013-01-01 14:05:00       2 -1.661099080 2013-01-01 14:05:00
# 21 2013-01-01 14:19:00       2 -1.470435741 2013-01-01 14:19:00
# 22 2013-01-01 14:33:00       2 -1.224747950 2013-01-01 14:33:00
# 23 2013-01-01 14:47:00       2 -1.097113768 2013-01-01 14:47:00
# 24 2013-01-01 15:01:00       2 -0.444684005 2013-01-01 15:01:00
# 25 2013-01-01 15:15:00       2 -1.056368413 2013-01-01 15:15:00
# 26 2013-01-01 15:29:00       2 -0.007762034 2013-01-01 15:29:00
# 27 2013-01-01 15:43:00       2 -0.362738416 2013-01-01 15:43:00
# 28 2013-01-01 15:57:00       2 -0.229778139 2013-01-01 15:57:00
# 29 2013-01-01 16:11:00       2  0.643008700 2013-01-01 16:11:00
# 30 2013-01-01 16:25:00       2 -0.279259373 2013-01-01 16:25:00
# 31 2013-01-01 16:39:00       2 -0.345087978 2013-01-01 16:39:00
# 32 2013-01-01 16:53:00       2  1.815228446 2013-01-01 16:53:00
# 33 2013-01-01 16:55:00       2  0.128821429 2013-01-01 16:55:00
# 34 2013-01-02 05:00:00       2 10.000000000 2013-01-02 05:00:00
# 35 2013-01-01 16:57:00       3 -2.000929238 2013-01-01 16:57:00
# 36 2013-01-01 17:11:00       3 -1.054055782 2013-01-01 17:11:00
# 37 2013-01-01 17:25:00       3  0.495619642 2013-01-01 17:25:00
# 38 2013-01-01 17:39:00       3 -0.351512874 2013-01-01 17:39:00
# 39 2013-01-01 17:53:00       3 -0.658503426 2013-01-01 17:53:00
# 40 2013-01-01 18:07:00       3 -0.390965408 2013-01-01 18:07:00
# 41 2013-01-01 18:21:00       3  1.258481665 2013-01-01 18:21:00
# 42 2013-01-01 18:35:00       3 -0.971385229 2013-01-01 18:35:00
# 43 2013-01-01 18:49:00       3 -0.738440754 2013-01-01 18:49:00
# 44 2013-01-01 19:03:00       3 -1.851555663 2013-01-01 19:03:00
# 45 2013-01-01 19:17:00       3  0.573751697 2013-01-01 19:17:00
# 46 2013-01-01 19:31:00       3 -1.242670271 2013-01-01 19:31:00
# 47 2013-01-01 19:45:00       3  0.043722008 2013-01-01 19:45:00
# 48 2013-01-01 19:59:00       3  0.446041053 2013-01-01 19:59:00
# 49 2013-01-01 20:13:00       3  0.097340485 2013-01-01 20:13:00
# 50 2013-01-01 20:15:00       3 -1.625616739 2013-01-01 20:15:00
# 51 2013-01-02 05:00:00       3 10.000000000 2013-01-02 05:00:00
# 52 2013-01-01 20:17:00       4 -0.004620768 2013-01-01 20:17:00
# 53 2013-01-01 20:31:00       4  0.992943637 2013-01-01 20:31:00
# 54 2013-01-01 20:45:00       4  0.586807720 2013-01-01 20:45:00
# 55 2013-01-01 20:59:00       4  0.189128812 2013-01-01 20:59:00
# 56 2013-01-01 21:13:00       4 -0.835205805 2013-01-01 21:13:00
# 57 2013-01-01 21:27:00       4 -0.073458335 2013-01-01 21:27:00
# 58 2013-01-01 21:41:00       4 -0.434617039 2013-01-01 21:41:00
# 59 2013-01-01 21:55:00       4  1.353361894 2013-01-01 21:55:00
# 60 2013-01-01 22:09:00       4 -0.290145312 2013-01-01 22:09:00
# 61 2013-01-01 22:23:00       4 -0.336311209 2013-01-01 22:23:00
# 62 2013-01-01 22:37:00       4  1.628442266 2013-01-01 22:37:00
# 63 2013-01-01 22:51:00       4 -1.109418760 2013-01-01 22:51:00
# 64 2013-01-01 23:05:00       4 -0.195656817 2013-01-01 23:05:00
# 65 2013-01-01 23:19:00       4 -0.301869926 2013-01-01 23:19:00
# 66 2013-01-01 23:33:00       4 -0.255607655 2013-01-01 23:33:00
# 67 2013-01-01 23:35:00       4  0.931032901 2013-01-01 23:35:00
# 68 2013-01-02 05:00:00       4 10.000000000 2013-01-02 05:00:00
# 69 2013-01-01 23:37:00       5  1.334912585 2013-01-01 23:37:00
# 70 2013-01-01 23:51:00       5  0.655511883 2013-01-01 23:51:00
# 71 2013-01-02 00:05:00       5 -0.777351759 2013-01-02 00:05:00
# 72 2013-01-02 00:19:00       5 -1.453529565 2013-01-02 00:19:00
# 73 2013-01-02 00:33:00       5  0.152608159 2013-01-02 00:33:00
# 74 2013-01-02 00:47:00       5  0.890356305 2013-01-02 00:47:00
# 75 2013-01-02 01:01:00       5  1.429338080 2013-01-02 01:01:00
# 76 2013-01-02 01:15:00       5  0.546115158 2013-01-02 01:15:00
# 77 2013-01-02 01:29:00       5  1.618343936 2013-01-02 01:29:00
# 78 2013-01-02 01:43:00       5 -1.083075142 2013-01-02 01:43:00
# 79 2013-01-02 01:57:00       5 -0.009056475 2013-01-02 01:57:00
# 80 2013-01-02 02:11:00       5 -0.283647452 2013-01-02 02:11:00
# 81 2013-01-02 02:25:00       5  0.761863447 2013-01-02 02:25:00
# 82 2013-01-02 02:39:00       5 -0.115135986 2013-01-02 02:39:00
# 83 2013-01-02 02:53:00       5  0.121258850 2013-01-02 02:53:00
# 84 2013-01-02 02:55:00       5 -0.011221686 2013-01-02 02:55:00
# 85 2013-01-02 05:00:00       5 10.000000000 2013-01-02 05:00:00

data.table

library(data.table)
as.data.table(df)[, prevtime := fun(Date_time), by = .(site_no)
                  ][, .SD[1,], by = .(site_no, prevtime)
                    ][, prevtime := NULL]

(这些列的顺序不同,否则与上面的dplyr方法相同.)

base R

工作量稍多一些,但它产生的结果与上面的dplyr和data.table相同.

split(df, df$site_no) |>
  lapply(function(site) {
    transform(site, prevtime = fun(Date_time, debug=F)) |>
      transform(grp = cumsum(c(TRUE, prevtime[-1] != prevtime[-length(prevtime)]))) |>
      subset(ave(grp, grp, FUN = seq_along) == 1)
  }) |>
  do.call(rbind.data.frame, args = _) |>
  subset(select = -c(prevtime, grp))

Benchmark/Comparison

这三种方法都会产生相同的输出,只是有一些细微的注意事项:data.table方法对列和不同的类对象进行重新排序,而base-R解决方案保留了原始的行名.这两个都是表面上的,但为了进行基准测试,我将修复这些更改,以便bench::mark(.)将确认所有输出都是相同的.

bench::mark(
  dplyr = {
    df %>%
      mutate(prevtime = fun(Date_time, debug=F), .by = site_no) %>%
      slice_head(n = 1, by = c("site_no", "prevtime")) %>%
      select(-prevtime)
  },
  data.table = {
    as.data.table(df)[, prevtime := fun(Date_time, debug=F), by = .(site_no)
                      ][, .SD[1,], by = .(site_no, prevtime)
                        ][, prevtime := NULL] |>
      # data.table is reordering columns above, aesthetic fix only for bench::mark
      setcolorder(names(df)) |>
      as.data.frame()
  },
  baseR = {
    split(df, df$site_no) |>
      lapply(function(site) {
        transform(site, prevtime = fun(Date_time, debug=F)) |>
          transform(grp = cumsum(c(TRUE, prevtime[-1] != prevtime[-length(prevtime)]))) |>
          subset(ave(grp, grp, FUN = seq_along) == 1)
      }) |>
      do.call(rbind.data.frame, args = _) |>
      subset(select = -c(prevtime, grp)) |>
      # the original row names are preserved, aesthetic fix only for bench::mark
      `rownames<-`(NULL)
  }
)

# # A tibble: 3 × 13
#   expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result        memory time            gc               
#   <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list>        <list> <list>          <list>           
# 1 dplyr          11ms  11.32ms      85.0        NA     6.07    28     2      329ms <df [85 × 3]> <NULL> <bench_tm [30]> <tibble [30 × 3]>
# 2 data.table  10.65ms  11.13ms      81.9        NA     2.56    32     1      391ms <df [85 × 3]> <NULL> <bench_tm [33]> <tibble [33 × 3]>
# 3 baseR        6.98ms   7.45ms     130.         NA     2.66    49     1      376ms <df [85 × 3]> <NULL> <bench_tm [50]> <tibble [50 × 3]>

我承认我有点惊讶,BASE-R是三者中最快的(而data.table是最慢的!),但对于更大的数据,情况可能并不总是如此.

R相关问答推荐

计算转换的次数

是否有R函数来判断一个组中的所有值是否与另一个组中的所有值相同?

找出疾病消失的受试者

par函数中的缩写,比如mgp,mar,mai是如何被破译的?

在df中保留原始变量和新变量

从所有项的 struct 相同的两级列表中,将该第二级中的所有同名项绑定在一起

我正在努力用R计算数据集中的中值逐步距离

根据列A中的差异变异列,其中行由列B中的相对值标识

绘制采样开始和采样结束之间的事件

根据1个变量绘制 colored颜色 发散的 map ,由另一个变量绘制饱和度,ggplot2不工作

如何在科学记数法中显示因子

如何在R中通过多个变量创建交叉表?

汇总数据的Sheffe检验的P值(平均值和标准差)

在gggraph中显示来自不同数据帧的单个值

我如何使用循环来编写冗余的Rmarkdown脚本?

使用来自嵌套列和非嵌套列的输入的PURRR:MAP和dplyr::Mariate

注释不会绘制在所有ggplot2面上

使用同一行中的前一个值填充R矩阵中的缺失值

Data.table::Shift type=允许扩展数据(&Q;LAG&Q;)

根据排名的顶点属性调整曲线图布局(&Q)