R help - Sep 2012 - problem with user defined panel function in xyplot

Hi everyone,

?

I am trying to do a horizonplot using my own time series
data. I know that there is a horizonplot function in latticeExtra, but on
closer examination i think that the graph itself is slightly wrong (it displays
some regions as triangles and i think they should be trapezoids, and the red
regions (that are below the baseline) are displayed on top of the blue areas ?
while i think they should be next to each other with no overlap between red and
blue.

?

So using the library gbclip i did my own horizonplot
function that displays the graph as i want it. Now i want to use this graph as
a panel function in xyplot function from lattice to get the nice lattice type
of graph for all my categories in my time series. And ?.. i am getting this
error:" Error using packet 1, Argument "ts01" is missing with no
default"fFor each of my columns.

?

Now my function called panel.tsfold takes as argument one
column from a time series or a zoo object that has only 1 time series. How can
i make the xyplot function to send to the panel function one column from the
bigger time series dataset?

?

My command that gives me error is: xyplot(ts00,
panel =panel.tsfold)

?

Thanks so much for any help,


Monica

?

Following is my function in case you would like to play
with it:

?

library(zoo)

library(latticeExtra)

library(gpclib)

?

setGeneric("translate.poly",
function(x, ...)

??????????
standardGeneric("translate.poly"))

?

setMethod("translate.poly",
signature(x = "gpc.poly"), 

????????? function(x, xscale=NA, yscale=NA,
...) {

????????????? x at pts <- lapply(x at pts,
function(p) {

????????????????? if (!is.na(xscale)) p$x <-
p$x + xscale

????????????????? if (!is.na(yscale)) p$y <-
p$y + yscale

????????????????? p

????????????? })

????????????? x

????????? })

?

?

setGeneric("flip.poly",
function(x, ...)

?????????? standardGeneric("flip.poly"))

?

setMethod("flip.poly",
signature(x = "gpc.poly"), 

????????? function(x, dir=dir, ...) {

????????????? x at pts <- lapply(x at pts,
function(p) {

????????????????? if (dir == "up")
p$y <- 2*max(p$y)-p$y

????????????????? if (dir == "down")
p$y <- 2*min(p$y)-p$y

????????????????? p

????????????? })

????????????? x

????????? })

?

panel.tsfold <- function(ts01, col.reg c("lightblue",
"#468CC8", "#0165B3",
"pink", "#E03231", "#B41414"), xlab = NA, ylab NA)
{

if (!is.null(dim(ts01))) ?ts01 <- ts00[,1]

bl <- coredata(ts01)[1]

y2 <- rep(bl, length(ts01))

ymin <- min(coredata(ts01), y2)

?

#vertices for
area under y1 

mat1 <-
cbind(c(index(ts01)[1], index(ts01), index(ts01)[length(index(ts01))]), c(ymin,
coredata(ts01), ymin))

?

#vertices for
area under y2

mat2 <-
cbind(c(index(ts01)[1],index(ts01), index(ts01)[length(index(ts01))]), c(ymin,
y2, ymin))

?

pp2 <-
as(mat2, "gpc.poly")

pp1 <-
as(mat1, "gpc.poly")

?

m <-max( (max(coredata(ts01)) - bl)/3,
abs(min(coredata(ts01)) - bl)/3)

m1 <- bl+m

m2 <- bl+2*m

?

##### cutting the blue poly above the baseline

# poly above the baseline

s1 <- setdiff(pp1, pp2)

y2 <- rep(m1, length(index(ts01)))

mat2a <-
cbind(c(index(ts01)[1],index(ts01), index(ts01)[length(index(ts01))]),
c(bl[[1]], y2, bl[[1]]))

pp2a <- as(mat2a,
"gpc.poly")

?

# poly above
baseline between baseline and first horizontal line at m1

sa1 <-
intersect(pp2a,s1)

?

# remaining
polygon - translate polygon down using my translate.poly function

s2 <- translate.poly(setdiff(s1, pp2a), yscale = -m)

?

# poly below the baseline

sb2 <- setdiff(pp2, pp1)

?

# poly below
the baseline flipped on top of the base line

sbf2 <-
flip.poly(sb2, dir = "up")

?

y2 <- rep(m1, length(index(ts01)))

mat2b <-
cbind(c(index(ts01)[1],index(ts01), index(ts01)[length(index(ts01))]),
c(bl[[1]],
y2, bl[[1]]))

pp2b <-
as(mat2b, "gpc.poly")

?

# poly above
baseline between baseline and first horizontal line at m1

sb1 <-
intersect(pp2b,sbf2)

?

# remaining
polygon

# translate polygon down using my translate.poly function

sb2 <- translate.poly(setdiff(sbf2, pp2b), yscale = -m)

?

# doing the graph

plot(index(ts01),
y2,? type="n", xlab = xlab,
ylab = ylab, ylim = c(bl[[1]], m1[[1]]))

?

plot(intersect(pp2a,s1),
poly.args=list(col=col.reg[1], border=col.reg[1]), add=TRUE)

plot(intersect(pp2a,s2),
poly.args=list(col=col.reg[2], border=col.reg[2]), add=TRUE)

plot(translate.poly(setdiff(s2,
pp2a), yscale = -m), poly.args=list(col=col.reg[3], border=col.reg[3]),
add=TRUE)

?

plot(intersect(pp2b,sb1),
poly.args=list(col=col.reg[4], border=col.reg[4]), add=TRUE)

plot(intersect(pp2b,sb2),
poly.args=list(col=col.reg[5], border=col.reg[5]), add=TRUE)

plot(translate.poly(setdiff(sb2,
pp2b), yscale = -m), poly.args=list(col=col.reg[6], border=col.reg[6]),
add=TRUE)

?

}

?

?