Es natural usar una solución recursiva.
Los datos deben consistir en una lista de los estados en juego, sus votos electorales y la presunta ventaja inicial para el candidato de la izquierda ("azul"). (Un valor de se acerca a la reproducción del gráfico del NY Times). En cada paso, se examinan las dos posibilidades (la izquierda gana o pierde); la ventaja se actualiza; si en ese momento se puede determinar el resultado (victoria, derrota o empate), en base a los votos restantes, entonces el cálculo se detiene; de lo contrario, se repite recursivamente para los estados restantes en la lista. Así:47
paths.compute <- function(start, options, states) {
if (start > sum(options)) x <- list(Id="O", width=1)
else if (start < -sum(options)) x <- list(Id="R", width=1)
else if (length(options) == 0 && start == 0) x <- list(Id="*", width=1)
else {
l <- paths.compute(start+options[1], options[-1], states[-1])
r <- paths.compute(start-options[1], options[-1], states[-1])
x <- list(Id=states[1], L=l, R=r, width=l$width+r$width, node=TRUE)
}
class(x) <- "path"
return(x)
}
states <- c("FL", "OH", "NC", "VA", "WI", "CO", "IA", "NV", "NH")
votes <- c(29, 18, 15, 13, 10, 9, 5, 6, 4)
p <- paths.compute(47, votes, states)
Esto poda efectivamente el árbol en cada nodo, lo que requiere mucho menos cómputo que explorar todos los resultados posibles. El resto es solo un detalle gráfico, por lo que analizaré solo aquellas partes del algoritmo que son esenciales para una visualización efectiva.29=512
El programa completo sigue. Está escrito de manera moderadamente flexible para permitir al usuario ajustar muchos de los parámetros. La parte crucial del algoritmo gráfico es el diseño del árbol. Para hacer esto, plot.pathutiliza un widthcampo para asignar proporcionalmente el espacio horizontal restante a los dos descendientes de cada nodo. Este campo se calcula inicialmente paths.computecomo el número total de hojas (descendientes) debajo de cada nodo. (Si no se realiza algún cálculo de este tipo, y el árbol binario simplemente se divide por la mitad en cada nodo, entonces, en el noveno estado, solo hay del ancho total disponible para cada hoja, que es demasiado angosto. Cualquiera que ha comenzado a dibujar un árbol binario en papel, ¡pronto experimentó este problema!)1/512
Las posiciones verticales de los nodos están dispuestas en una serie geométrica (con una relación común a) para que el espacio se acerque en las partes más profundas del árbol. Los grosores de las ramas y los tamaños de los símbolos de las hojas también se escalan por profundidad. (Esto causará problemas con los símbolos circulares en las hojas, porque sus relaciones de aspecto cambiarán según las avariaciones. No me he molestado en arreglar eso).
paths.compute <- function(start, options, states) {
if (start > sum(options)) x <- list(Id="O", width=1)
else if (start < -sum(options)) x <- list(Id="R", width=1)
else if (length(options) == 0 && start == 0) x <- list(Id="*", width=1)
else {
l <- paths.compute(start+options[1], options[-1], states[-1])
r <- paths.compute(start-options[1], options[-1], states[-1])
x <- list(Id=states[1], L=l, R=r, width=l$width+r$width, node=TRUE)
}
class(x) <- "path"
return(x)
}
plot.path <- function(p, depth=0, x0=1/2, y0=1, u=0, v=1, a=.9, delta=0,
x.offset=0.01, thickness=12, size.leaf=4, decay=0.15, ...) {
#
# Graphical symbols
#
cyan <- rgb(.25, .5, .8, .5); cyan.full <- rgb(.625, .75, .9, 1)
magenta <- rgb(1, .7, .775, .5); magenta.full <- rgb(1, .7, .775, 1)
gray <- rgb(.95, .9, .4, 1)
#
# Graphical elements: circles and connectors.
#
circle <- function(center, radius, n.points=60) {
z <- (1:n.points) * 2 * pi / n.points
t(rbind(cos(z), sin(z)) * radius + center)
}
connect <- function(x1, x2, veer=0.45, n=15, ...){
x <- seq(x1[1], x1[2], length.out=5)
y <- seq(x2[1], x2[2], length.out=5)
y[2] = veer * y[3] + (1-veer) * y[2]
y[4] = veer * y[3] + (1-veer) * y[4]
s = spline(x, y, n)
lines(s$x, s$y, ...)
}
#
# Plot recursively:
#
scale <- exp(-decay * depth)
if (is.null(p$node)) {
if (p$Id=="O") {dx <- -y0; color <- cyan.full}
else if (p$Id=="R") {dx <- y0; color <- magenta.full}
else {dx = 0; color <- gray}
polygon(circle(c(x0 + dx*x.offset, y0), size.leaf*scale/100), col=color, border=NA)
text(x0 + dx*x.offset, y0, p$Id, cex=size.leaf*scale)
} else {
mid <- ((delta+p$L$width) * v + (delta+p$R$width) * u) / (p$L$width + p$R$width + 2*delta)
connect(c(x0, (x0+u)/2), c(y0, y0 * a), lwd=thickness*scale, col=cyan, ...)
connect(c(x0, (x0+v)/2), c(y0, y0 * a), lwd=thickness*scale, col=magenta, ...)
plot(p$L, depth=depth+1, x0=(x0+u)/2, y0=y0*a, u, mid, a, delta, x.offset, thickness, size.leaf, decay, ...)
plot(p$R, depth=depth+1, x0=(x0+v)/2, y0=y0*a, mid, v, a, delta, x.offset, thickness, size.leaf, decay, ...)
}
}
plot.grid <- function(p, y0=1, a=.9, col.text="Gray", col.line="White", ...) {
#
# Plot horizontal lines and identifiers.
#
if (!is.null(p$node)) {
abline(h=y0, col=col.line, ...)
text(0.025, y0*1.0125, p$Id, cex=y0, col=col.text, ...)
plot.grid(p$L, y0=y0*a, a, col.text, col.line, ...)
plot.grid(p$R, y0=y0*a, a, col.text, col.line, ...)
}
}
states <- c("FL", "OH", "NC", "VA", "WI", "CO", "IA", "NV", "NH")
votes <- c(29, 18, 15, 13, 10, 9, 5, 6, 4)
p <- paths.compute(47, votes, states)
a <- 0.925
eps <- 1/26
y0 <- a^10; y1 <- 1.05
mai <- par("mai")
par(bg="White", mai=c(eps, eps, eps, eps))
plot(c(0,1), c(a^10, 1.05), type="n", xaxt="n", yaxt="n", xlab="", ylab="")
rect(-eps, y0 - eps * (y1 - y0), 1+eps, y1 + eps * (y1-y0), col="#f0f0f0", border=NA)
plot.grid(p, y0=1, a=a, col="White", col.text="#888888")
plot(p, a=a, delta=40, thickness=12, size.leaf=4, decay=0.2)
par(mai=mai)