## Recreate infographic

## The data (see ./data.R)
wars <- read.csv("wars.csv")
logdur <- log2(wars$duration)
maxdur <- ceiling(max(logdur))
yrange <- c(-.001, maxdur)

## Libraries and shapes
source("setup.R")

bgcol <- "#FFF9E1"
## We will drop the "white" at the end
pal <- hcl.colors(7, "rocket")
pal[1] <- "red"
## colorspace::swatchplot(pal)
names(pal) <- c("Global",
                "Asia", "Europe", "Africa",
                "North America", "South America")

plotwar <- function() {
    grid.rect(gp=gpar(col=NA, fill=bgcol))
    pushViewport(viewport(width=unit(1, "npc") - unit(3, "cm"),
                          height=unit(1, "npc") - unit(2, "cm")))
    ## Overall layout
    if (!exists("flowedhtml"))
        flowedhtml <- flow(html, css=css)
    grid.html(flowedhtml, viewports=TRUE)
    upViewport(0)
    ## Top part of page
    mainvp <- grid.grep("main", grep=TRUE, grobs=FALSE, viewports=TRUE)
    downViewport(mainvp)
    pushViewport(viewport(y=1, height=unit(1, "npc") - unit(2, "lines"),
                          just="top"))
    grid.segments(-.5, 0, 1.5, 0, gp=gpar(lwd=3))
    ## Plot region
    pushViewport(viewport(y=unit(3, "lines"),
                          height=unit(1, "npc") - unit(3, "lines"),
                          just="bottom",
                          width=unit(1, "npc"),
                          xscale=c(1900, 2010),
                          yscale=yrange))
    grid.segments(-.5, 0, 1, 0, gp=gpar(lty="dotted", lwd=.7))
    ## y-axis
    yticks <- 0:maxdur
    grid.text(2^yticks, unit(1, "npc") + unit(7, "mm"),
              unit(yticks, "native"), just="right",
              gp=gpar(cex=.5))
    grid.segments(unit(1, "npc") + unit(9, "mm"),
                  unit(yticks, "native"),
                  1.5,
                  unit(yticks, "native"),
                  gp=gpar(lty="dotted", lwd=.7))
    ## x-axis
    grid.segments(-.5, unit(-1.5, "lines"), 1.5, unit(-1.5, "lines"))
    grid.segments(1899:2010, unit(-1.5, "lines"), 1899:2010,
                  unit(-1.5, "lines") + unit(1, "mm"),
                  default.units="native",
                  gp=gpar(lwd=1, lineend="butt"))
    xticks <- seq(1900, 2010, 10)
    grid.segments(xticks, unit(-1.5, "lines"), xticks,
                  unit(-1.5, "lines") + unit(2, "mm"),
                  default.units="native",
                  gp=gpar(lwd=2, lineend="butt"))
    grid.text(xticks, unit(xticks, "native"), unit(-3, "lines"),
              gp=gpar(cex=.7))
    ## lines
    col <- pal[wars$region]
    path <- knot(wars$start, 0) + dir(90) +
        dir(90) + knot(wars$end, logdur)
    grid.metapost(path, gp=gpar(col=col, lwd=.7))
    grid.force(redraw=FALSE)
    invisible(lapply(seq_along(col),
                     function(i) {
                         grid.edit(paste0("path-", i), gp=gpar(col=col[i]),
                                   redraw=FALSE)
                     }))
    grid.refresh()
    ## poppies
    global <- grepl("Global", wars$region)
    minsize <- 2
    maxsize <- 40
    sdeath <- sqrt(wars$death)
    scaledeaths <- function(x) {
        minsize + (maxsize - minsize)*(x - min(sdeath))/diff(range(sdeath))
    }
    size <- scaledeaths(sdeath)
    invisible(lapply(seq_along(col)[!global],
                     function(i) {
                         poppy(unit(wars$end[i], "native"),
                               unit(logdur[i], "native"),
                               size=unit(size[i], "mm"),
                               adjustcolor(col[i], alpha=.8))
                     }))
    invisible(lapply(seq_along(col)[global],
                     function(i) {
                         poppyShadow(unit(wars$end[i], "native"),
                                     unit(logdur[i], "native"),
                                     size=unit(size[i], "mm"),
                                     adjustcolor(col[i], alpha=.8),
                                     lwd=size[i]/10)
                     }))
    upViewport(0)
    ## size legend
    sizevp <- grid.grep("size", grep=TRUE, grobs=FALSE, viewports=TRUE)
    downViewport(sizevp)
    pushViewport(viewport(x=1, width=.9, just="right"))
    grid.segments(0, unit(1, "npc") + unit(0, "mm"),
                  1, unit(1, "npc") + unit(0, "mm"),
                  gp=gpar(col="grey"))
    grid.text("NUMBER of DEATHS IN THOUSANDS",
              0, unit(1, "npc") + unit(0, "mm") + unit(1, "mm"),
              just=c("left", "bottom"),
              gp=gpar(cex=.5, fontface="bold"))
    deaths <- c(100, 500, 1000, 2000)
    sizes <- scaledeaths(sqrt(deaths*1000))
    for (i in 1:4) {
        poppy(i/5, .5, unit(sizes[i], "mm"), "black", lwd=.5)
    }
    grid.text(deaths, 1:4/5, 0, just="bottom",
              gp=gpar(cex=.5))
    upViewport(0)
    ## region legend
    regionvp <- grid.grep("region", grep=TRUE, grobs=FALSE, viewports=TRUE)
    downViewport(regionvp)
    pushViewport(viewport(x=1, width=.9, just="right"))
    grid.segments(0, unit(1, "npc") + unit(0, "mm"),
                  1, unit(1, "npc") + unit(0, "mm"),
                  gp=gpar(col="grey"))
    grid.text("REGIONS INVOLVED IN WARS",
              0, unit(1, "npc") + unit(0, "mm") + unit(1, "mm"),
              just=c("left", "bottom"),
              gp=gpar(cex=.5, fontface="bold"))
    regions <- c(sort(names(pal)[-grep("Global", names(pal))]))
    for (i in seq_along(regions)) {
        poppy(i/7, .5, unit(7, "mm"), pal[regions[i]])
    }
    poppyShadow(6/7, .5, unit(7, "mm"), pal["Global"], lwd=2)
    grid.text(gsub("North", "N.", gsub("South", "S.", gsub("America", "Am.",
                                                           regions))),
              1:5/7, 0, just="bottom",
              gp=gpar(cex=.5))
    grid.text("Global",
              6/7, 0, just="bottom",
              gp=gpar(cex=.5))
    upViewport(0)
    ## diagram
    diagramvp <- grid.grep("diagram", grep=TRUE, grobs=FALSE, viewports=TRUE)
    downViewport(diagramvp)
    pushViewport(viewport(x=0, width=unit(1, "npc") - unit(1, "cm"), just="left"))
    grid.segments(0, unit(1, "npc") + unit(0, "mm"),
                  1, unit(1, "npc") + unit(0, "mm"),
                  gp=gpar(col="grey"))
    grid.text("POPPY DIAGRAM",
              0, unit(1, "npc") + unit(0, "mm") + unit(1, "mm"),
              just=c("left", "bottom"),
              gp=gpar(cex=.5, fontface="bold"))
    grid.segments(0, c(.2, .7), .8, c(.2, .7),
                  gp=gpar(lty="dotted"))
    grid.segments(c(.3, .5), .1, c(.3, .5), .7,
                  gp=gpar(lty="dotted"))
    grid.text(c("Start", " End"), c(.3, .5), unit(.7, "npc") + unit(1, "mm"),
              just="left", rot=90, gp=gpar(cex=.5))
    path <- knot(.3, .2) + dir(90) +
        dir(90) + knot(.5, .7)
    grid.metapost(path, gp=gpar(col=pal["Africa"]))
    poppy(.5, .7, unit(2, "mm"), pal["Africa"])
    grid.segments(.85, .2, .85, .7,
                  arrow=arrow(length=unit(1, "mm"), type="closed", ends="both"),
                  gp=gpar(fill="black"))
    grid.text("DURATION", .9, .45, just="top", rot=90, gp=gpar(cex=.4))
    upViewport(0)
}

