如何在R中使用acf（）用于多个子集？

Question

我正在尝试编写代码，为多个子集执行自相关。例如。随着时间的推移，我有多个国家的健康数据。我想让每个国家/地区的每个变量自相关。任何帮助都会很棒！ 以下是我尝试过的一些事情，但未成功：

require(plyr)
POP_ACF=acf(PhD_data_list_view$POP, lag.max=NULL, type=c("correlation"), 
            plot=TRUE, na.action=na.pass, demean=TRUE)

dlply(PhD_data_list_view, .(Country), function(x) POP_ACF %+% x)

POP_ACF=function(PhD_data_list_view$POP) c(acf(PhD_data_list_view$POP, plot=TRUE)$acf)

Answer 1

acf是一个函数，它接受一个向量并返回一个列表。这使得它很适合purrr包，它将函数映射到列表上，但也可以使用基数R来完成。

我将使用beaver1包中的datasets数据集，因为您没有提供自己的数据集。我将使用不同的观察天数作为不同国家的类比，以及POP变量的温度。

基地R：

• split将向量beaver1$temp转换为第二个参数beaver1$day的向量列表。
• 然后mapply在该列表的每个元素上运行函数acf。
• 由于我们使用mapply代替lapply，我们还可以提供另一个参数列表，此处为每个图表的标题main = unique(beaver1$day)。
• 最后一个参数SIMPLIFY = F告诉它返回默认输出，而不是尝试将列表强制转换为其他任何内容。

par(mfrow = c(1,2))
mapply(acf, 
       split(beaver1$temp, beaver1$day), 
       main = unique(beaver1$day), 
       SIMPLIFY = F)

# $`346`
# 
# Autocorrelations of series ‘dots[[1L]][[1L]]’, by lag
# 
#     0     1     2     3     4     5     6     7     8     9    10    11    12    13    14    15    16    17    18    19 
# 1.000 0.838 0.698 0.593 0.468 0.355 0.265 0.167 0.113 0.069 0.028 0.037 0.087 0.108 0.145 0.177 0.151 0.125 0.123 0.106 

# $`347`
# 
# Autocorrelations of series ‘dots[[1L]][[2L]]’, by lag
# 
#      0      1      2      3      4      5      6      7      8      9     10     11     12     13 
#  1.000  0.546  0.335  0.130  0.080  0.024 -0.025 -0.103 -0.090 -0.032  0.168  0.036 -0.089 -0.306 

purrr和整洁的方式：

根据您想要对输出执行的操作，这种方式更灵活一些。我们可以使用purrr::map作为mapply的直接插入内容：

library(purrr)

beaver1 %>% 
  split(.$day) %>% 
  map(~acf(.$temp, main = unique(.$day))) 

返回完全相同的输出。但我们也可以完全整理并从acf作为数据框返回数据，以便我们可以使用ggplot2进一步探索它。

• 第一个map返回一个输出列表，每个输出都是一个列表，其中包含变量滞后， acf 和<强> n.used 即可。
• map_dfr正在运行函数data.frame，将每个变量分配给新列。
• 我们还制作了一个列来计算CI。请参阅：How is the confidence interval calculated for the ACF function?
• 然后我们可以使用ggplot制作我们想要的任何类型的情节，我们仍然拥有您想要进行的任何其他分析的数据。

library(ggplot2)
beaver_acf <-
  beaver1 %>% 
    split(.$day) %>% 
    map(~acf(.$temp, plot = F)) %>% 
    map_dfr(
      ~data.frame(lag = .$lag, 
                  acf = .$acf,
                  ci = qnorm(0.975)/sqrt(.$n.used)
            ), .id = "day") 

head(beaver_acf)

#   day lag       acf        ci
# 1 346   0 1.0000000 0.2054601
# 2 346   1 0.8378889 0.2054601
# 3 346   2 0.6983476 0.2054601
# 4 346   3 0.5928198 0.2054601
# 5 346   4 0.4680912 0.2054601
# 6 346   5 0.3554939 0.2054601


ggplot(beaver_acf, aes(lag, acf)) + 
  geom_segment(aes(xend = lag, yend = 0)) +
  geom_hline(aes(yintercept = ci), linetype = "dashed", color = "blue") +
  geom_hline(aes(yintercept = -ci), linetype = "dashed", color = "blue") +
  facet_wrap(~variable)