Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Dividing a map by electoral results?

Tags:

r

I would like to divide a map of Germany vertically by the electoral results of 2013:

> VoteGermany2013
    Party Result
1 CDU/CSU   49.4
2     SPD   30.5
3   LINKE   10.2
4  GRUENE   10.0

What I'm looking for is very simple: a map divided like a one-bar graph, with 49.4% of the lenght for CDU/CSU, 30.5% for SPD and so on. It would be like a single bar divided in parts, but with the form of a country.

For the map, I'm using:

library(maps)
library(mapdata)
map("worldHires","Germany")
like image 508
Naomi Peer Avatar asked Mar 05 '15 16:03

Naomi Peer


Video Answer


1 Answers

Create a bar plot with rect, overlay the country border, and trim back the rectangles around the border.

enter image description here

library('maps')
library('mapdata')

## fill = TRUE !important
dat <- map("worldHires", "Germany", fill = TRUE)

## set up plotting window
p <- par('usr')
plot.new()
plot.window(p[1:2], p[3:4])

## make some data and calculate some useful things
pcts <- prop.table(table(sample(1:3, 20, replace = TRUE)))
xx <- range(dat$x, na.rm = TRUE)
yy <- range(dat$y, na.rm = TRUE)
zz <- diff(yy) * pcts

cols <- palette(rainbow(length(zz)))
cols <- c('red','black','gold')

## draw and color rectangles, you can do this many other ways
dy <- 0
for (ii in seq_along(zz)) {
  rect(p[1], yy[1] + dy,
       p[2], yy[1] + (dy <- sum(zz[1:ii])),
       col = cols[ii], border = NA)
}

map('worldHires', 'Germany', col = 'black', add = TRUE)

## trim around borders
xb <- xx + c(-1, 1)
yb <- yy + c(-1, 1)
polypath(c(dat$x, NA, c(xb, rev(xb))), c(dat$y, NA, rep(yb, each = 2)),
         col = 'white', rule = 'evenodd')

polypath part inspired by How can I color the ocean blue in a map of the US?

Edit: function for easier use, added labels

sample data

## examples
pcts <- prop.table(table(sample(1:3, 20, replace = TRUE)))


voteGermany2013 <- read.table(header = TRUE, text = "Party Result
1 CDU/CSU   49.4
2     SPD   30.5
3   LINKE   10.2
4  GRUENE   10.0")

function:

evelyne <- function(x, region, labels, cols) {
  op <- par(no.readonly = TRUE)
  on.exit(par(op))

  require('maps')
  require('mapdata')

  ## fill = TRUE !important
  dat <- map("worldHires", region, fill = TRUE)

  ## set up plotting window
  p <- par('usr')
  plot.new()
  plot.window(p[1:2], p[3:4])

  ## calculate some useful things
  xx <- range(dat$x, na.rm = TRUE)
  yy <- range(dat$y, na.rm = TRUE)
  zz <- diff(yy) * x

  if (missing(cols))
    cols <- palette(rainbow(length(x)))

  ## draw and color rectangles
  dyy <- rep(0, length(zz))
  dy <- 0
  for (ii in seq_along(zz)) {
    rect(p[1], yy[1] + dy, p[2], yy[1] + (dy <- sum(zz[1:ii])),
         col = cols[ii], border = NA)
    ## label y-coordinates
    dyy[ii] <- yy[1] + c(0, cumsum(zz))[ii] + zz[ii] / 2
  }

  map('worldHires', region, col = 'black', add = TRUE)

  ## trim around borders
  xb <- xx + c(-1,1)
  yb <- yy + c(-1,1)
  polypath(c(dat$x, NA, c(xb, rev(xb))), c(dat$y, NA, rep(yb, each = 2)),
           col = 'white', rule = 'evenodd')

  if (!missing(labels))
    text(max(xx), dyy, labels = labels, pos = 4, xpd = NA)
}

ex:

evelyne(pcts, 'Germany', cols = c('red','black','gold'))

enter image description here

with(voteGermany2013,
     evelyne(Result / 100, 'Germany', labels = sprintf('%s (%s%%)', Party, Result)))

enter image description here

like image 103
rawr Avatar answered Nov 25 '22 10:11

rawr