R函数,用于计算给定时间点不同测量次数的移动平均值

cig3rfwq  于 2023-09-27  发布在  其他
关注(0)|答案(5)|浏览(71)

对于 Dataframe 中的每个时间点,我有2到4个测量值。我想计算移动平均值,因此对于给定的时间点,我有一个值,该值是该时间点+之前的时间点和之后的时间点的所有测量值的平均值。

cellcounts <-c(80, 188, 206, 162, 106,  90,  85, 109,  87,  94,  86, 196, 132, 135,  84, 122,  67,  88,  81, 121,   9,  93, 117, 91, 108, 103, 119, 100,  18,  98,  93, 119, 140, 160, 101,  82, 111, 103,  28,  72, 144,  85,   1)
time <-c(-2.7, -2.8, -2.9, -3.0, -3.1, -3.2, -3.3, -3.4, -3.5, -3.6, -2.7, -2.8, -2.9, -3.0, -3.1, -3.2, -3.3, -3.4, -3.5, -3.6, -3.9, -3.0, -3.1, -3.2, -3.3, -3.4, -3.5, -3.7, -2.5, -2.6, -2.9, -3.0, -3.2, -3.3, -3.4, -3.5, -3.7, -3.8, -2.5, -2.6, -3.7, -3.8, -3.9)
df <- data.frame(cellcounts, time)
df <- df[order(df$time),]
df
zoo::rollapply(df, width = 3, FUN = mean, align = "center", fill = NA)
nvbavucw

nvbavucw1#

问题没有指定结果应该是什么,所以我们假设所需的结果是一个滚动平均向量,其元素数量与输入df中的行数相同。(2)和(3)压缩和解压缩数据,因此如果需要压缩版本,则仅省略rep.int(即最后一步)在这两个步骤中的任何一个。
请注意,我们不能简单地压缩数据并使用rollapply,因为不同的运行具有不同的长度。这些解决方案考虑到了这一点。它们都使用rollapply,但使用方法不同。
(2)在代码行方面似乎特别短。

1)偏移量列表rollapplywidth参数可以是表示要使用的偏移量的向量列表,因此创建该列表offsets,然后运行rollapply

我们假设前一时间是当前时间-0.1,下一时间是当前时间+0.1。
我们转换为整数倍,以避免浮点不精确。before是返回到开始的位置数,after是向前到结束的位置数。

library(zoo)

itime <- as.integer(10 * df$time + 1e-5) # integer time
seqno <- seq_along(itime)
before <- match(itime - 1L, itime, nomatch = seqno) - seqno
after <- findInterval(itime + 1L, itime) - seqno
offsets <- Map(seq, before, after)

means <- rollapply(df$cellcounts, offsets, mean)

2)压缩/解压缩在相同的时间运行中取和和长度,对每个执行rollapply并除法。然后使用rep.int解压缩。

roll <- function(x) rollapply(x, 3, sum, partial = TRUE)

means2 <- df |>
  aggregate(cbind(cellcounts, lens = 1) ~ time, data = _, sum) |>
  with((roll(cellcounts) / roll(lens)) |> rep.int(lens))

3)weighted.mean类似于(2),但我们使用weighted.mean组合均值而不是总和。

wm <- function(x, m = rbind(x)) weighted.mean(m[, 1], m[, 2])

means3 <- df |>
 with(data.frame(means = tapply(cellcounts, time, mean),
                 lens = tapply(cellcounts, time, length))) |>
 transform(means = rollapply(cbind(means, lens), 3, wm, partial = TRUE,
   by.column = FALSE)) |>
 with(rep.int(means, lens))

4)宽格式这将序列号seqno添加到运行中的每个连续相等时间(运行中的第一行为1,下一行为2,依此类推),然后使用read.zoo转换为宽格式。然后,我们使用rollapply生成答案的压缩形式,并如上所述使用rep.int将其扩展到最终结果。

means4 <- df |>
  transform(seqno = ave(time, time, FUN = seq_along)) |>
  read.zoo(index = "time", split = "seqno") |>
  rollapply(3, mean, na.rm = TRUE, partial = TRUE, by.column = FALSE) |>
  rep.int(rle(df$time)$lengths)

正在检查

identical(means, means2)
## [1] TRUE

identical(means, means3)
## [1] TRUE

identical(means, means4)
## [1] TRUE

四个人都给予了同样的答案:

