postcoder/app.R at master · traffordDataLab/postcoder · GitHub

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
## Postcoder ##

library(shiny) ; library(shinyWidgets) ; library(tidyverse) ; library(PostcodesioR) ; library(leaflet) ; library(htmlwidgets) ; library(markdown)

server <- function(input, output) {

  output$map <- renderLeaflet({
    leaflet() %>%
      addProviderTiles("CartoDB.Positron") %>%
      setView(lng = -2.330256, lat= 53.421829, zoom = 12)
  })

  click <- eventReactive(input$map_click,{
    event <- input$map_click
  })

  observe({

    if (input$selection == "postcode") {

      observeEvent(input$submit, {

        result <- postcode_lookup(input$target)

        tryCatch({
        leafletProxy("map") %>%
          clearMarkers() %>% clearPopups() %>%
          setView(lng = result$longitude, lat = result$latitude, zoom = 18) %>%
          addProviderTiles(providers$CartoDB.Positron, options = tileOptions(minZoom = 5, maxZoom = 17)) %>%
          addCircleMarkers(lng = result$longitude, lat = result$latitude, fill = TRUE, stroke = TRUE,
                           weight = 2, color = "#046dc3", opacity = 1,
                           group = "marker") %>%
          addPopups(lng = result$longitude, lat = result$latitude,
                    popup = paste0("<h4>", result$postcode, "</h4>",
                                   "<strong>Local authority:</strong> ", result$admin_district,
                                   "<br /><strong><abbr title='Integrated Care Board'>ICB</abbr>:</strong> ", result$icb,
                                   "<br /><strong>Constituency:</strong> ", result$parliamentary_constituency,
                                   "<br /><strong>Ward:</strong> ", result$admin_ward,
                                   "<br /><strong><abbr title='Middle-layer Super Output Area'>MSOA</abbr>:</strong> ", result$msoa,
                                   "<br /><strong><abbr title='Lower-layer Super Output Area'>LSOA</abbr>:</strong> ", result$lsoa)) %>%
          onRender(paste0("function(el, x) {$('head').append(","\'<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">\'",");}"))
        },
        error = function(e) {
          showModal(modalDialog(tags$h5("Please enter a valid postcode")))
        })
      })
    }
    else {

      result <- reverse_geocoding(longitude = click()$lng,
                                  latitude = click()$lat,
                                  limit = 1)

     leafletProxy("map") %>%
        clearMarkers() %>% clearPopups() %>%
        setView(lng = click()$lng, lat = click()$lat, zoom = 18) %>%
        addProviderTiles(providers$CartoDB.Positron, options = tileOptions(minZoom = 5, maxZoom = 17), group = "Road map") %>%
        addCircleMarkers(lng = click()$lng, lat = click()$lat, fill = TRUE, stroke = TRUE,
                         weight = 2, color = "#046dc3", opacity = 1) %>%
        addPopups(lng = click()$lng, lat = click()$lat,
                  popup = ifelse(
                    is.null(result),
                    paste0("<h5>Sorry, there is no postcode at this location.</h5>"),
                    paste0("<h4>", result[[1]]$postcode, "</h4>",
                           "<strong>Local authority:</strong> ", result[[1]]$admin_district,
                           "<br /><strong><abbr title='Integrated Care Board'>ICB</abbr>:</strong> ", result[[1]]$icb,
                           "<br /><strong>Constituency:</strong> ", result[[1]]$parliamentary_constituency,
                           "<br /><strong>Ward:</strong> ", result[[1]]$admin_ward,
                           "<br /><strong><abbr title='Middle-layer Super Output Area'>MSOA</abbr>:</strong> ", result[[1]]$msoa,
                           "<br /><strong><abbr title='Lower-layer Super Output Area'>LSOA</abbr>:</strong> ", result[[1]]$lsoa)
                  )) %>%
        onRender(paste0("function(el, x) {$('head').append(","\'<meta name=\"viewport\" content=\"width=device-width, initial-scale=1.0\">\'",");}"))
    }
  })

}

ui <- bootstrapPage(title = "Postcoder",
  # Set the language of the page - important for accessibility
  tags$html(lang = "en-GB"),
  tags$head(includeCSS("styles.css"),
            leafletOutput("map", width = "100%", height = "100%"),
            absolutePanel(id = "uiPanel", class = "panel panel-default controls", top = 10, left = 70,
                          width = "200px",
                          tags$main(
                            a(
                              img(
                                src = "https://www.trafforddatalab.io/images/trafford_council_logo_black_on_white_100px.png",
                                style = "position: relative; top: -5px;",
                                height = 45,
                                alt = "Trafford Council"
                              ),
                              href = "https://www.trafford.gov.uk",
                              target = "_blank"
                            ),
                            h1("Postcoder"),
                            radioButtons(inputId = "selection",
                                         label = NULL,
                                         choices = c("Choose location" = "location", "Enter postcode" = "postcode"),
                                         selected = "location"),
                            conditionalPanel(
                              condition = "input.selection == 'postcode'",
                              tags$div(class = "div1", textInput("target", label = NULL , width = '105px', placeholder = NULL)),
                              tags$div(class = "div1", actionButton("submit", "", icon("chevron-right")))),
                            tags$br(),
                            tags$div(class = "div2", tags$small("Powered by ", tags$a(href="https://postcodes.io/", "Postcodes.io", target = "_blank")))
                          ),
            ),
            div(
              style = "position: absolute; left: 1.3em; bottom: 4.5em;",
              dropdown(
                includeMarkdown("help.md"),
                icon = icon("circle-info"),
                size = "md",
                style = "jelly",
                width = "300px",
                up = TRUE
              )),
            tags$footer(
              "Developed in ",
              a(href = "https://cran.r-project.org/", target = "_blank", "R"),
              " by the ",
              a(href = "https://www.trafforddatalab.io", target = "_blank", "Trafford Data Lab"),
              " under the ",
              a(href = "https://www.trafforddatalab.io/LICENSE.txt", target = "_blank", "MIT"),
              " licence"
            )))

shinyApp(ui = ui, server = server)