There and Back Again competition entry https://shiny.petras.space/commute/
rstats
rshiny
census
competition
leaflet
javascript
stats-nz

app.R 25KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611
  1. library(shiny)
  2. library(shinyjs)
  3. library(leaflet)
  4. library(rgdal)
  5. library(dplyr)
  6. library(leaflet.extras)
  7. library(shinyWidgets)
  8. source("leafletfunctions.R")
  9. source("extras.R")
  10. # work_travel <- read_csv("../travel-work.csv")
  11. load(file="datasets.RData")
  12. shpf <- readOGR(dsn="sa20025WGSfil")
  13. sa.in.dest <- shpf@data$SA22018_V1 %in% work_to$work_code
  14. sa.in.home <- shpf@data$SA22018_V1 %in% work_from$res_code
  15. transport.t <- c("Private car", "Passenger in car",
  16. "Bicycle", "Walk", "Company car", "Bus", "Train",
  17. "Ferry", "Work at home", "Other", "None/Unknown")
  18. edu.t <- c("Drive self", "Passenger in car", "Walk", "Bicycle",
  19. "School bus", "Public bus", "Train", "Ferry", "Study at home",
  20. "Other", "None/Unknown")
  21. cols.labs <- c(transport.t[1:10], "Total")
  22. cols.edu.labs <- c(edu.t[1:10], "Total")
  23. codelist <- shpf@data %>%
  24. mutate(sa2_code = as.numeric(as.character(SA22018_V1))) %>%
  25. select(sa2_code)
  26. startcols.res <- codelist %>% left_join(work_from, by = c("sa2_code" = "res_code"))
  27. startcols.res <- tencols[startcols.res$MAX]
  28. startcols.res <- ifelse(is.na(startcols.res), "#808080", startcols.res)
  29. startcols.work <- codelist %>% left_join(work_to, by = c("sa2_code" = "work_code"))
  30. startcols.work <- tencols[startcols.work$MAX]
  31. startcols.work <- ifelse(is.na(startcols.work), "#808080", startcols.work)
  32. startcols.edures <- codelist %>% left_join(edu_from,
  33. by = c("sa2_code" = "res_code"))
  34. startcols.edures <- tencols[startcols.edures$MAX]
  35. startcols.edures <- ifelse(is.na(startcols.edures), "#808080", startcols.edures)
  36. startcols.edu <- codelist %>% left_join(edu_to, by = c("sa2_code" = "edu_code"))
  37. startcols.edu <- tencols[startcols.edu$MAX]
  38. startcols.edu <- ifelse(is.na(startcols.edu), "#808080", startcols.edu)
  39. hrstr <- "<hr/>"
  40. # Define UI
  41. ui <- fluidPage(
  42. useShinyjs(),
  43. leafletjs,
  44. keyboardjs,
  45. tags$style(type = "text/css", extracss),
  46. leafletOutput("map"),
  47. absolutePanel(top = 10, right = 10, id="mapcontrol",
  48. div(
  49. radioButtons("radioeduemp",
  50. label = "Commuters (age 15+) travelling to",
  51. choiceNames = list(
  52. HTML("<span>E<u>m</u>ployment</span>"),
  53. HTML("<span>E<u>d</u>ucation</span>")
  54. ),
  55. choiceValues = list(
  56. "Employment", "Education"
  57. ),
  58. inline = TRUE),
  59. radioButtons("radioinout", label="Show commuters who",
  60. choiceNames = list(
  61. HTML("<span>Commute <u>f</u>rom selected area</span>"),
  62. HTML("<span>Commute <u>t</u>o selected area</span>")),
  63. choiceValues = list(
  64. "res",
  65. "work"
  66. ),
  67. inline = FALSE),
  68. radioButtons("radiocolour",
  69. label = "Colour by",
  70. choiceNames = list(
  71. HTML("<span>M<u>o</u>st common commute method</span>"),
  72. HTML("<span>N<u>u</u>mber of commuters</span>")
  73. ),
  74. choiceValues = list(
  75. "type",
  76. "number"
  77. ),
  78. inline = FALSE),
  79. div(class="locinfo",
  80. htmlOutput("lochtml")),
  81. div(id="loc2"),
  82. htmlOutput("secondarylochtml"))
  83. ),
  84. absolutePanel(top = 25, right = 10, id="control2",
  85. materialSwitch("controlswitch", value=TRUE, right=TRUE,
  86. inline=TRUE, status="info")),
  87. absolutePanel(bottom = 26, right = 10, id="loading",
  88. p("Loading...")),
  89. absolutePanel(bottom=26, right=10, left=10, top=10, id="infopanel",
  90. infotext),
  91. absolutePanel(bottom=10, left=10, id="infobuttoncontainer",
  92. prettyToggle("mapinfobutton", label_on = "Info",
  93. label_off = "Info", icon_on=icon("times"),
  94. icon_off = icon("info"),
  95. animation = "pulse",
  96. inline = TRUE,
  97. status_on = "danger",
  98. status_off = "info")
  99. )
  100. )
  101. # Define server logic
  102. server <- function(input, output) {
  103. sel.SA2.code <- reactiveVal(0)
  104. attribupdate <- FALSE
  105. mouseover <- reactive({
  106. lastover <- input$map_shape_mouseover$id
  107. lastover <- ifelse(is.null(lastover), 0, lastover)
  108. lastout <- input$map_shape_mouseout$id
  109. lastout <- ifelse(is.null(lastout), 0, lastout)
  110. ifelse(lastout == lastover, 0, lastover)
  111. })
  112. output$map <- renderLeaflet({
  113. leaf <- leaflet(shpf, options = leafletOptions(minZoom = 3, maxZoom = 13,
  114. crs = NULL)) %>%
  115. addPolygons(color="#000", opacity = 1, weight=1,
  116. fillColor = startcols.res,
  117. layerId = ~SA22018_V1,
  118. label = shpf@data$SA22018__1,
  119. fillOpacity = 1, group = "polys") %>%
  120. setView(174, -41, 6) %>%
  121. addResetMapButton() %>%
  122. addSearchFeatures("polys",
  123. options = searchFeaturesOptions(
  124. hideMarkerOnCollapse = TRUE,
  125. autoCollapse = FALSE,
  126. openPopup = FALSE,
  127. zoom=11,
  128. position="topleft")) %>%
  129. addLegend(position = "topleft",
  130. colors = c(tencols, "#808080"),
  131. labels = transport.t, opacity = 1,
  132. title = "Commute method")
  133. shinyjs::hideElement(selector="#loading p", asis = TRUE,
  134. anim=TRUE, animType = "slide", time=10)
  135. leaf
  136. })
  137. updateMap <- function() {
  138. shinyjs::showElement(selector="#loading p", asis = TRUE,
  139. anim=TRUE, animType = "slide")
  140. selcode <- sel.SA2.code()
  141. selcode <- ifelse(is.na(selcode), 0, selcode)
  142. psel <- selcode %in% shpf@data$SA22018_V1
  143. if (input$radioeduemp == "Employment") {
  144. if (input$radiocolour == "type") {
  145. if (input$radioinout == "work") {
  146. fcols <- startcols.work
  147. if (psel) {
  148. codvs <- work_simp %>% filter(work_code == selcode)
  149. codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "res_code"))
  150. codvs <- tencols[codvs$MAX]
  151. fcols <- ifelse(is.na(codvs), "#808080", codvs)
  152. }
  153. } else {
  154. fcols <- startcols.res
  155. if (psel) {
  156. codvs <- work_simp %>% filter(res_code == selcode)
  157. codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "work_code"))
  158. codvs <- tencols[codvs$MAX]
  159. fcols <- ifelse(is.na(codvs), "#808080", codvs)
  160. }
  161. }
  162. lp <- leafletProxy("map", data = shpf) %>%
  163. setShapeStyle(layerId = ~SA22018_V1, fillColor = fcols) %>%
  164. clearControls() %>%
  165. addLegend(position = "topleft",
  166. colors = c(tencols, "#808080"),
  167. labels = transport.t, opacity = 1,
  168. title = "Commute method"
  169. ) %>%
  170. clearGroup("hpoly")
  171. } else {
  172. if (input$radioinout == "work") {
  173. if (psel) {
  174. codvs <- work_simp %>% filter(work_code == selcode)
  175. codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "res_code"))
  176. cvals <- ifelse(codvs$total == 0, NA, codvs$total)
  177. } else {
  178. codvs <- codelist %>%
  179. left_join(work_to, by = c("sa2_code" = "work_code"))
  180. cvals <- ifelse(codvs$total == 0, NA, codvs$total)
  181. }
  182. } else {
  183. if (psel) {
  184. codvs <- work_simp %>% filter(res_code == selcode)
  185. codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "work_code"))
  186. cvals <- ifelse(codvs$total == 0, NA, codvs$total)
  187. } else {
  188. codvs <- codelist %>%
  189. left_join(work_from, by = c("sa2_code" = "res_code"))
  190. cvals <- ifelse(codvs$total == 0, NA, codvs$total)
  191. }
  192. }
  193. cvr <- range(cvals, na.rm = TRUE)
  194. binner <- colorBin(c("white", "red"), cvr, bins = 7, pretty = TRUE)
  195. lp <- leafletProxy("map", data = shpf) %>%
  196. setShapeStyle(layerId = ~SA22018_V1, fillColor = binner(cvals)) %>%
  197. clearControls() %>%
  198. addLegend(position = "topleft",
  199. pal = binner,
  200. values = cvals, opacity = 1,
  201. na.label = "None",
  202. title = "Number of commuters") %>%
  203. clearGroup("hpoly")
  204. }
  205. } else {
  206. # Education code
  207. if (input$radiocolour == "type") {
  208. if (input$radioinout == "work") {
  209. fcols <- startcols.edu
  210. if (psel) {
  211. codvs <- edu_simp %>% filter(edu_code == selcode)
  212. codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "res_code"))
  213. codvs <- tencols[codvs$MAX]
  214. fcols <- ifelse(is.na(codvs), "#808080", codvs)
  215. }
  216. } else {
  217. fcols <- startcols.edures
  218. if (psel) {
  219. codvs <- edu_simp %>% filter(res_code == selcode)
  220. codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "edu_code"))
  221. codvs <- tencols[codvs$MAX]
  222. fcols <- ifelse(is.na(codvs), "#808080", codvs)
  223. }
  224. }
  225. lp <- leafletProxy("map", data = shpf) %>%
  226. setShapeStyle(layerId = ~SA22018_V1, fillColor = fcols) %>%
  227. clearControls() %>%
  228. addLegend(position = "topleft",
  229. colors = c(tencols, "#808080"),
  230. labels = edu.t, opacity = 1,
  231. title = "Commute method"
  232. ) %>%
  233. clearGroup("hpoly")
  234. } else {
  235. if (input$radioinout == "work") {
  236. if (psel) {
  237. codvs <- edu_simp %>% filter(edu_code == selcode)
  238. codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "res_code"))
  239. cvals <- ifelse(codvs$total == 0, NA, codvs$total)
  240. } else {
  241. codvs <- codelist %>%
  242. left_join(edu_to, by = c("sa2_code" = "edu_code"))
  243. cvals <- ifelse(codvs$total == 0, NA, codvs$total)
  244. }
  245. } else {
  246. if (psel) {
  247. codvs <- edu_simp %>% filter(res_code == selcode)
  248. codvs <- codelist %>% left_join(codvs, by=c("sa2_code" = "edu_code"))
  249. cvals <- ifelse(codvs$total == 0, NA, codvs$total)
  250. } else {
  251. codvs <- codelist %>%
  252. left_join(edu_from, by = c("sa2_code" = "res_code"))
  253. cvals <- ifelse(codvs$total == 0, NA, codvs$total)
  254. }
  255. }
  256. cvr <- range(cvals, na.rm = TRUE)
  257. binner <- colorBin(c("white", "red"), cvr, bins = 7, pretty = TRUE)
  258. lp <- leafletProxy("map", data = shpf) %>%
  259. setShapeStyle(layerId = ~SA22018_V1, fillColor = binner(cvals)) %>%
  260. clearControls() %>%
  261. addLegend(position = "topleft",
  262. pal = binner,
  263. values = cvals, opacity = 1,
  264. na.label = "None",
  265. title = "Number of commuters") %>%
  266. clearGroup("hpoly")
  267. }
  268. }
  269. if (psel) {
  270. lp %>% addPolygons(group = "hpoly",
  271. weight = 4,
  272. data = shpf[which(shpf@data$SA22018_V1 == selcode),],
  273. color = "#000000",
  274. fill = FALSE, opacity = 1)
  275. }
  276. shinyjs::hideElement(selector="#loading p", asis=TRUE,
  277. anim=TRUE, animType = "slide",
  278. time = 1)
  279. }
  280. observeEvent(input$map_click, ignoreInit = TRUE, {
  281. cursel <- sel.SA2.code()
  282. p <- input$map_click
  283. pdat <- data.frame(Longitude = p$lng,
  284. Latitude =p$lat)
  285. coordinates(pdat) <- ~ Longitude + Latitude
  286. proj4string(pdat) <- proj4string(shpf)
  287. ppoly <- over(pdat, shpf)
  288. codetmp <- as.numeric(as.character(ppoly[1,"SA22018_V1"]))
  289. codetmp <- ifelse(is.na(codetmp), 0, codetmp)
  290. newsl <- ifelse(sel.SA2.code() == codetmp, 0, codetmp)
  291. if (newsl != cursel) {
  292. sel.SA2.code(newsl)
  293. updateMap()
  294. }
  295. })
  296. observeEvent(input$map_zoom, once=TRUE, {
  297. if (!attribupdate) {
  298. shinyjs::html(selector=".leaflet-control-attribution.leaflet-control",
  299. html = attribhtml)
  300. attribupdate <<- TRUE
  301. }
  302. })
  303. observeEvent(input$map_shape_mouseover, once=TRUE,{
  304. # Backup
  305. if (!attribupdate) {
  306. shinyjs::html(selector=".leaflet-control-attribution.leaflet-control",
  307. html = attribhtml)
  308. attribupdate <<- TRUE
  309. }
  310. })
  311. observeEvent(input$radioeduemp, ignoreInit = TRUE, {
  312. updateMap()
  313. })
  314. observeEvent(input$radioinout, ignoreInit = TRUE, {
  315. updateMap()
  316. })
  317. observeEvent(input$infobutton, {
  318. print(input$infobutton)
  319. })
  320. observeEvent(input$radiocolour, ignoreInit = TRUE, {
  321. updateMap()
  322. })
  323. observeEvent(input$controlswitch, ignoreInit = TRUE, {
  324. shinyjs::toggleElement("mapcontrol", anim=TRUE,
  325. time = 0.5)
  326. })
  327. observeEvent(input$mapinfobutton, ignoreInit = TRUE, {
  328. shinyjs::toggleElement("infopanel", anim=TRUE,
  329. time = 0.5)
  330. })
  331. output$lochtml <- renderUI({
  332. seled <- sel.SA2.code()
  333. seled <- ifelse(is.na(seled), 0, seled)
  334. if (!(seled %in% shpf@data$SA22018_V1)) {
  335. HTML("")
  336. } else {
  337. namesel <- shpf@data$SA22018__1[shpf@data$SA22018_V1 == seled]
  338. if (input$radioeduemp == "Employment") {
  339. if (input$radiocolour == "type") {
  340. str <- sprintf("<b>%s</b>", namesel)
  341. if (input$radioinout == "work") {
  342. str <- sprintf("<p>Commuting method of people who <b>work</b> in
  343. <u>%s</u></p>", str)
  344. vals <- as.numeric(work_to[work_to$work_code == seled, 5:15])
  345. vals <- ifelse(is.na(vals), 0, vals)
  346. vals <- ifelse(vals < 0, "~0", as.character(vals))
  347. listi <- paste0(sprintf("<li>%s: %s</li>", cols.labs,
  348. vals),
  349. collapse="")
  350. str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
  351. } else {
  352. str <- sprintf("<p>Commuting method of people who <b>live</b> in
  353. <u>%s</u></p>", str)
  354. vals <- as.numeric(work_from[work_from$res_code == seled, 5:15])
  355. vals <- ifelse(is.na(vals), 0, vals)
  356. vals <- ifelse(vals < 0, "~0", as.character(vals))
  357. listi <- paste0(sprintf("<li>%s: %s</li>", cols.labs,
  358. vals),
  359. collapse="")
  360. str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
  361. }
  362. HTML(str)
  363. } else {
  364. str <- hrstr
  365. if (input$radioinout == "work") {
  366. val <- as.numeric(work_to[work_to$work_code == seled, 15])
  367. val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
  368. str <- sprintf("%s<p>%d people commute <b>to</b> employment in
  369. <b><u>%s</u></b></p>", str, val, namesel)
  370. if (val > 0) {
  371. subs <- work_simp %>% filter(work_code == seled) %>%
  372. arrange(desc(total)) %>% head(10)
  373. listi <- paste0(sprintf("<li>%s: %s</li>", subs$res_name,
  374. subs$total),
  375. collapse="")
  376. str <- sprintf("%s<p>Top areas to commute from:<p>
  377. <ul>%s</ul>", str, listi)
  378. }
  379. } else {
  380. val <- as.numeric(work_from[work_from$res_code == seled, 15])
  381. val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
  382. str <- sprintf("%s<p>%d people commute to employment <b>from</b>
  383. <b><u>%s</u></b></p>", str, val, namesel)
  384. if (val > 0) {
  385. subs <- work_simp %>% filter(res_code == seled) %>%
  386. arrange(desc(total)) %>% head(10)
  387. listi <- paste0(sprintf("<li>%s: %s</li>", subs$work_name,
  388. subs$total),
  389. collapse="")
  390. str <- sprintf("%s<p>Top areas to commute to:<p>
  391. <ul>%s</ul>", str, listi)
  392. }
  393. }
  394. HTML(str)
  395. }
  396. } else {
  397. if (input$radiocolour == "type") {
  398. str <- sprintf("<b>%s</b>", namesel)
  399. if (input$radioinout == "work") {
  400. str <- sprintf("<p>Commuting method of people who commute to
  401. <b>education</b> in
  402. <u>%s</u></p>", str)
  403. vals <- as.numeric(edu_to[edu_to$edu_code == seled, 5:15])
  404. vals <- ifelse(is.na(vals), 0, vals)
  405. vals <- ifelse(vals < 0, "~0", as.character(vals))
  406. listi <- paste0(sprintf("<li>%s: %s</li>", cols.edu.labs,
  407. vals),
  408. collapse="")
  409. str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
  410. } else {
  411. str <- sprintf("<p>Commuting method to education
  412. of people who <b>live</b> in
  413. <u>%s</u></p>", str)
  414. vals <- as.numeric(edu_from[edu_from$res_code == seled, 5:15])
  415. vals <- ifelse(is.na(vals), 0, vals)
  416. vals <- ifelse(vals < 0, "~0", as.character(vals))
  417. listi <- paste0(sprintf("<li>%s: %s</li>", cols.edu.labs,
  418. vals),
  419. collapse="")
  420. str <- paste0(hrstr, str, "<ul>", listi, "</ul>")
  421. }
  422. } else {
  423. str <- hrstr
  424. if (input$radioinout == "work") {
  425. val <- as.numeric(edu_to[edu_to$edu_code == seled, 15])
  426. val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
  427. str <- sprintf("%s<p>%d people commute <b>to</b> education in
  428. <b><u>%s</u></b></p>", str, val, namesel)
  429. if (val > 0) {
  430. subs <- edu_simp %>% filter(edu_code == seled) %>%
  431. arrange(desc(total)) %>% head(10)
  432. listi <- paste0(sprintf("<li>%s: %s</li>", subs$res_name,
  433. subs$total),
  434. collapse="")
  435. str <- sprintf("%s<p>Top areas to commute from:<p>
  436. <ul>%s</ul>", str, listi)
  437. }
  438. } else {
  439. val <- as.numeric(edu_from[edu_from$res_code == seled, 15])
  440. val <- ifelse(is.na(val), 0, ifelse(val < 0, 0, val))
  441. str <- sprintf("%s<p>%d people commute to education <b>from</b>
  442. <b><u>%s</u></b></p>", str, val, namesel)
  443. if (val > 0) {
  444. subs <- edu_simp %>% filter(res_code == seled) %>%
  445. arrange(desc(total)) %>% head(10)
  446. listi <- paste0(sprintf("<li>%s: %s</li>", subs$edu_name,
  447. subs$total),
  448. collapse="")
  449. str <- sprintf("%s<p>Top areas to commute to:<p>
  450. <ul>%s</ul>", str, listi)
  451. }
  452. }
  453. }
  454. HTML(str)
  455. }
  456. }
  457. })
  458. output$secondarylochtml <- renderUI({
  459. curshp <- mouseover()
  460. cursel <- sel.SA2.code()
  461. if (curshp == 0) {
  462. if (cursel == 0) {
  463. HTML(paste0(hrstr,
  464. "<p><em>No area selected. Click on
  465. an area for more information.</em></p>"))
  466. } else {
  467. HTML("")
  468. }
  469. } else {
  470. shpname <- shpf@data$SA22018__1[curshp == shpf@data$SA22018_V1]
  471. if (cursel == 0) {
  472. if (input$radioeduemp == "Employment") {
  473. if (input$radioinout == "res") {
  474. fdf <- work_from %>% filter(res_code == curshp)
  475. tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
  476. ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
  477. pmp <- ""
  478. if (ttype != 0) {
  479. pmp <- sprintf("Most common mode of transport: %s",
  480. transport.t[ttype])
  481. }
  482. HTML(sprintf("%s<p><em>%d people commute to employment from
  483. %s. %s</em></p>", hrstr, tot, shpname,
  484. pmp))
  485. } else {
  486. fdf <- work_to %>% filter(work_code == curshp)
  487. tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
  488. ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
  489. pmp <- ""
  490. if (ttype != 0) {
  491. pmp <- sprintf("Most common mode of transport: %s",
  492. transport.t[ttype])
  493. }
  494. HTML(sprintf("%s<p><em>%d people commute to employment in
  495. %s. %s</em></p>", hrstr, tot, shpname,
  496. pmp))
  497. }
  498. } else {
  499. if (input$radioinout == "res") {
  500. fdf <- edu_from %>% filter(res_code == curshp)
  501. tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
  502. ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
  503. pmp <- ""
  504. if (ttype != 0) {
  505. pmp <- sprintf("Most common mode of transport: %s",
  506. edu.t[ttype])
  507. }
  508. HTML(sprintf("%s<p><em>%d people commute to education from
  509. %s. %s</em></p>", hrstr, tot, shpname,
  510. pmp))
  511. } else {
  512. fdf <- edu_to %>% filter(edu_code == curshp)
  513. tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
  514. ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
  515. pmp <- ""
  516. if (ttype != 0) {
  517. pmp <- sprintf("Most common mode of transport: %s",
  518. edu.t[ttype])
  519. }
  520. HTML(sprintf("%s<p><em>%d people commute to education in
  521. %s. %s</em></p>", hrstr, tot, shpname,
  522. pmp))
  523. }
  524. }
  525. } else {
  526. shpname.0 <- shpf@data$SA22018__1[cursel == shpf@data$SA22018_V1]
  527. if (input$radioeduemp == "Employment") {
  528. if (input$radioinout == "res") {
  529. fdf <- work_simp %>% filter(res_code == cursel,
  530. work_code == curshp)
  531. tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
  532. ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
  533. pmp <- ""
  534. if (ttype != 0) {
  535. pmp <- sprintf("Most common mode of transport: %s",
  536. transport.t[ttype])
  537. }
  538. HTML(sprintf("%s<p><em>%d people commute to employment
  539. in %s from %s. %s</em></p>", hrstr, tot, shpname,
  540. shpname.0, pmp))
  541. } else {
  542. fdf <- work_simp %>% filter(work_code == cursel,
  543. res_code == curshp)
  544. tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
  545. ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
  546. pmp <- ""
  547. if (ttype != 0) {
  548. pmp <- sprintf("Most common mode of transport: %s",
  549. transport.t[ttype])
  550. }
  551. HTML(sprintf("%s<p><em>%d people commute to employment
  552. in %s from %s. %s</em></p>", hrstr, tot, shpname.0,
  553. shpname, pmp))
  554. }
  555. } else {
  556. if (input$radioinout == "res") {
  557. fdf <- edu_simp %>% filter(res_code == cursel,
  558. edu_code == curshp)
  559. tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
  560. ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
  561. pmp <- ""
  562. if (ttype != 0) {
  563. pmp <- sprintf("Most common mode of transport: %s",
  564. edu.t[ttype])
  565. }
  566. HTML(sprintf("%s<p><em>%d people commute to education
  567. in %s from %s. %s</em></p>", hrstr, tot, shpname,
  568. shpname.0, pmp))
  569. } else {
  570. fdf <- edu_simp %>% filter(edu_code == cursel,
  571. res_code == curshp)
  572. tot <- ifelse(nrow(fdf) == 0, 0, fdf$total)
  573. ttype <- ifelse(is.na(fdf$MAX) || nrow(fdf) == 0, 0, fdf$MAX)
  574. pmp <- ""
  575. if (ttype != 0) {
  576. pmp <- sprintf("Most common mode of transport: %s",
  577. edu.t[ttype])
  578. }
  579. HTML(sprintf("%s<p><em>%d people commute to education
  580. in %s from %s. %s</em></p>", hrstr, tot, shpname.0,
  581. shpname, pmp))
  582. }
  583. }
  584. }
  585. }
  586. })
  587. }
  588. # Run the application
  589. shinyApp(ui = ui, server = server)