Label the tops, bump labels up to avoid other labels, then to the side to avoid collisions with points.
top.bumptwice <- function(d,debug=FALSE,...){
labtab <- apply.method("top.bumpup",d)
if(debug)draw.rects(labtab)
gapply(labtab,function(l,...){
between <- d[d$y>l$bottom & d$y<l$top,]
x <- sort(c(range(d$x),between$x))
if(length(x)==2)return(l)
dif <- diff(x)
ok <- dif>with(l,right-left)
if(!any(ok))ok[1] <- TRUE
i <- which(ok)
intervals <- data.frame(left=x[i]+l$w/2,right=x[i+1]-l$w/2,i=seq_along(i))
molt <- with(intervals,data.frame(i,x=c(left,right)))
dists <- transform(molt,dist=x-l$x)
best <- dists[which.min(abs(dists$dist)),]
besti <- intervals[best$i,]
l$x <- if(l$x<besti$right & l$x>besti$left)l$x else best$x
l
})
}
![]() |
data(Chem97,package="mlmRev")
library(lattice)
p <- densityplot(~gcsescore|gender,Chem97,
groups=factor(score),layout=c(1,2),
n=500,plot.points=FALSE)
direct.label(p,"top.bumptwice")
|
![]() |
library(reshape2) iris2 <- melt(iris,id="Species") library(lattice) p <- densityplot(~value|variable,iris2,groups=Species,scales="free") direct.label(p,"top.bumptwice") |
![]() |
loci <- data.frame(ppp=c(rbeta(800,10,10),rbeta(100,0.15,1),rbeta(100,1,0.15)),
type=factor(c(rep("NEU",800),rep("POS",100),rep("BAL",100))))
library(ggplot2)
p <- qplot(ppp,data=loci,colour=type,geom="density")
direct.label(p,"top.bumptwice")
|
| Please contact Toby Dylan Hocking if you are using directlabels or have ideas to contribute, thanks! |
| Documentation website generated from source code version 2021.2.24 (git revision bb6db07 Mon, 14 Jun 2021 22:38:45 +0530) using inlinedocs. |
| validate |