#=================================================================================================
#
# labelPoints: label points in a scatterplot while trying to avoid labels overlapping with one another
# and with points.
#
#=================================================================================================
labelPoints = function(x, y, labels, cex = 0.7, offs = 0.01, xpd = TRUE, jiggle = 0,
protectEdges = TRUE,
doPlot = TRUE, ...)
{
nPts = length(labels);
box = par("usr");
dims = par("pin");
scaleX = dims[1]/(box[2] - box[1]);
scaleY = dims[2]/(box[4] - box[3]);
#ish = charmatch(shape, .shapes);
#if (is.na(ish))
# stop(paste("Unrecognized 'shape'. Recognized values are", paste(.shapes, collapse = ", ")));
if (par("xlog"))
{
xx = log10(x);
} else
xx = x;
if (par("ylog"))
{
yy = log10(y);
} else
yy = y;
xx = xx * scaleX;
yy = yy * scaleY;
if (jiggle > 0)
{
rangeX = max(xx, na.rm = TRUE) - min(xx, na.rm = TRUE)
jx = xx + jiggle * rangeX * (runif(nPts) - 0.5);
rangeY = max(yy, na.rm = TRUE) - min(yy, na.rm = TRUE)
jy = yy + jiggle * rangeY * (runif(nPts) - 0.5);
} else {
jx = xx;
jy = yy;
}
dx = offs;
dy = offs;
labWidth = strwidth(labels, cex=cex) * scaleX;
labHeight = strheight(labels, cex=cex) * scaleY;
if (nPts==0) return(0);
if (nPts==1)
{
if (protectEdges)
{
shift = ifelse(x - labWidth/2/scaleX < box[1], box[1] - x + labWidth/2/scaleX,
ifelse(x + labWidth/2/scaleX > box[2], box[2] - x - labWidth/2/scaleX, 0));
x = x + shift;
# Also check the top and bottom edges
yShift = if (y + labHeight/scaleY + offs/scaleY > box[4]) -(labHeight + 2*offs)/scaleY else 0;
y = y + yShift
}
text(x, y + labHeight/2/scaleY + offs/scaleY, labels, cex = cex, xpd = xpd, adj = c(0.5, 0.5), ...)
return (0);
}
xMat = cbind(xx,yy);
jxMat = cbind(jx, jy);
distX = as.matrix(dist(jx));
distY = as.matrix(dist(jy));
dir = matrix(0, nPts, 2);
d0SqX = (labWidth+2*offs)^2
d0SqY = (labHeight + 2*offs)^2;
for (p in 1:nPts)
{
difs = matrix(jxMat[p, ], nPts, 2, byrow = TRUE) - jxMat;
difSc = difs / sqrt(matrix(apply(difs^2, 1, sum, na.rm = TRUE), nPts, 2));
difSx = rbind(difSc, c(0,1));
difSx[p, ] = 0;
w = c(exp(-distX[,p]^4 / d0SqX[p]^2 - distY[,p]^4/d0SqY^2));
w[distX[, p]==0 & distY[,p]==0] = 0;
w = c(w, 0.01);
dir[p, ] = apply(difSx * matrix(w, (nPts+1), 2), 2, sum, na.rm = TRUE) / sum(w, na.rm = TRUE)
if (sum(abs(dir[p, ]))==0) dir[p, ] = runif(2);
}
scDir = dir / sqrt(matrix(apply(dir^2, 1, sum, na.rm = TRUE), nPts, 2));
offsMat = cbind(labWidth/2 + offs, labHeight/2 + offs)
Rmat = abs(scDir / offsMat);
ind = Rmat[, 1] > Rmat[, 2]; # This is an indicator of whether the labels touch the vertical (TRUE ) or
# horizontal (FALSE) edge of the square around the point
# These are preliminary text coordinates relative to their points.
dx = offsMat[, 1] * sign(scDir[, 1])
dx[!ind] = scDir[!ind, 1] * offsMat[!ind, 2]/abs(scDir[!ind,2]);
dy = offsMat[, 2] * sign(scDir[, 2]);
dy[ind] = scDir[ind, 2] * offsMat[ind, 1]/abs(scDir[ind,1]);
# Absolute coordinates
xt = (xx + dx)/scaleX;
yt = (yy + dy)/scaleY;
# Check if any of the points overlap with a label (of a different point)
pointMaxx = matrix(xx + offs, nPts, nPts);
pointMinx = matrix(xx - offs, nPts, nPts);
pointMiny = matrix(yy - offs, nPts, nPts);
pointMaxy = matrix(yy + offs, nPts, nPts);
labelMinx = matrix(xt - labWidth/2, nPts, nPts, byrow = TRUE);
labelMaxx = matrix(xt + labWidth/2, nPts, nPts, byrow = TRUE);
labelMiny = matrix(yt - labHeight/2, nPts, nPts, byrow = TRUE);
labelMaxy = matrix(yt + labHeight/2, nPts, nPts, byrow = TRUE);
overlapF = function(x1min, x1max, x2min, x2max)
{
overlap = matrix(0, nPts, nPts);
overlap[ x1max > x2min & x1max < x2max & x1min < x2min ] = 1;
overlap[ x1max > x2min & x1max < x2max & x1min > x2min ] = 2;
overlap[ x1max > x2max & x1min > x2min ] = 3;
overlap;
}
overlapX = overlapF(pointMinx, pointMaxx, labelMinx, labelMaxx);
overlapY = overlapF(pointMiny, pointMaxy, labelMiny, labelMaxy);
indOvr = overlapX > 0 & overlapY >0;
overlap = matrix(0, nPts, nPts);
overlap[indOvr] = (overlapY[indOvr] - 1) * 3 + overlapX[indOvr];
# For now try to fix cases of a single overlap.
nOvrPerLabel = apply(overlap>0, 1, sum);
#for (p in 1:nPts) if (nOverPerLabel[p]==1)
#{
# Check if any of the labels extend past the left or right edge of the plot
if (protectEdges)
{
shift = ifelse(xt - labWidth/2/scaleX < box[1], box[1] - xt + labWidth/2/scaleX,
ifelse(xt + labWidth/2/scaleX > box[2], box[2] - xt - labWidth/2/scaleX, 0));
xt = xt + shift;
# Also check the top and bottom edges
# Do labels overlap with points along the x coordinate?
xOverlap = abs(xt-x) < (labWidth/2 + offs)/scaleX;
yShift = ifelse(yt - labHeight/2/scaleY < box[3],
ifelse(xOverlap, (labHeight + 2*offs)/scaleY, box[3] - yt + labHeight/2/scaleY),
ifelse(yt + labHeight/2/scaleY > box[4], -(labHeight + 2*offs)/scaleY, 0));
yt = yt + yShift
}
if (par("xlog")) xt = 10^xt;
if (par("ylog")) yt = 10^yt;
if (doPlot)
text(xt, yt, labels, cex = cex, xpd = xpd, adj = c(0.5, 0.5), ...)
invisible(data.frame(x = xt, y= yt, label = labels));
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.