plotVar <- function(op, ylab="variance", xlab="x", panel=var.panel, auto.key=list(lines=TRUE, points=FALSE, columns=3), ...) {
require(lattice)
var.panel <- function(x, y, ...) {
# panel.polygon(c(op$at[1]-1000, op$n.b, op$n.b, op$at[1]-1000), c(0, 0, 100, 100), border=NA, fill="lightgray")
panel.grid(h=-1, v=FALSE)
if(op$at[1]<1)
panel.abline(v=1, lty=2, col="black")
if(tail(op$at, 1) > n)
panel.abline(v=n, lty=2, col="black")
panel.xyplot(x, y, ...)
}
if(class(op) == "opblend") {
n <- ncol(op$O)
d <- with(op, make.groups(
from.var = from.var,
to.var = to.var,
blend.var = var)
)
d$x <- rep(op$at, 3)
lab <- paste(round(op$blend.p*100), "% blend from deg=", op$from.deg, " span=", op$from.span, " to deg=", op$to.deg, " span=", op$to.span, sep="")
p <- xyplot(data ~ x | lab, groups=which, data=d, type="l",
panel=panel,
xlab=xlab,
ylab=ylab,
auto.key=auto.key,
...
)
} else if(class(op) == "stlop") {
n <- ncol(op$fit$O)
if(op$pars$fc.number > 0) {
d <- with(op, make.groups(
"Total variance" = op$fit$var,
"Seasonal variance" = op$seas$var
))
for(i in 1:op$pars$fc.number) {
d <- rbind(d, data.frame(data=opVar(op$fc[[i]]), which=op$pars$fc.name[i]))
}
d$x <- rep(op$seas$at, 2 + op$pars$fc.number)
} else {
d <- with(op, make.groups(
"Total variance" = op$fit$var,
"Seasonal variance" = op$seas$var,
"Trend variance" = op$trend$var)
)
d$x <- rep(op$seas$at, 3)
}
p <- xyplot(data ~ x, groups=which, data=d, type="l",
panel=panel,
xlab=xlab,
ylab=ylab,
auto.key=auto.key,
...
)
} else {
n <- ncol(op$O)
lab <- ""
if(class(op) == "op")
lab <- paste("deg=", op$pars$deg, " span=", op$pars$span, sep="")
# sometimes all are equal ("periodic"), but not at several decimal places...
# if(all.equal(op$var, rep(op$var[1], length(op$var))))
# yy <- rep(op$var[1], length(op$var))
# else
yy <- op$var
p <- xyplot(yy ~ op$at | lab, panel=panel, type="l", xlab=xlab, ylab=ylab, ...)
}
p
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.