R 中两个数据帧的时间方差

Variance over time with two dataframes in R

我有两个数据框。 df1 是一个数据框,其中每一行都是某人给出的分数。

df1

title <- c("x","x","x","x","y","y","y","y","y")
day <- c(0,2,2,4,1,1,3,3,4)
score <- c(7,7,6,4,8,1,7,1,5)
df1 = data.frame(title,day,score)

df2 是长格式的 title-day 格式的面板数据集,有很多变量。我正在寻找一种方法来改变第 x 天的方差分数和随时间变化的方差分数(即第 x 天的分数方差和所有以前的分数)。

它应该是这样的:

title <- c("x","x","x","x","x","y","y","y","y","y")
day <- c(0,1,2,3,4,0,1,2,3,4)
variance_day_x <- c(0,0,0.5,0,0,0,24.5,0,12,0)
variance_cumulative <- c(0,0,0.3333,0.3333,2,0,24.5,24.5,14.25,10.8)
df2 <- data.frame(title,day,variance_day_x,variance_cumulative)

如您所见,我需要将 df1 中的 2 个变量转变为 df2。每天的方差是第一个变量,当那天有 0 或 1 个分数可用时方差 = 0,因为没有什么可计算的。第二个变量是累积方差,每次有新分数可用时都需要更新方差。

希望这足以解释我的问题。我现在卡住了,希望大家能帮忙!

有点乱的 Base R 解决方案:

df_variances <- cbind(df1,  data.frame(do.call("rbind", lapply(split(df1, df1$title),
       function(x){
        variance_cumulative <- sapply(seq_len(nrow(x)), function(i){
          z <- var(x$score[1:i]) 
          }
        )
        variance_day_x <- sapply(seq_len(nrow(x)), function(j){
          q <- var(x$score[(j-1):j])
          }
        )
       variance_df <- data.frame(variance_day_x = variance_day_x,
                                 variance_cumulative = variance_cumulative)
    }
  )
), row.names =  NULL))

df_clean <- replace(df_variances, is.na(df_variances), 0)

使用 tidyverse 你可以尝试这样的事情。首先 group_by title 并使用可以从 mutate 调用的自定义累积方差函数。在按 titleday 分组后计算日方差。 complete 将填补缺失的天数,fill 将结转那些缺失天数的累积方差。如果您愿意,可以将 NA 替换为零 replace_na.

library(tidyverse)

cumvar <- function(x)  {
  sapply(seq_along(x), function(i) var(x[1:i]))
}

df1 %>%
  group_by(title) %>%
  mutate(cvar = cumvar(score)) %>%
  group_by(title, day) %>%
  summarise(variance_day_x = var(score),
            variance_cumulative = last(cvar)) %>%
  complete(title, day = 0:4) %>%
  fill(variance_cumulative, .direction = "down")

输出

# A tibble: 10 x 4
# Groups:   title [2]
   title   day variance_day_x variance_cumulative
   <chr> <dbl>          <dbl>               <dbl>
 1 x         0           NA                NA    
 2 x         1           NA                NA    
 3 x         2            0.5               0.333
 4 x         3           NA                 0.333
 5 x         4           NA                 2    
 6 y         0           NA                NA    
 7 y         1           24.5              24.5  
 8 y         2           NA                24.5  
 9 y         3           18                14.2  
10 y         4           NA                10.8

另一个基本的 R 解决方案。我还使用自定义 cumvar 函数。此外,我使用 @Ruben's great repeat_last function 用最后已知值填充 NAs。

这个解决方案主要基于ave,它将一个函数应用于一个变量,由其他变量分组。由于日期不完整,我们可以将原始数据 merge 为包含所有 unique 标题和日期的完整数据集。在计算 variances 之前,我们先计算累积方差;这个想法是 select 以后使用 length 每天 "newer" 值。最后我们删除了dupes,就大功告成了。

cumvar <- function(x) sapply(1:length(x), function(i) {var(x[1:i])})
df1$vari.cum <- with(df1, ave(score, title, FUN=cumvar))
compl <- expand.grid(title=unique(df1$title), day=unique(df1$day))
dfx <- merge(compl, df1, all.x= TRUE)
dfx$vari.cum <- with(dfx, ave(vari.cum, title, FUN=repeat_last))
res <- within(dfx, {
  vari.day <- ave(score, title, day, FUN=var)
  vari.cum <- ave(vari.cum, title, day, FUN=function(x) x[length(x)])
})
res <- res[!duplicated(res[c("title", "day")]), c(1:2, 5:4)]
res
#   title day vari.day   vari.cum
# 1      x   0       NA         NA
# 2      x   1       NA         NA
# 3      x   2      0.5  0.3333333
# 5      x   3       NA  0.3333333
# 6      x   4       NA  2.0000000
# 7      y   0       NA         NA
# 8      y   1     24.5 24.5000000
# 10     y   2       NA 24.5000000
# 11     y   3     18.0 14.2500000
# 13     y   4       NA 10.8000000