Adding textbox to multiple panels in lattice

Hi

Here's a panel function that does what I think you want (NOTE that you 
need to load 'grid' for this to work) ...

library(grid)

panel.tpop <- function(x,y,...){
     panel.grid(h=length(agegrs),v=5,col="lightgrey",lty=1)
     ls1 <<- list(...)
     y <<- y
     iFrame <- iEduDat[ls1$subscripts,]
     iSex <- with(iFrame,unique(sex))
     if (iSex=="Female"){
         panel.pyramid(x,y,...)
         iCc <- with(iFrame,unique(cc))
         iYr <- with(iFrame,unique(yr))
         totpop <- round(sum(abs(subset(iEduDat,cc==iCc &
                                        yr==iYr,
                                        select=value)))/
                         1000,2)
         LAB <- paste("Pop = ",totpop," Mio",sep="")
         xr <- max(abs(subset(iEduDat,cc==iCc,
                              select=value)))
         xr <- xr - xr * 0.005

         # Make the text label
         tg <- textGrob(LAB, x=unit(xr, "native") - unit(1, "mm"),
                        just="right",
                        y=unit(max(y) - 2, "native"),
                        gp=gpar(cex=0.7))
         # Draw box big enough to fit the text
         grid.rect(x=unit(xr, "native"), just="right",
                   y=unit(max(y) - 2, "native"),
                   width=grobWidth(tg) + unit(2, "mm"),
                   height=unit(1, "lines"),
                   gp=gpar(fill="white"))
         # Draw the text
         grid.draw(tg)
     } else {panel.pyramid(x,y,...)}
}

Paul

Adding textbox to multiple panels in lattice

Thread (2 messages)