根据这篇文章中的@Julius 的说法,是否可以使用stl
with na.approx
、 from zoo
package 、 using stl(x, na.action = na.approx, ...)
。这会进行某种插值。
不幸的是stl
,更喜欢常规时间序列。
因此,我采用@Julius 方法来测试假设时间序列不规则loess
的填充性能。NAs
显然误差很小。
让我们模拟
以下函数获取数据并使用3^(0:p)
NA模拟场景,naapprox=TRUE
用于使用na.approx
和optspan=TRUE
优化跨度参数。损失函数是 MAPE。
#The approach is based in @Julius stl with NAs
library(zoo)
library(plyr)
library(reshape)
library(ggplot2)
mape <- function(f, x) colMeans(abs(1 - f / x) * 100,na.rm=T)
loessCheck <- function(data,p=2, naapprox=TRUE, optspan=TRUE){
set.seed(20130201)
pos <- lapply(3^(0:p), function(x) sample(1:length(data), x))
datasetsNA <- lapply(pos, function(x) {data[x] <- NA; data})
original <- data.frame(y.predict=as.numeric(data))
original$id <- "Original"
datasetsNA <- lapply(datasetsNA, function(y){
posna=which(is.na(y))
tvo=1:length(y)
yo=y;tv=tvo
if (any(posna%in%c(1,length(y)))) tv=tvo[-posna[which(posna%in%c(1,length(y)))]]
if(naapprox) y=na.approx(y) #instead of inside loess
if(optspan){ fseq=function(x, y)
mape(matrix(predict(loess(y ~ dt, span=x, data.frame(dt=tv, y=y))),ncol=1),as.vector(y[!is.na(y)]))
ospan <- optimize(fseq, c(0.1,1), maximum=FALSE,y=y)
spanmim <- ospan$minimum
} else spanmim <- 0.75
y.loess <- loess(y ~ dt, span=spanmim, data.frame(dt=tv, y=y))
y.predict <- predict(y.loess, data.frame(dt=tvo))
y.predict[-posna] <- yo[-posna]
data.frame(y.predict,
id = paste(length(posna), "NAs"),
stringsAsFactors = FALSE)
})
loessAll <- rbind.fill(c(list(original), datasetsNA))
loessAll$Date <- time(data)
results <- data.frame(y.predict = sapply(lapply(datasetsNA, '[', i = "y.predict"), mape, original[, "y.predict"]))
results$id <- unique(loessAll$id[-(1:nrow(original))])
results <- melt(results, id.var = "id")
results$x <- min(loessAll$Date) + diff(range(loessAll$Date)) / 4
results$y <- min(original[, "y.predict"],na.rm=T) + diff(range(original[, "y.predict"],na.rm=T)) / (4 * p) * (0:p)
results$value <- round(results$value, 2)
ggplot(loessAll, aes(x = Date, y = y.predict, colour = id, group = id)) + geom_line() +
theme_bw() +
theme(legend.title = element_blank(), strip.background = element_rect(fill = "white")) +
labs(x = NULL, y = NULL) + scale_colour_brewer(palette = "Set1") +
lapply(unique(results$id), function(z)
geom_text(data = results, colour = "black", size = 3,
aes(x = x, y = y, label = paste0("MAPE (", id, "): ", value, "%"))))
}
args(loessCheck) # first boolean for using na.approx, the second for optimize span parameter in sample
loessCheck(nottem,p=3) #T T
loessCheck(nottem,p=3,FALSE) #FT
loessCheck(nottem,p=3,FALSE,FALSE)
loessCheck(nottem,p=3,TRUE,FALSE)
na.approx
从 zoo 包中使用时减少 MAPE并推荐span= 0.75
。在填充 NA 之后,可以考虑其他建模替代方案。