Skip to content

lattice xyplot point labelling

3 messages · Duncan Mackay, Massimo Bressan

Massimo Bressan
# 
This is my reproducible example

tv.ms<-structure(list(inq = structure(4:17, .Label = c("D4", "D5", "D6a", 
"D6b", "D6c", "D7", "D8", "F4", "F5a", "F5b", "F6a", "F6b", "F6c", 
"F6d", "F7a", "F7b", "F8"), class = "factor"), tv.km.median.iteq =
c(0.320000000000004, 
0.239999999999998, 0.240000000000002, 0.0800000000000001, 0.989999999999995, 
0.309999999999999, 4.47000000000003, 0.620000000000005, 0.620000000000005, 
0.18, 0.790000000000006, 0.32, 0.0200000000000005, 0.01), ms.km.median.iteq
= c(0.420000000000002, 
0.380000000000001, 0.33, 0.0900000000000001, 1.06999999999994, 
0.559999999999974, 5.20000000000027, 1.5, 1.19, 0.469999999999999, 
0.310000000000002, 0.459999999999999, 0.0400000000000003, 0.04
), type = c("PCDD", "PCDD", "PCDD", "PCDD", "PCDF", "PCDF", "PCDF", 
"PCDF", "PCDF", "PCDF", "PCDF", "PCDF", "PCDF", "PCDF")), .Names = c("inq", 
"tv.km.median.iteq", "ms.km.median.iteq", "type"), row.names = 4:17, class =
"data.frame")


I worked out the chart mainly with the hints of this great forum (thanks
again for that): what I?ve done so far accomplishes my needs except for that
now I need a little final tweaking in order to avoid the overlapping of some
specific labels (i.e. by looking at the plot the labels: F6b and F6a, F7a
and F5a)


xyplot(tv.km.median.iteq~ms.km.median.iteq|type, data=tv.ms,
        layout=c(1,2),
        aspect="xy", 
        xlab = expression(paste('ms [ fg/', m^3, ' ]', sep = '')), 
        ylab = expression(paste('tv [ fg/', m^3, ' ]', sep = '')), 
        scales= list(relation="free", log=10, cex=0.8), 
        
       prepanel = function(x, y, subscripts) { 
          rr<- range(cbind(x,y)) 
          list(xlim = rr, ylim= rr) 
        }, 
        panel = function(x, y , subscripts,...) { 
          panel.xyplot(x, y, cex=0.8,...) 
          panel.abline(a = 0, b = 1, lty = 2, col ="gray") 
          panel.text(x, y, labels=tv.ms$inq[subscripts], 
                     cex = 0.7, pos=3, offset=1, srt=0, adj=c(1,1))
          #alternative to the use of panel.text
          #ltext(x=x, y=y, labels=tv.ms$inq[subscripts], pos=1, cex=0.8)
        }, 
        #subscripts=TRUE, 
        xscale.components = function(...)  { 
          ans <- xscale.components.logpower(...) 
          range <- ans$num.limit 
          newtck <- round(seq(range[1],range[2],l=7),1) 
          ans$bottom$ticks$at <- newtck 
          ans$bottom$labels$at <- newtck 
          ans$bottom$labels$labels <-parse(text=paste('10^',newtck,sep='')) 
          ans 
        } , 
        yscale.components  = function(...)  { 
          ans <- yscale.components.logpower(...) 
          range <- ans$num.limit 
          newtck <- round(seq(range[1],range[2],l=7),1) 
          ans$left$ticks$at <- newtck 
          ans$left$labels$at <- newtck 
          ans$left$labels$labels <-parse(text=paste('10^',newtck,sep='')) 
          ans 
        }
)

I?m thinking to sort out the problem by:
1 -	plotting all labels except for those overlapping (i.e the above
mentioned points);
2 -	plotting the remaining labels (i.e. the overlapping ones) by introducing
a ?manual displacement?;

I know that?s probably not much efficient nor elegant resorting to a ?manual
solution? involving at least two ?plotting steps? (the first to see where to
tweak and the second to fix) but I can?t think to any other solution

Any help?

Thank you

max




--
View this message in context: http://r.789695.n4.nabble.com/lattice-xyplot-point-labelling-tp4659798.html
Sent from the R help mailing list archive at Nabble.com.
Duncan Mackay
# 
hi

the bottom panel seems ok so for the top you 
supply a vector of positions that are your 
required positions (name eg posvec) to the panel 
function. may need to do the same for other functions
to access the correct panel there is the ifelse statement

posvec = c(...)

   panel = function(x, y , subscripts,...) {
           pnl = panel.number()
           panel.xyplot(x, y, cex=0.8,...)
           panel.abline(a = 0, b = 1, lty = 2, col ="gray")
           if (pnl == 2){
           panel.text(x, y, labels=tv.ms$inq[subscripts],
                      cex = 0.7, pos=3, offset=1, srt=0, adj=c(1,1))
           } else {
           panel.text(x, y, labels=tv.ms$inq[subscripts],
                      cex = 0.7, pos=posvec, offset=1, srt=0, adj=c(1,1))
           }
           #alternative to the use of panel.text
           #ltext(x=x, y=y, labels=tv.ms$inq[subscripts], pos=1, cex=0.8)
         },

HTh

Duncan

Duncan Mackay
Department of Agronomy and Soil Science
University of New England
Armidale NSW 2351
Email: home: mackay at northnet.com.au
At 22:30 27/02/2013, you wrote: