-
Notifications
You must be signed in to change notification settings - Fork 0
/
server.R
140 lines (124 loc) · 6.77 KB
/
server.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
library(shiny)
library(rgdal) # for readOGR function
library(leaflet)
library(ggplot2) # for barplot
library(stringr) # for str_wrap function
#Version 4: make circles clickable to display bar plots
##############################
#read shapefile
dprk.shp <- readOGR(dsn = "PRK_adm", layer = "PRK_adm1") #SpatialPolygonsDF
#read data
data <- read.csv("popdensity.csv")
heating <- read.csv(file = "heating.csv") # heating system data
cooking <- read.csv(file = "cooking.csv") # cooking fuel data
#Merge shapefile with DPRK data
dprk.shp$Province <- dprk.shp$NAME_1 #create "Province" to merge by "Province";
dprk.shp@data <- merge(dprk.shp@data, data, by = "Province")
# Create color pallete
binpal <- colorBin(palette = "Reds", domain = dprk.shp$PopDensity,
bins = c(0, 200, 400, 600, 800, 1000, 4500), pretty = FALSE)
shinyServer(function(input, output) {
#static part of the map
output$dprkmap <- renderLeaflet({
leaflet () %>%
setView(lng = 124, lat = 42, zoom = 7) %>%
addPolygons(data = dprk.shp, stroke = TRUE, color = "black", weight = 1,
smoothFactor = 1,
fillOpacity = 0.5, fillColor = binpal(dprk.shp$PopDensity),
popup = paste("Province/Region:", dprk.shp$Display, "<br>",
"Population Density:", dprk.shp$PopDensity),
group = "density",
layerId = ~Display) %>%
addLegend(position = "bottomright", pal = binpal,
values = dprk.shp$PopDensity, opacity = 0.5,
title = "Population Density") %>%
addMarkers(lng = 125.8, lat = 38.97,
popup = paste("The Capital: Pyongyang <br> Population Density:",
dprk.shp$PopDensity[dprk.shp$Display == "Pyongyang"], "<br>",
"Households that use electricity as cooking fuel:",
dprk.shp$PercElectricityCooking[dprk.shp$Display == "Pyongyang"], "%",
"<br>", "Households that use electronic heating:",
dprk.shp$PercElectronicHeating[dprk.shp$Display == "Pyongyang"], "%")
)
})
# put dynamic parts of the map in observers
## add circles for cooking fuel
observe({
proxy <- leafletProxy("dprkmap", data = dprk.shp)
proxy %>% clearGroup(group = "electricitycooking")
if (input$cooking) {
proxy %>%
addCircles(data = dprk.shp, lng = ~long, lat = ~lat, weight = 1, opacity = 3,
radius = sqrt(dprk.shp$PercElectricityCooking / pi) * 30000,
popup = paste("Province:", dprk.shp$Display, "<br>",
"Households that use electricity as cooking fuel:",
dprk.shp$PercElectricityCooking, "%"),
group = "electricitycooking", layerId = ~paste0(Display, "1")
# here have to assign layerId different from the polygons earlier;
# and circles for heating later;
)
}
})
## add circles for heating system
observe({
proxy <- leafletProxy("dprkmap", data = dprk.shp)
proxy %>% clearGroup(group = "electronicheating")
if (input$heating) {
proxy %>%
addCircles(data = dprk.shp, lng = ~long, lat = ~lat, weight = 1, opacity = 3,
radius = sqrt(dprk.shp$PercElectronicHeating / pi) * 30000,
fillColor = "green", color = "green",
popup = paste("Province:", dprk.shp$Display, "<br>",
"Households that use electronic heating:",
dprk.shp$PercElectronicHeating, "%"),
group = "electronicheating", layerId = ~paste0(Display, "2")
# here have to assign layerId different from the polygons;
# and circles for cooking earlier;
)
}
})
## clicking on a province generates bar plots of heating and cooking fuel for that province
### Get data frame for the province that was clicked on
df_reactive <- eventReactive(input$dprkmap_shape_click, {
p <- input$dprkmap_shape_click
#### if p$id ends in "1" or "2", get rid of these numbers;
#### p$id that end in "1" or "2" come from circles;
#### p$id that do not end in "1" or "2" come from the polygons;
#### The goal is to extract from p$id the name of the province that is being clicked on;
if (regmatches(p$id, regexpr(".$", p$id)) == "1" |
# this regmatches function returns the last character in the string given by p$id;
regmatches(p$id, regexpr(".$", p$id)) == "2") {
id <- sub("[0-9]", "", p$id)
}
else id <- p$id
data.frame(type_heating = c("Central/Local", "Electronic", "Electronic with others",
"Coal boiler/Briquette hole", "Wood hole", "Others"),
households_heating = as.numeric(heating[heating$Province == id, 3:8]),
type_cooking = c("Electricity", "Gas", "Petroleum", "Coal", "Wood", "Others"),
households_cooking = as.numeric(cooking[cooking$Province == id, 3:8]),
province_name = id #this extra column stores province for title of plot later;
)
})
output$barCooking <- renderPlot({
ggplot(data = df_reactive(), aes(x = type_cooking, y = households_cooking)) +
geom_bar(stat = "identity", fill = "steelblue") +
geom_text(aes(label = households_cooking), vjust = -0.3, size = 3.5) + #display y values on bars
labs(title = paste("Households by Type of Cooking Fuel in", df_reactive()[1, 5]),
#get province name from fifth column of data frame from df_reactive() earlier
x = "Type of Cooking Fuel Used", y = "Number of Households") +
theme_minimal() +
scale_x_discrete(labels = function(x) str_wrap(x, width = 10)) + #wrap x var names
ylim(0, max(cooking[ , 3:8])) #set same y axis for bar plots of all provinces
})
output$barHeating <- renderPlot({
ggplot(data = df_reactive(), aes(x = type_heating, y = households_heating)) +
geom_bar(stat = "identity", fill = "green") +
geom_text(aes(label = households_heating), vjust = -0.3, size = 3.5) + #display y values on bars
labs(title = paste("Households by Type of Heating System in", df_reactive()[1, 5]),
#get province name from fifth column of data frame from df_reactive() earlier
x = "Type of Heating System", y = "Number of Households") +
theme_minimal() +
scale_x_discrete(labels = function(x) str_wrap(x, width = 10)) + #wrap x var names
ylim(0, max(heating[ , 3:8])) #set same y axis for bar plots of all provinces
})
})