Một mô hình AR (1) với sự can thiệp được xác định trong phương trình được đưa ra trong câu hỏi có thể được trang bị như hình dưới đây. Lưu ý cách transfer
xác định đối số ; bạn cũng cần một biến chỉ báo xtransf
cho mỗi một trong số các can thiệp (xung và thay đổi tạm thời):
require(TSA)
cds <- structure(c(2580L, 2263L, 3679L, 3461L, 3645L, 3716L, 3955L, 3362L,
2637L, 2524L, 2084L, 2031L, 2256L, 2401L, 3253L, 2881L,
2555L, 2585L, 3015L, 2608L, 3676L, 5763L, 4626L, 3848L,
4523L, 4186L, 4070L, 4000L, 3498L),
.Dim = c(29L, 1L),
.Dimnames = list(NULL, "CD"),
.Tsp = c(2012, 2014.33333333333, 12),
class = "ts")
fit <- arimax(log(cds), order = c(1, 0, 0),
xtransf = data.frame(Oct13a = 1 * (seq_along(cds) == 22),
Oct13b = 1 * (seq_along(cds) == 22)),
transfer = list(c(0, 0), c(1, 0)))
fit
# Coefficients:
# ar1 intercept Oct13a-MA0 Oct13b-AR1 Oct13b-MA0
# 0.5599 7.9643 0.1251 0.9231 0.4332
# s.e. 0.1563 0.0684 0.1911 0.1146 0.2168
# sigma^2 estimated as 0.02131: log likelihood = 14.47, aic = -18.94
Bạn có thể kiểm tra tầm quan trọng của từng can thiệp bằng cách xem thống kê t của các hệ số và . Để thuận tiện, bạn có thể sử dụng chức năng .ω 1ω0ω1coeftest
require(lmtest)
coeftest(fit)
# Estimate Std. Error z value Pr(>|z|)
# ar1 0.559855 0.156334 3.5811 0.0003421 ***
# intercept 7.964324 0.068369 116.4896 < 2.2e-16 ***
# Oct13a-MA0 0.125059 0.191067 0.6545 0.5127720
# Oct13b-AR1 0.923112 0.114581 8.0564 7.858e-16 ***
# Oct13b-MA0 0.433213 0.216835 1.9979 0.0457281 *
# ---
# Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Trong trường hợp này, xung không có ý nghĩa ở mức ý nghĩa . Tác dụng của nó có thể đã bị bắt bởi sự thay đổi nhất thời.5 %
Hiệu quả can thiệp có thể được định lượng như sau:
intv.effect <- 1 * (seq_along(cds) == 22)
intv.effect <- ts(
intv.effect * 0.1251 +
filter(intv.effect, filter = 0.9231, method = "rec", sides = 1) * 0.4332)
intv.effect <- exp(intv.effect)
tsp(intv.effect) <- tsp(cds)
Bạn có thể vẽ hiệu quả của sự can thiệp như sau:
plot(100 * (intv.effect - 1), type = "h", main = "Total intervention effect")
Hiệu ứng tương đối dai dẳng vì gần bằng (nếu bằng chúng tôi sẽ quan sát sự thay đổi cấp độ vĩnh viễn). 1 ω 2 1ω21ω21
Về mặt số lượng, đây là những mức tăng ước tính được định lượng tại từng thời điểm do can thiệp vào tháng 10 năm 2013:
window(100 * (intv.effect - 1), start = c(2013, 10))
# Jan Feb Mar Apr May Jun Jul Aug Sep Oct
# 2013 74.76989
# 2014 40.60004 36.96366 33.69046 30.73844 28.07132
# Nov Dec
# 2013 49.16560 44.64838
Can thiệp làm tăng giá trị của biến quan sát vào tháng 10 năm 2013 khoảng . Trong các giai đoạn tiếp theo, hiệu quả vẫn còn nhưng với trọng lượng giảm dần.75 %
Chúng ta cũng có thể tạo ra các can thiệp bằng tay và chuyển chúng thành stats::arima
các hồi quy bên ngoài. Các can thiệp là một xung cộng với thay đổi tạm thời với tham số và có thể được xây dựng như sau.0,9231
xreg <- cbind(
I1 = 1 * (seq_along(cds) == 22),
I2 = filter(1 * (seq_along(cds) == 22), filter = 0.9231, method = "rec",
sides = 1))
arima(log(cds), order = c(1, 0, 0), xreg = xreg)
# Coefficients:
# ar1 intercept I1 I2
# 0.5598 7.9643 0.1251 0.4332
# s.e. 0.1562 0.0671 0.1563 0.1620
# sigma^2 estimated as 0.02131: log likelihood = 14.47, aic = -20.94
Các ước tính tương tự của các hệ số như trên được thu được. Ở đây chúng tôi đã sửa thành . Ma trận là loại biến giả mà bạn có thể cần phải thử các kịch bản khác nhau. Bạn cũng có thể đặt các giá trị khác nhau cho và so sánh hiệu quả của nó. 0,9231 ω 2ω20,9231xreg
ω2
Những can thiệp này tương đương với một ngoại lệ phụ gia (AO) và thay đổi tạm thời (TC) được xác định trong gói tsoutliers
. Bạn có thể sử dụng gói này để phát hiện các hiệu ứng này như được hiển thị trong câu trả lời của @forecaster hoặc để xây dựng các hồi quy được sử dụng trước đó. Ví dụ: trong trường hợp này:
require(tsoutliers)
mo <- outliers(c("AO", "TC"), c(22, 22))
oe <- outliers.effects(mo, length(cds), delta = 0.9231)
arima(log(cds), order = c(1, 0, 0), xreg = oe)
# Coefficients:
# ar1 intercept AO22 TC22
# 0.5598 7.9643 0.1251 0.4332
# s.e. 0.1562 0.0671 0.1563 0.1620
# sigma^2 estimated as 0.02131: log likelihood=14.47
# AIC=-20.94 AICc=-18.33 BIC=-14.1
Chỉnh sửa 1
Tôi đã thấy rằng phương trình mà bạn đưa ra có thể được viết lại thành:
( ω0+ ω1) - ω0ω2B1 - ω2BPt
và nó có thể được chỉ định như bạn đã sử dụng transfer=list(c(1, 1))
.
Như được hiển thị bên dưới, trong trường hợp này, việc tham số hóa này dẫn đến các ước tính tham số liên quan đến một hiệu ứng khác so với tham số hóa trước đó. Nó nhắc nhở tôi về tác động của một ngoại lệ đổi mới thay vì xung cộng với thay đổi nhất thời.
fit2 <- arimax(log(cds), order=c(1, 0, 0), include.mean = TRUE,
xtransf=data.frame(Oct13 = 1 * (seq(cds) == 22)), transfer = list(c(1, 1)))
fit2
# ARIMA(1,0,0) with non-zero mean
# Coefficients:
# ar1 intercept Oct13-AR1 Oct13-MA0 Oct13-MA1
# 0.7619 8.0345 -0.4429 0.4261 0.3567
# s.e. 0.1206 0.1090 0.3993 0.1340 0.1557
# sigma^2 estimated as 0.02289: log likelihood=12.71
# AIC=-15.42 AICc=-11.61 BIC=-7.22
Tôi không quen thuộc lắm với ký hiệu của gói TSA
nhưng tôi nghĩ rằng hiệu quả của can thiệp hiện có thể được định lượng như sau:
intv.effect <- 1 * (seq_along(cds) == 22)
intv.effect <- ts(intv.effect * 0.4261 +
filter(intv.effect, filter = -0.4429, method = "rec", sides = 1) * 0.3567)
tsp(intv.effect) <- tsp(cds)
window(100 * (exp(intv.effect) - 1), start = c(2013, 10))
# Jan Feb Mar Apr May Jun Jul Aug
# 2014 -3.0514633 1.3820052 -0.6060551 0.2696013 -0.1191747
# Sep Oct Nov Dec
# 2013 118.7588947 -14.6135216 7.2476455
plot(100 * (exp(intv.effect) - 1), type = "h",
main = "Intervention effect (parameterization 2)")
Hiệu ứng có thể được mô tả ngay bây giờ là sự gia tăng mạnh vào tháng 10 năm 2013 sau đó là giảm theo hướng ngược lại; sau đó hiệu quả của can thiệp biến mất nhanh chóng xen kẽ các tác động tích cực và tiêu cực của trọng lượng phân rã.
Hiệu ứng này có phần kỳ dị nhưng có thể có trong dữ liệu thực. Tại thời điểm này tôi sẽ xem xét bối cảnh dữ liệu của bạn và các sự kiện có thể đã ảnh hưởng đến dữ liệu. Ví dụ: đã có thay đổi chính sách, chiến dịch tiếp thị, khám phá, ... có thể giải thích sự can thiệp vào tháng 10 năm 2013. Nếu vậy, điều hợp lý hơn là sự kiện này có ảnh hưởng đến dữ liệu như được mô tả trước đây hoặc như chúng tôi đã tìm thấy với tham số ban đầu?
Theo AIC, mô hình ban đầu sẽ được ưa thích vì nó thấp hơn ( so với ). Cốt truyện của loạt phim gốc không đề xuất sự phù hợp rõ ràng với những thay đổi mạnh mẽ liên quan đến việc đo lường biến can thiệp thứ hai.- 15,42- 18,94- 15,42
Không biết ngữ cảnh của dữ liệu, tôi sẽ nói rằng mô hình AR (1) có thay đổi nhất thời với tham số sẽ phù hợp để mô hình hóa dữ liệu và đo lường sự can thiệp.0.9
Chỉnh sửa 2
Giá trị của xác định mức độ ảnh hưởng của can thiệp giảm xuống 0, do đó, đó là tham số chính trong mô hình. Chúng ta có thể kiểm tra điều này bằng cách điều chỉnh mô hình cho một loạt các giá trị của . Dưới đây, AIC được lưu trữ cho mỗi mô hình này.ω 2ω2ω2
omegas <- seq(0.5, 1, by = 0.01)
aics <- rep(NA, length(omegas))
for (i in seq(along = omegas)) {
tc <- filter(1 * (seq_along(cds) == 22), filter = omegas[i], method = "rec",
sides = 1)
tc <- ts(tc, start = start(cds), frequency = frequency(cds))
fit <- arima(log(cds), order = c(1, 0, 0), xreg = tc)
aics[i] <- AIC(fit)
}
omegas[which.min(aics)]
# [1] 0.88
plot(omegas, aics, main = "AIC for different values of the TC parameter")
AIC thấp nhất được tìm thấy cho (phù hợp với giá trị ước tính trước đó). Tham số này liên quan đến một hiệu ứng tương đối dai dẳng nhưng nhất thời. Chúng tôi có thể kết luận rằng hiệu ứng là tạm thời vì với các giá trị cao hơn , AIC tăng (hãy nhớ rằng trong giới hạn, , sự can thiệp sẽ trở thành một sự thay đổi cấp độ vĩnh viễn).0,9 ω 2 = 1ω2=0.880.9ω2=1
Can thiệp nên được bao gồm trong các dự báo. Lấy dự báo cho các giai đoạn đã được quan sát là một bài tập hữu ích để đánh giá hiệu suất của các dự báo. Mã dưới đây giả định rằng chuỗi kết thúc vào tháng 10 năm 2013. Dự báo sau đó được thu nhận bao gồm cả can thiệp với tham số .ω2=0.9
Trước tiên, chúng tôi phù hợp với mô hình AR (1) với sự can thiệp là một biến hồi quy (với tham số ):ω2=0.9
tc <- filter(1 * (seq.int(length(cds) + 12) == 22), filter = 0.9, method = "rec",
sides = 1)
tc <- ts(tc, start = start(cds), frequency = frequency(cds))
fit <- arima(window(log(cds), end = c(2013, 10)), order = c(1, 0, 0),
xreg = window(tc, end = c(2013, 10)))
Các dự báo có thể được lấy và hiển thị như sau:
p <- predict(fit, n.ahead = 19, newxreg = window(tc, start = c(2013, 11)))
plot(cbind(window(cds, end = c(2013, 10)), exp(p$pred)), plot.type = "single",
ylab = "", type = "n")
lines(window(cds, end = c(2013, 10)), type = "b")
lines(window(cds, start = c(2013, 10)), col = "gray", lty = 2, type = "b")
lines(exp(p$pred), type = "b", col = "blue")
legend("topleft",
legend = c("observed before the intervention",
"observed after the intervention", "forecasts"),
lty = rep(1, 3), col = c("black", "gray", "blue"), bty = "n")
Các dự báo đầu tiên phù hợp tương đối tốt với các giá trị quan sát (đường chấm màu xám). Các dự báo còn lại cho thấy loạt bài sẽ tiếp tục đường dẫn đến giá trị trung bình ban đầu như thế nào. Khoảng tin cậy dù sao cũng lớn, phản ánh sự không chắc chắn. Do đó, chúng ta nên thận trọng và sửa đổi mô hình khi dữ liệu mới được ghi lại.
95%Khoảng tin cậy có thể được thêm vào âm mưu trước như sau:
lines(exp(p$pred + 1.96 * p$se), lty = 2, col = "red")
lines(exp(p$pred - 1.96 * p$se), lty = 2, col = "red")