means
##  [1]  49.50000  49.50000  79.00000  79.00000 108.28571 108.28571 108.28571
##  [8] 104.33333 104.33333  98.50000  98.50000  98.50000  98.50000  99.16667
## [15]  99.16667  99.16667  99.16667 105.33333 105.33333 105.33333 105.33333
## [22] 106.36364 106.36364 106.36364 106.36364 114.45455 114.45455 114.45455
## [29] 124.70000 124.70000 124.70000 124.70000 147.11111 147.11111 147.11111
## [36] 140.14286 140.14286 120.00000 120.00000  63.66667  63.66667  54.00000
## [43]  54.00000
6pp0gazn

6pp0gazn2#

在碱R中:

with(
  rle(df$time),
  {
    cs_x <- c(NA, 1L, cs_x <- cumsum(lengths) + 1L, NA)
    cs_y <- c(0, cumsum(df$cellcounts))
    data.frame(
      time = values,
      av_cellcounts = (cs_y[cs_x[-(1:3)]] - cs_y[cs_x[1:(length(cs_x) - 3L)]])/
        (cs_x[-(1:3)] - cs_x[1:(length(cs_x) - 3L)])
    )
  }
)
#>    time av_cellcounts
#> 1  -3.9            NA
#> 2  -3.8      79.00000
#> 3  -3.7     108.28571
#> 4  -3.6     104.33333
#> 5  -3.5      98.50000
#> 6  -3.4      99.16667
#> 7  -3.3     105.33333
#> 8  -3.2     106.36364
#> 9  -3.1     114.45455
#> 10 -3.0     124.70000
#> 11 -2.9     147.11111
#> 12 -2.8     140.14286
#> 13 -2.7     120.00000
#> 14 -2.6      63.66667
#> 15 -2.5            NA

或者,在终点处仅取2个时间步长的平均值:

with(
  rle(df$time),
  {
    cs_x <- c(1L, 1L, cs_x <- cumsum(lengths) + 1L, cs_x[length(cs_x)])
    cs_y <- c(0, cumsum(df$cellcounts))
    data.frame(
      time = values,
      av_cellcounts = (cs_y[cs_x[-(1:3)]] - cs_y[cs_x[1:(length(cs_x) - 3L)]])/
        (cs_x[-(1:3)] - cs_x[1:(length(cs_x) - 3L)])
    )
  }
)
#>    time av_cellcounts
#> 1  -3.9      49.50000
#> 2  -3.8      79.00000
#> 3  -3.7     108.28571
#> 4  -3.6     104.33333
#> 5  -3.5      98.50000
#> 6  -3.4      99.16667
#> 7  -3.3     105.33333
#> 8  -3.2     106.36364
#> 9  -3.1     114.45455
#> 10 -3.0     124.70000
#> 11 -2.9     147.11111
#> 12 -2.8     140.14286
#> 13 -2.7     120.00000
#> 14 -2.6      63.66667
#> 15 -2.5      54.00000
hvvq6cgz

hvvq6cgz3#

像这样吗

Base R

使用tapply计算时间均值,然后计算滚动均值。

x <- with(df, tapply(cellcounts, time, mean)) |>
  zoo::rollapply(width = 3, FUN = mean, align = "center", fill = NA)

## make a data.frame from the result above
df1 <- data.frame(time = as.numeric(names(x)), cellmeans = x)
df1
#>      time cellmeans
#> -3.9 -3.9        NA
#> -3.8 -3.8  72.44444
#> -3.7 -3.7 106.61111
#> -3.6 -3.6 106.02778
#> -3.5 -3.5 100.00000
#> -3.4 -3.4  99.16667
#> -3.3 -3.3 105.33333
#> -3.2 -3.2 106.02778
#> -3.1 -3.1 113.44444
#> -3   -3.0 124.41667
#> -2.9 -2.9 154.30556
#> -2.8 -2.8 139.55556
#> -2.7 -2.7 120.00000
#> -2.6 -2.6  63.66667
#> -2.5 -2.5        NA

# another way of creating a results df
df2 <- x |> as.data.frame()
df2$time <- x |> names() |> as.numeric()
df2
#>              x time
#> -3.9        NA -3.9
#> -3.8  72.44444 -3.8
#> -3.7 106.61111 -3.7
#> -3.6 106.02778 -3.6
#> -3.5 100.00000 -3.5
#> -3.4  99.16667 -3.4
#> -3.3 105.33333 -3.3
#> -3.2 106.02778 -3.2
#> -3.1 113.44444 -3.1
#> -3   124.41667 -3.0
#> -2.9 154.30556 -2.9
#> -2.8 139.55556 -2.8
#> -2.7 120.00000 -2.7
#> -2.6  63.66667 -2.6
#> -2.5        NA -2.5

