Nothing
space.pies <-
function(x,
y,
pie.slices,
pie.colors = NULL,
pie.radius = 1,
pie.space = 5,
link = TRUE,
seg.lwd = 1,
seg.col = 1,
seg.lty = 1,
coord = NULL) {
if (is.null(coord)) {
## mm.pointLabels is the marmap version of pointLabels function from package maptools
mm.pointLabels = function (x,
y = NULL,
labels = seq(along = x),
cex = 1,
method = c("SANN",
"GA"),
allowSmallOverlap = FALSE,
trace = FALSE,
doPlot = TRUE,
...)
{
if (!missing(y) && (is.character(y) || is.expression(y))) {
labels <- y
y <- NULL
}
labels <- as.graphicsAnnot(labels)
boundary <- par()$usr
xyAspect <- par()$pin[1] / par()$pin[2]
toUnityCoords <- function(xy) {
list(
x = (xy$x - boundary[1]) / (boundary[2] - boundary[1]) *
xyAspect,
y = (xy$y - boundary[3]) / (boundary[4] -
boundary[3]) / xyAspect
)
}
toUserCoords <- function(xy) {
list(
x = boundary[1] + xy$x / xyAspect * (boundary[2] -
boundary[1]),
y = boundary[3] + xy$y * xyAspect *
(boundary[4] - boundary[3])
)
}
z <- xy.coords(x, y, recycle = TRUE)
z <- toUnityCoords(z)
x <- z$x
y <- z$y
if (length(labels) < length(x))
labels <- rep(labels, length(x))
method <- match.arg(method)
if (allowSmallOverlap)
nudgeFactor <- 0.02 ###original 0.02###########
n_labels <- length(x)
width <- (strwidth(labels, units = "figure", cex = cex) +
0.015) * xyAspect
height <- (strheight(labels, units = "figure", cex = cex) +
0.015) / xyAspect
gen_offset <-
function(code)
c(-1,-1,-1, 0, 0, 1, 1, 1)[code] *
(width / 2) + (0 + 1i) * c(-1, 0, 1,-1, 1,-1, 0, 1)[code] *
(height / 2)
rect_intersect <- function(xy1, offset1, xy2, offset2) {
w <- pmin(Re(xy1 + offset1 / 2), Re(xy2 + offset2 / 2)) -
pmax(Re(xy1 - offset1 / 2), Re(xy2 - offset2 / 2))
h <- pmin(Im(xy1 + offset1 / 2), Im(xy2 + offset2 / 2)) -
pmax(Im(xy1 - offset1 / 2), Im(xy2 - offset2 / 2))
w[w <= 0] <- 0
h[h <= 0] <- 0
w * h
}
nudge <- function(offset) {
doesIntersect <- rect_intersect(xy[rectidx1] + offset[rectidx1],
rectv[rectidx1], xy[rectidx2] + offset[rectidx2],
rectv[rectidx2]) > 0
pyth <-
abs(xy[rectidx1] + offset[rectidx1] - xy[rectidx2] -
offset[rectidx2]) / nudgeFactor
eps <- 1e-10
for (i in which(doesIntersect & pyth > eps)) {
idx1 <- rectidx1[i]
idx2 <- rectidx2[i]
vect <-
(xy[idx1] + offset[idx1] - xy[idx2] - offset[idx2]) / pyth[idx1]
offset[idx1] <- offset[idx1] + vect
offset[idx2] <- offset[idx2] - vect
}
offset
}
objective <- function(gene) {
offset <- gen_offset(gene)
if (allowSmallOverlap)
offset <- nudge(offset)
if (!is.null(rectidx1))
area <-
sum(rect_intersect(xy[rectidx1] + offset[rectidx1],
rectv[rectidx1], xy[rectidx2] + offset[rectidx2],
rectv[rectidx2]))
else
area <- 0
n_outside <- sum(
Re(xy + offset - rectv / 2) < 0 | Re(xy +
offset + rectv / 2) > xyAspect |
Im(xy + offset - rectv / 2) <
0 | Im(xy + offset + rectv / 2) > 1 / xyAspect
)
res <- 1000 * area + n_outside
res
}
xy <- x + (0 + 1i) * y
rectv <- width + (0 + 1i) * height
rectidx1 <- rectidx2 <- array(0, (length(x) ^ 2 - length(x)) / 2)
k <- 0
for (i in 1:length(x))
for (j in seq(len = (i - 1))) {
k <- k + 1
rectidx1[k] <- i
rectidx2[k] <- j
}
canIntersect <-
rect_intersect(xy[rectidx1], 2 * rectv[rectidx1],
xy[rectidx2], 2 * rectv[rectidx2]) > 0
rectidx1 <- rectidx1[canIntersect]
rectidx2 <- rectidx2[canIntersect]
if (trace)
message("possible intersects =", length(rectidx1))
if (trace)
message("portion covered =", sum(rect_intersect(xy, rectv,
xy, rectv)))
GA <- function() {
n_startgenes <- 1000
n_bestgenes <- 30
prob <- 0.2
mutate <- function(gene) {
offset <- gen_offset(gene)
doesIntersect <-
rect_intersect(xy[rectidx1] + offset[rectidx1],
rectv[rectidx1], xy[rectidx2] + offset[rectidx2],
rectv[rectidx2]) > 0
for (i in which(doesIntersect)) {
gene[rectidx1[i]] <- sample(1:8, 1)
}
for (i in seq(along = gene))
if (runif(1) <= prob)
gene[i] <- sample(1:8, 1)
gene
}
crossbreed <- function(g1, g2)
ifelse(sample(c(0, 1),
length(g1), replace = TRUE) > 0.5, g1, g2)
genes <- matrix(sample(1:8, n_labels * n_startgenes,
replace = TRUE),
n_startgenes,
n_labels)
for (i in 1:10) {
scores <- array(0, NROW(genes))
for (j in 1:NROW(genes))
scores[j] <- objective(genes[j,])
rankings <- order(scores)
genes <- genes[rankings,]
bestgenes <- genes[1:n_bestgenes,]
bestscore <- scores[rankings][1]
if (bestscore == 0) {
if (trace)
message("overlap area =", bestscore)
break
}
genes <- matrix(0, n_bestgenes ^ 2, n_labels)
for (j in 1:n_bestgenes)
for (k in 1:n_bestgenes)
genes[n_bestgenes *
(j - 1) + k,] <- mutate(crossbreed(bestgenes[j,], bestgenes[k,]))
genes <- rbind(bestgenes, genes)
if (trace)
message("overlap area =", bestscore)
}
nx <- Re(xy + gen_offset(bestgenes[1,]))
ny <- Im(xy + gen_offset(bestgenes[1,]))
list(x = nx, y = ny)
}
SANN <- function() {
gene <- rep(8, n_labels)
score <- objective(gene)
bestgene <- gene
bestscore <- score
T <- 2.5
for (i in 1:50) {
k <- 1
for (j in 1:50) {
newgene <- gene
newgene[sample(1:n_labels, 1)] <- sample(1:8,
1)
newscore <- objective(newgene)
if (newscore <= score || runif(1) < exp((score -
newscore) / T)) {
k <- k + 1
score <- newscore
gene <- newgene
}
if (score <= bestscore) {
bestscore <- score
bestgene <- gene
}
if (bestscore == 0 || k == 10)
break
}
if (bestscore == 0)
break
if (trace)
message("overlap area =", bestscore)
T <- 0.9 * T
}
if (trace)
message("overlap area =", bestscore)
nx <- Re(xy + gen_offset(bestgene))
ny <- Im(xy + gen_offset(bestgene))
list(x = nx, y = ny)
}
if (method == "SANN")
xy <- SANN()
else
xy <- GA()
xy <- toUserCoords(xy)
if (doPlot)
return(xy)
# invisible(xy)
}
#########################################################################################
mm.pointLabels(x, y, cex = pie.radius * pie.space) -> xy
if (link == TRUE) {
segments(x,
y,
xy$x,
xy$y,
lwd = seg.lwd,
col = seg.col,
lty = seg.lty)
}
for (i in 1:length(xy$x)) {
plotrix::floating.pie(
xy$x[i],
xy$y[i],
x = as.numeric(pie.slices[i, ][pie.slices[i, ] != 0]),
col = as.vector(pie.colors[i, ][pie.slices[i, ] != 0]),
radius = pie.radius,
shadow = FALSE
)
}
} # end of if statement
if (!is.null(coord)) {
if (link == TRUE) {
segments(x,
y,
coord[, 1],
coord[, 2],
lwd = seg.lwd,
col = seg.col,
lty = seg.lty)
}
for (i in 1:nrow(coord)) {
plotrix::floating.pie(
coord[i,1],
coord[i,2],
x = as.numeric(pie.slices[i, ][pie.slices[i, ] != 0]),
col = as.vector(pie.colors[i, ][pie.slices[i, ] != 0]),
radius = pie.radius,
shadow = FALSE
)
}
} # end of if statement
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.