## cairo_pdf("wars.pdf", width=12)
## png("wars.png", height=700, width=1200, res=100)
svg("wars.svg", width=12)
plotwar()
dev.off()

## focus on bits of plot
library(xml2)
svg <- read_xml("wars.svg")
xml_set_attr(xml_root(svg), "viewBox", "0 200 100 200")
xml_set_attr(xml_root(svg), "width", "100")
xml_set_attr(xml_root(svg), "height", "200")
write_xml(svg, "curves.svg")

library(xml2)
svg <- read_xml("wars.svg")
xml_set_attr(xml_root(svg), "viewBox", "600 390 250 100")
xml_set_attr(xml_root(svg), "width", "250")
xml_set_attr(xml_root(svg), "height", "100")
write_xml(svg, "poppies.svg")

library(xml2)
svg <- read_xml("wars.svg")
xml_set_attr(xml_root(svg), "viewBox", "250 100 200 200")
xml_set_attr(xml_root(svg), "width", "200")
xml_set_attr(xml_root(svg), "height", "200")
write_xml(svg, "shadow.svg")

svg("layout.svg", width=12)
plotwar()
grid.rect(gp=gpar(col=NA, fill=rgb(1,1,1,.5)))
mainvp <- grid.grep("main", grep=TRUE, grobs=FALSE, viewports=TRUE)
downViewport(mainvp)
grid.rect(gp=gpar(fill=NA, lwd=3))
upViewport(0)
regionvp <- grid.grep("region", grep=TRUE, grobs=FALSE, viewports=TRUE)
downViewport(regionvp)
grid.rect(gp=gpar(fill=NA, lwd=3))
upViewport(0)
sizevp <- grid.grep("size", grep=TRUE, grobs=FALSE, viewports=TRUE)
downViewport(sizevp)
grid.rect(gp=gpar(fill=NA, lwd=3))
upViewport(0)
diagramvp <- grid.grep("diagram", grep=TRUE, grobs=FALSE, viewports=TRUE)
downViewport(diagramvp)
grid.rect(gp=gpar(fill=NA, lwd=3))
upViewport(0)
captionvp <- grid.grep("caption", grep=TRUE, grobs=FALSE, viewports=TRUE)
downViewport(captionvp)
grid.rect(gp=gpar(fill=NA, lwd=3))
upViewport(0)
dev.off()