创建于2023-09-20使用reprex v2.0.2
关于aggregate

df3 <- aggregate(cellcounts ~ time, df, mean)
df3$cellcounts <- zoo::rollapply(df3$cellcounts, width = 3, FUN = mean, align = "center", fill = NA)
df3
#>    time cellcounts
#> 1  -3.9         NA
#> 2  -3.8   72.44444
#> 3  -3.7  106.61111
#> 4  -3.6  106.02778
#> 5  -3.5  100.00000
#> 6  -3.4   99.16667
#> 7  -3.3  105.33333
#> 8  -3.2  106.02778
#> 9  -3.1  113.44444
#> 10 -3.0  124.41667
#> 11 -2.9  154.30556
#> 12 -2.8  139.55556
#> 13 -2.7  120.00000
#> 14 -2.6   63.66667
#> 15 -2.5         NA

创建于2023-09-20使用reprex v2.0.2

dplyr

使用summarise计算按时间分组的均值,然后计算滚动均值。

suppressPackageStartupMessages(
  library(dplyr)
)

df %>%
  group_by(time) %>%
  summarise(cellmeans = mean(cellcounts, .groups = "drop")) %>%
  mutate(cellmeans = zoo::rollapply(cellmeans, width = 3, FUN = mean, align = "center", fill = NA))
#> # A tibble: 15 × 2
#>     time cellmeans
#>    <dbl>     <dbl>
#>  1  -3.9      NA  
#>  2  -3.8      72.4
#>  3  -3.7     107. 
#>  4  -3.6     106. 
#>  5  -3.5     100  
#>  6  -3.4      99.2
#>  7  -3.3     105. 
#>  8  -3.2     106. 
#>  9  -3.1     113. 
#> 10  -3       124. 
#> 11  -2.9     154. 
#> 12  -2.8     140. 
#> 13  -2.7     120  
#> 14  -2.6      63.7
#> 15  -2.5      NA

创建于2023-09-20使用reprex v2.0.2

5jvtdoz2

5jvtdoz24#

zoo-FAQ建议对每次具有多个测量值的时间序列进行重复数据消除。
下面是一个示例,aggregate()使用mean()复制度量值,然后应用滚动平均值。

library(zoo)

z <- zoo(cellcounts, time)
#> Warning in zoo(cellcounts, time): some methods for "zoo" objects do not work if
#> the index entries in 'order.by' are not unique
z <- aggregate(z, identity, mean)

rollapply(
  z,
  width = 3,
  FUN = mean,
  align = "center",
  # partial = TRUE, # uncomment to include means for first and last entries
  fill = NA
)
#>      -3.9      -3.8      -3.7      -3.6      -3.5      -3.4      -3.3      -3.2 
#>        NA  72.44444 106.61111 106.02778 100.00000  99.16667 105.33333 106.02778 
#>      -3.1        -3      -2.9      -2.8      -2.7      -2.6      -2.5 
#> 113.44444 124.41667 154.30556 139.55556 120.00000  63.66667        NA
deikduxw

deikduxw5#

使用dplyr和slider
我们使用consecutive_id来创建一个递增的整数ID,确保相邻的时间点之间总是相隔1的距离。
然后,我们将该ID传递给slide_index_meanslide_index_mean通过计算共享时间间隔的平均值来考虑重复的时间点。

library(dplyr)
library(slider)
df %>%
  mutate(time_id = consecutive_id(time)) %>%
  mutate(mean = slide_index_mean(cellcounts, i = time_id, before = 1, after = 1)) %>%
  distinct(time_id, .keep_all = TRUE) %>%
  select(time, mean)

   time    mean
1  -3.9  49.500
2  -3.8  79.000
3  -3.7 108.286
4  -3.6 104.333
5  -3.5  98.500
6  -3.4  99.167
7  -3.3 105.333
8  -3.2 106.364
9  -3.1 114.455
10 -3.0 124.700
11 -2.9 147.111
12 -2.8 140.143
13 -2.7 120.000
14 -2.6  63.667
15 -2.5  54.000

相关问题