我用预测包预测.Below是我预测的结果。
#CODE
library(forecast)
DATA_SET<-data.frame(TEST=c(200,220,200,260,300,290,320,340,360,500,200,300,400,250,350,390,400,450,470,350,300,220,580,450,120,250,360,470)
)
View(DATA_SET)
# Making TS object
TS_DATA_SET<-ts(DATA_SET,start=c(2010,1),frequency = 12)
# Forecasting
TS_FORECAST<-auto.arima(TS_DATA_SET)
所以现在我想从checkresiduals函数中提取p值到数据框中,
#Checking residuals
checkresiduals(TS_FORECAST, plot = FALSE)
## Ljung-Box test
##
## data: Residuals from ARIMA(0,0,0) with non-zero mean
## Q* = 4.5113, df = 4.6, p-value = 0.4237
##
## Model df: 1. Total lags used: 5.6
我正在尝试下面的代码,但我有问题
p-value<-data.frame(checkresiduals(TS_FORECAST, plot = FALSE))
p_value
#data frame with 0 columns and 0 rows
那么任何人都可以帮助我如何从checkresiduals函数中提取p值(p值= 0.4237)到data.frame?
不幸的是,函数checkresiduals()
不返回值,只是prints()
它们。您可以通过编写没有括号的checkresiduals
来查看该功能。或者你检查开发者的github。
您可以通过在其中放入return()
来重写该功能。我只是复制粘贴功能并将其插入到最后:
checkresiduals <- function(object, lag, df=NULL, test, plot=TRUE, ...) {
showtest <- TRUE
if (missing(test)) {
if (is.element("lm", class(object))) {
test <- "BG"
} else {
test <- "LB"
}
showtest <- TRUE
}
else if (test != FALSE) {
test <- match.arg(test, c("LB", "BG"))
showtest <- TRUE
}
else {
showtest <- FALSE
}
# Extract residuals
if (is.element("ts", class(object)) | is.element("numeric", class(object))) {
residuals <- object
object <- list(method = "Missing")
}
else {
residuals <- residuals(object)
}
if (length(residuals) == 0L) {
stop("No residuals found")
}
if ("ar" %in% class(object)) {
method <- paste("AR(", object$order, ")", sep = "")
} else if (!is.null(object$method)) {
method <- object$method
} else if ("HoltWinters" %in% class(object)) {
method <- "HoltWinters"
} else if ("StructTS" %in% class(object)) {
method <- "StructTS"
} else {
method <- try(as.character(object), silent = TRUE)
if ("try-error" %in% class(method)) {
method <- "Missing"
} else if (length(method) > 1 | base::nchar(method[1]) > 50) {
method <- "Missing"
}
}
if (method == "Missing") {
main <- "Residuals"
} else {
main <- paste("Residuals from", method)
}
if (plot) {
suppressWarnings(ggtsdisplay(residuals, plot.type = "histogram", main = main, ...))
}
# Check if we have the model
if (is.element("forecast", class(object))) {
object <- object$model
}
if (is.null(object) | !showtest) {
return(invisible())
}
# Seasonality of data
freq <- frequency(residuals)
# Find model df
if(grepl("STL \\+ ", method)){
warning("The fitted degrees of freedom is based on the model used for the seasonally adjusted data.")
}
df <- modeldf(object)
if (missing(lag)) {
lag <- ifelse(freq > 1, 2 * freq, 10)
lag <- min(lag, round(length(residuals)/5))
lag <- max(df+3, lag)
}
if (!is.null(df)) {
if (test == "BG") {
# Do Breusch-Godfrey test
BGtest <- lmtest::bgtest(object, order = lag)
BGtest$data.name <- main
print(BGtest)
return(BGtest)
}
else {
# Do Ljung-Box test
LBtest <- Box.test(zoo::na.approx(residuals), fitdf = df, lag = lag, type = "Ljung")
LBtest$method <- "Ljung-Box test"
LBtest$data.name <- main
names(LBtest$statistic) <- "Q*"
print(LBtest)
cat(paste("Model df: ", df, ". Total lags used: ", lag, "\n\n", sep = ""))
return(LBtest)
}
}
}
你还需要modeldf()
的github file功能
modeldf <- function(object, ...){
UseMethod("modeldf")
}
modeldf.Arima <- function(object, ...){
length(object$coef)
}
使用此解决方案,您可以使用原始的checkresiduals功能。现在您可以使用以下命令调用p.value:
res_values <- checkresiduals(TS_FORECAST, plot = TRUE)
res_values$p.value
您也可以自己使用Ljung-Box
和Breusch-Godfrey test
并忽略checkresiduals()
函数,因为这是checkresiduals()
所做的。
我认为编辑checkresiduals()
函数是一种更方便的方式,所以你可以像习惯它一样使用它。您可以将其粘贴到代码中,它应该完成工作。只需确保在调用函数之前声明modeldf()
和modeldf().Arima
。它也可以测试功能。
选项2,因为它是可能的:
您可以使用capture.output()
捕获输出
capture.output(checkresiduals(TS_FORECAST, plot = FALSE))[5]
“Q * = 4.8322,df = 5,p值= 0.4367”
使用grep命令,应该可以在不更改函数的情况下提取p值。由于我不熟悉grep,我无法就此任务提供正确的答案。
Here你可以看到checkresiduals()
的内部。
不幸的是,根据文档,它不会返回值,因此您无法轻松提取所需内容。
但您可以进行相同的计算(查看链接仓库中的第125行):
Box.test(zoo::na.approx(TS_FORECAST$residuals), type = "Ljung")
在将输出分配给变量后,要访问p值,只需使用$p.value
。
请注意,在我的快速示例中,它有点不同,因为我使用了默认值:
# r$p.value
# [1] 0.3678976