[R] problem with user defined panel function in xyplot

[Monica Pisica]

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)

 

}