找到 Leverage/Hatvalue 个有影响力的观察结果

Finding Leverage/Hatvalue of Influential Observations

两个数据集:一个显然具有影响力的观察结果,另一个则没有。但是,当我找到 hatvalues 并使用经验法则测试时,第一个不表示撤消杠杆,第二个表示:

df1 <- dplyr::tribble(
  ~input_date,          ~input_reading,
  as.Date('2006-02-01'),         12428,
  as.Date('2006-02-17'),         12543,
  as.Date('2006-02-23'),         12555,
  as.Date('2006-03-14'),         12716,
  as.Date('2006-06-16'),         13275
)
fit1 <- lm(input_reading ~ input_date, data=df1)
hatvalues(fit1)

        1         2         3         4         5 
0.3594735 0.2625274 0.2376641 0.2002821 0.9400529

注意最后一次观察 (5)。它的帽值为 0.94,是帽值平均值的 2 倍或 3 倍以上,因此它被标记为有影响力。

df2 <- dplyr::tribble(
  ~input_date,          ~input_reading,
  as.Date('2006-02-17'),         12543,
  as.Date('2006-02-23'),         12555,
  as.Date('2006-03-14'),         12716,
  as.Date('2006-06-16'),         13275,
  as.Date('2006-07-23'),           247 # Obseravation is influential
)
fit2 <- lm(input_reading ~ input_date, data=df2)
hatvalues(fit2)

        1         2         3         4         5 
0.3833232 0.3491395 0.2641404 0.3635198 0.6398770

现在看最后一个观察,明显有影响,但它的值不超过平均值的2倍。

背景:数据集是随时间变化的值。每隔一段时间,这些值就会变得不稳定(异常、尖峰、重置、归零)。我的想法是使用 for 循环来计算每 5 个数据点的回归。当我遇到异常时,我可以编写一些逻辑来修复它。

在回归分析中,影响点是其删除对参数估计有很大影响的点。 DFBETAS 测量有影响点和没有影响点的每个参数估计值的差异(例如参见 [​​=17=])。
这是计算 dfbetas 度量的代码。

df1 <- structure(list(input_date = structure(1:5, .Label = c("  as.Date('2006-02-01')", 
"  as.Date('2006-02-17')", "  as.Date('2006-02-23')", "  as.Date('2006-03-14')", 
"  as.Date('2006-06-16')"), class = "factor"), input_reading = c(12428L, 
12543L, 12555L, 12716L, 13275L)), .Names = c("input_date", "input_reading"
), class = "data.frame", row.names = c(NA, -5L))

df1$input_date <- as.numeric(df1$input_date)
fit1 <- lm(input_reading ~ input_date, data=df1)

( dfbs1 <- dfbetas(fit1) )

#   (Intercept)    input_date
# 1  0.94689012 -7.851198e-01
# 2  0.07973496 -5.289019e-02
# 3 -0.18342246 -1.105316e-16
# 4  0.13852536 -4.594366e-01
# 5 -4.39111784  7.281845e+00

input_date 变量的 dfbetas 图是:

plot(1:nrow(dfbs1), dfbs1[,2], pch="+")

df2 <- structure(list(input_date = structure(1:5, .Label = c("  as.Date('2006-02-17')", 
"  as.Date('2006-02-23')", "  as.Date('2006-03-14')", "  as.Date('2006-06-16')", 
"  as.Date('2006-07-23')"), class = "factor"), input_reading = c(12543L, 
12555L, 12716L, 13275L, 247L)), .Names = c("input_date", "input_reading"
), class = "data.frame", row.names = c(NA, -5L))

df2$input_date <- as.numeric(df2$input_date)
fit2 <- lm(input_reading ~ input_date, data=df2)

( dfbs2 <- dfbetas(fit2) )

#   (Intercept)    input_date
# 1 -0.92324836  7.655171e-01
# 2 -0.01153703  7.652800e-03
# 3  0.10536710  4.104386e-17
# 4 -0.19892033  6.597441e-01
# 5 25.34283780 -4.202634e+01

plot(1:nrow(dfbs2), dfbs2[,2], pch="+")

结论。两个数据集中的两个影响点都被dfbetas正确检测到了。