Продолжение. Предыдущие части:
Рисуем картограммы в 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()
