【问题标题】:In R, is it possible to include the same row in multiple groups, or is there other workaround?在 R 中,是否可以在多个组中包含同一行,或者是否有其他解决方法?
【发布时间】:2015-11-18 18:30:02
【问题描述】:

我在一天中的多个时间点(不等间隔)测量了土壤中的 N20 通量。我试图通过找到给定日期曲线下的面积来计算土壤中的总 N20 通量。我知道在仅使用给定日期的度量时如何执行此操作,但是,我想包括前一天的最后一个度量和第二天的第一个度量以改进对曲线的估计。

这是一个给出更具体想法的示例:

library(MESS)
library(lubridate)
library(dplyr)

生成可重现的示例

datetime <- seq(ymd_hm('2015-04-07 11:20'),ymd('2015-04-13'), by = 'hours')
dat <- data.frame(datetime, day = day(datetime), Flux = rnorm(n = length(datetime), mean = 400, sd = 20))

useDate <- data.frame(day = c(7:12), DateGood = c("No", "Yes", "Yes", "No", "Yes", "No"))
  dat <- left_join(dat, useDate)

有些日子是“坏的”(太多缺失的措施),有些日子是“好”的(可用的)。目标是过滤在“好”日发生的所有测量(行)以及前一天的最后一次测量和第二天的第一次测量。

  out <- dat %>%
      mutate(lagDateGood = lag(DateGood),
             leadDateGood = lead(DateGood)) %>%
      filter(lagDateGood != "No" | leadDateGood != "No")

现在我需要计算曲线下的面积 - 这是不正确的

out2 <- out %>%
    group_by(day) %>%
    mutate(hourOfday = hour(datetime) + minute(datetime)/60) %>%
    summarize(auc = auc(x = hourOfday, y = Flux, from = 0, to = 24, type = "spline"))

问题是我在计算 AUC 时没有包括前一天结束和第二天开始的测量值。此外,我还估算了第 10 天的通量,这是“糟糕”的一天。

我认为我的问题的症结与团体有关。一些测量需要在多个组中(例如,第 8 天的最后一次测量将用于估计第 8 天和第 9 天的 AUC)。你对我如何组建新小组有什么建议吗?或者是否有完全不同的方式来实现目标?

【问题讨论】:

  • 如果您希望一个值在多个组中,那么您需要在输入数据集中复制该值。我建议您创建第二个表,其中包含每天的“最后一个”值,并将日期向前推,以便我匹配第二天。添加一个新列来指示这种特殊情况是有意义的,然后将此数据集重新绑定到您的原始数据集。
  • 感谢您的评论,亚历克斯。我不确定我是否跟随你。我想我可以做到这一点,但我不确定这是否最有意义。前一天进行测量的时间对于正确计算样条曲线很重要。恐怕只是将其移至第二天会丢失此信息。
  • 因此添加一个仅包含组标识符的新列(执行计算的舍入日期)。将组是前一天的最后读数向前推,以便可以与第二天的原始读数一起收集。
  • 我想我明白你的意思了。我可以使用两列来描述这些组,然后为每个列进行汇总,以及 rbind 结果。我认为这样做可能比您的评论建议的要棘手。
  • 这是我发布的一个相关问题:stackoverflow.com/questions/33789627/…

标签: r dplyr lubridate


【解决方案1】:

对于它的价值,这就是我所做的。答案确实在于我在 cmets 中链接到的问题。从问题中“out”的数据框开始:

#Now I need to calculate the area under the curve for each day
n <- nrow(out)
extract <- function(ix) out[seq(max(1, min(ix)-1), min(n, max(ix) + 1)), ]
res <- lapply(split(1:n, out$day), extract)

calcTotalFlux <- function(df) {
    if (nrow(df) < 10) {              # make sure the day has at least 10 measures
        NA
    } else {
    day_midnight <- floor_date(df$datetime[2], "day")
    df %>%
    mutate(time = datetime - day_midnight) %>%
    summarize(TotalFlux = auc(x = time, y = Flux, from = 0, to = 1440, type = "spline"))}
}

do.call("rbind",lapply(res, calcTotalFlux))

    TotalFlux
7         NA
8   585230.2
9   579017.3
10        NA
11  563689.7
12        NA

【讨论】:

    【解决方案2】:

    这是另一种方式。更符合@Alex Brown 的建议。

     # Another way
    last <- out %>%
        group_by(day) %>%
        filter(datetime == max(datetime)) %>%
        ungroup() %>%
        mutate(day = day + 1)
    
    first <- out %>%
        group_by(day) %>%
        filter(datetime == min(datetime)) %>%
        ungroup() %>%
        mutate(day = day - 1)
    
    d <- rbind(out, last, first) %>%
        group_by(day) %>%
        arrange(datetime)
    
    n_measures_per_day <- d %>%
        summarize(n = n())
    
    d <- left_join(d, n_measures_per_day) %>%
        filter(n > 4)
    
    TotalFluxDF <- d %>%
        mutate(timeAtMidnight = floor_date(datetime[3], "day"),
               time = datetime - timeAtMidnight) %>%
        summarize(auc = auc(x = time, y = Flux, from = 0, to = 1440, type = "spline"))
    
    TotalFluxDF
    
    Source: local data frame [3 x 2]
    
        day      auc
      (dbl)    (dbl)
    1     8 585230.2
    2     9 579017.3
    3    11 563689.7
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2013-01-13
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多