วิธีคำนวณ“ เส้นทางสู่ทำเนียบขาว” โดยใช้ R


12

ฉันเพิ่งเจอการวิเคราะห์ที่ยอดเยี่ยมนี้ซึ่งทั้งน่าสนใจและสวยงามด้วยสายตา:

http://www.nytimes.com/interactive/2012/11/02/us/politics/paths-to-the-white-house.html

ฉันอยากรู้ว่า "เส้นทางต้นไม้" นั้นสามารถสร้างได้อย่างไรโดยใช้ R ข้อมูลและอัลกอริทึมใดที่เราจำเป็นต้องสร้างเช่นเส้นทางต้นไม้

ขอบคุณ


Roughly: ตรวจสอบชุดค่าผสมของผู้ชนะในแต่ละรัฐและวางผลลัพธ์ในตารางเลขฐานสอง 9-dim hypertable เรียงลำดับใหม่บนต้นไม้ตามข้อมูลที่ได้รับจากนั้นตัดกิ่งที่ซ้ำซ้อน 29

easy Eh @mbq ?! ;-)
Reinstate Monica - G. Simpson

1
ฉันคิดว่าพวกเขาทำมันแตกต่างกันเล็กน้อย: จัดอันดับรัฐตาม EV จากนั้นดูว่าเกิดอะไรขึ้นถ้าผู้สมัครแต่ละคนชนะลงต้นไม้ ดังนั้นคุณไม่จำเป็นต้องสร้างแล้วตัด 29
Peter Flom - Reinstate Monica

คำตอบ:


10

มันเป็นเรื่องธรรมดาที่จะใช้โซลูชันแบบเรียกซ้ำ

ข้อมูลจะต้องประกอบด้วยรายชื่อของรัฐในการเล่นการลงคะแนนเลือกของพวกเขาและข้อได้เปรียบเริ่มต้นสันนิษฐานไปทางซ้าย ("สีฟ้า") ผู้สมัคร (มูลค่าใกล้เคียงกับการทำซ้ำกราฟิก NY Times) ในแต่ละขั้นตอนจะมีการตรวจสอบความเป็นไปได้สองอย่าง (ซ้ายชนะหรือแพ้) มีการอัพเดทข้อได้เปรียบ; หาก ณ จุดนั้นผลลัพธ์ (ชนะแพ้หรือเสมอกัน) สามารถพิจารณาได้ - ขึ้นอยู่กับคะแนนเสียงที่เหลือ - การคำนวณจะหยุดลง มิฉะนั้นจะเกิดซ้ำซ้ำสำหรับสถานะที่เหลืออยู่ในรายการ ดังนั้น: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)

สิ่งนี้จะตัดต้นไม้ที่แต่ละโหนดอย่างมีประสิทธิภาพซึ่งต้องการการคำนวณน้อยกว่าการสำรวจผลลัพธ์ที่เป็นไปได้ทั้งหมดส่วนที่เหลือเป็นเพียงรายละเอียดกราฟิกดังนั้นฉันจะหารือเฉพาะส่วนต่าง ๆ ของอัลกอริทึมที่จำเป็นสำหรับการสร้างภาพข้อมูลที่มีประสิทธิภาพ29=512

ภาพ

โปรแกรมเต็มรูปแบบดังต่อไปนี้ มันถูกเขียนในลักษณะที่มีความยืดหยุ่นในระดับปานกลางเพื่อให้ผู้ใช้สามารถปรับพารามิเตอร์จำนวนมาก ส่วนที่สำคัญของอัลกอริทึมการทำกราฟคือเลย์เอาต์ทรี เมื่อต้องการทำสิ่งนี้ให้plot.pathใช้widthเขตข้อมูลเพื่อจัดสรรพื้นที่แนวนอนที่เหลือตามสัดส่วนให้กับลูกหลานสองคนของแต่ละโหนด ฟิลด์นี้ถูกคำนวณเริ่มแรกด้วยpaths.computeจำนวนรวมของใบไม้ (ลูกหลาน) ใต้แต่ละโหนด (หากการคำนวณบางอย่างไม่ได้ทำและต้นไม้ไบนารีถูกแบ่งครึ่งในแต่ละโหนดโดยสถานะที่เก้ามีเพียงของความกว้างทั้งหมดที่มีสำหรับแต่ละใบไม้ซึ่งแคบเกินไป ได้เริ่มวาดต้นไม้ไบนารีบนกระดาษเร็ว ๆ นี้ประสบปัญหานี้!)1/512

ตำแหน่งแนวตั้งของโหนดจะถูกจัดเรียงในชุดเรขาคณิต (โดยมีอัตราส่วนทั่วไปa) เพื่อให้ระยะห่างเข้าใกล้ส่วนที่ลึกกว่าของต้นไม้ ความหนาของกิ่งและขนาดของสัญลักษณ์ใบไม้จะถูกปรับขนาดตามความลึกเช่นกัน (สิ่งนี้จะทำให้เกิดปัญหากับสัญลักษณ์วงกลมที่ใบไม้เนื่องจากอัตราส่วนภาพของมันจะเปลี่ยนaไปตามความหลากหลายฉันไม่ได้ใส่ใจที่จะแก้ไขปัญหานี้)

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)

2
นั่นเป็นทางออกที่ดีงาม และกราฟิกที่น่าประทับใจ นอกจากนี้ยังมีpartitionsแพ็คเกจที่อาจมีโครงสร้างสำหรับการแจกแจงความเป็นไปได้
DWIN

ว้าว Whuber มีวีไม่เพียงพอที่จะทำเครื่องหมายคำตอบของคุณด้วย!
Tal Galili
โดยการใช้ไซต์ของเรา หมายความว่าคุณได้อ่านและทำความเข้าใจนโยบายคุกกี้และนโยบายความเป็นส่วนตัวของเราแล้ว
Licensed under cc by-sa 3.0 with attribution required.