Рисуем картодиаграммы в R: бросаем пироги

Продолжение. Предыдущие части:
Рисуем картограммы в R,
Рисуем фоновые картограммы в R: красим районы.

У карт с заливкой районов цветом в зависимости от доли партии на выборах есть существенный недостаток: на них никак не отражается плотность населения. Из-за этого искажается представление о значении того или иного региона для результатов голосования.

Избежать этого искажения можно изображая результаты выборов при помощи круговых диаграмм («пирогов») площадь которых пропорциональна числу проголосовавших:

Создано это изображение следующим образом:

> # Отсортируем районы в порядке убывания числа действительных бюлетеней
> # (большие «пироги» отрисуются раньше, это улучшает внешний вид):
> udm.TIK <- udm.TIK[order(tik$v10, decreasing=T),]
> tik <- tik[order(tik$v10, decreasing=T),]
> # Запрашиваем структуру первой строки объекта udm.TIK…
> str(udm.TIK[1,]) # … и изучаем её:
Formal class 'SpatialPolygonsDataFrame' [package "sp"] with 5 slots
  ..@ data       :'data.frame': 1 obs. of  3 variables:
  .. ..$ OSM_ID   : int -954515
  .. ..$ NAME     : Factor w/ 341 levels "Агрикольское",..: 107
  .. ..$ ADMIN_LVL: Factor w/ 7 levels "10","2","3","4",..: 5
  ..@ polygons   :List of 1
  .. ..$ :Formal class 'Polygons' [package "sp"] with 5 slots
  .. .. .. ..@ Polygons :List of 1
  .. .. .. .. ..$ :Formal class 'Polygon' [package "sp"] with 5 slots
  .. .. .. .. .. .. ..@ labpt  : num [1:2] 53.2 56.9
  .. .. .. .. .. .. ..@ area   : num 0.0469
  .. .. .. .. .. .. ..@ hole   : logi FALSE
  .. .. .. .. .. .. ..@ ringDir: int 1
  .. .. .. .. .. .. ..@ coords : num [1:272, 1:2] 53 53 53 53.1 53.1 ...
  .. .. .. ..@ plotOrder: int 1
  .. .. .. ..@ labpt    : num [1:2] 53.2 56.9
  .. .. .. ..@ ID       : chr "205"
  .. .. .. ..@ area     : num 0.0469
  ..@ plotOrder  : int 1
  ..@ bbox       : num [1:2, 1:2] 53 56.7 53.4 57
  .. ..- attr(*, "dimnames")=List of 2
  .. .. ..$ : chr [1:2] "x" "y"
  .. .. ..$ : chr [1:2] "min" "max"
  ..@ proj4string:Formal class 'CRS' [package "sp"] with 1 slots
  .. .. ..@ projargs: chr "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"

Обратите внимание на содержимое слота labpt, входящего в слот polygons (выделено красным) — это координаты, к которым прикрепляется на карте название региона. Для нас эта точка будет центром будущей круговой диаграммы.

> # Соберём долготы…
> x <- sapply(slot(udm.TIK, "polygons"), slot, "labpt")[1,]
> # … и широты для размещения круговых диаграмм
> y <- sapply(slot(udm.TIK, "polygons"), slot, "labpt")[2,]
> # Сформируем матрицу с долями партий — функция draw.pie требует именно матрицу:
> part <- matrix(
+ c(tik$ER/tik$v10, tik$KPRF/tik$v10, tik$LDPR/tik$v10, tik$SR/tik$v10,
+ 1-(tik$ER+tik$KPRF+tik$LDPR+tik$SR)/tik$v10),
+ ncol=5, dimnames=list(tik$x ,c("ЕР", "КПРФ", "ЛДПР", "СР", "др.")))
> # Закажем для партий цвета:
> color <- c("#0000ff88", "#ff000088", "#ffff0088", "#00ff0088", "transparent")
> #  "#ff000088" — красный полупрозрачный (88 — уровень прозрачности)
> # Закажем библиотеку, умеющую рисовать круговые диаграммы на карте:
> library("mapplots")
> # Подготовим фон:
> png("result.png", width=5, height=5, units="in", res=100, bg="transparent")
> par(mai=c(.1,.1,1,.1))
> plot(udm[udm$ADMIN_LVL == 2 & !is.na(udm$ADMIN_LVL),], col="white", border="gray")
> # Рисуем круговые диаграммы. Для того, чтобы площадь круга была пропорциональна
> # числу избирателей, радиус круга пропорционален квадратному корню из их числа.
> draw.pie(x, y, part, radius=sqrt(tik$v10)/1500, col=color)
> # Подпишем названия районов (мелким шрифтом и справа от центров «пирогов»)…
> text(x[grep("район", tik$x)]+0.05, y[grep("район", tik$x)],
+ labels=tik$x[grep("район", tik$x)], adj=0, cex=.5)
> # … и названия городов (нормальным шрифтом и слева от центров «пирогов»)
> text(x[grep("район", tik$x, invert=T)]-0.05, y[grep("район", tik$x, invert=T)],
+ labels=tik$x[grep("район", tik$x, invert=T)], adj=1)
> # Разместим легенду, заголовок и закроем png-устройство:
> legend("left", legend=c("ЕР", "КПРФ", "ЛДПР", "СР", "прочие"), fill=color, bty="n")
> title(main="Результаты выборов в Государственную Думу\nв муниципальных районах
+ и городских округах Удмуртии")
> dev.off()

UPD — Способ, позволяющий присоединять шкалу численности проголосовавших:

> # Сформируем матрицу с результатами партий, а не их долями:
> part <- matrix(c(tik$ER, tik$v10-tik$ER), ncol=2,
+ dimnames=list(tik$x ,c("ЕР", "прочие")))
> # Закажем для партий цвета:
> color <- c("#0000ff88", "transparent")
> plot(udm[udm$ADMIN_LVL == 2 & !is.na(udm$ADMIN_LVL),], col="white", border="gray")
> # Рисуем круговые диаграммы. Такой синтаксис обеспечивает пропорциональность
> # площади круга числу проголосовавших избирателей.
> draw.pie(x, y, part, radius=1/4, col=color)
> # Легенда для числа проголосовавших:
> legend.bubble("right", # Указываем размещение легенды, …
+ maxradius=1/4, # радиус самой большой окружности, …
+ z=round(max(tik$v10)/1000,0), # диапазон числовых подписей, …
+ txt.cex=0.5, # их размер, …
+ n=3, # и число…
+ bty="n") # а также отменяем отрисовку рамки.
> # Легенда для долей партий и их цветов:
> legend.pie("left", # Указываем размещение легенды, …
+ radius=1/4, # размер пирога, …
+ z=c(sum(tik$ER), sum(tik$v10-tik$ER)), # изображаемые на нём пропорции, …
+ col=color, # их цвета, …
+ labels=c("ЕР", "прочие"), # метки…
+ cex=0.5, # и их размер.
+ mab=2, # Корректируем отступы
+ bty="n") # а также отменяем отрисовку рамки.
> title(main="Результаты выборов в Государственную Думу\nв муниципальных районах
+ и городских округах Удмуртии")
> dev.off()