├── GIFs ├── STATS19_scanner.gif ├── brexit.gif └── crime_map.gif ├── LISA └── LISA.Rmd ├── README.md ├── STATS19_scanner ├── README.md ├── STATS19_scanner.Rmd ├── Tidying STATS19 data.R ├── boroughs.csv ├── boroughs.geojson └── casualties_2005-15.Rda ├── brexit ├── README.md ├── brexit.Rmd └── england_wales.geojson └── crime_map ├── README.md ├── about.md ├── app.R ├── boroughs.geojson ├── crime_data.csv ├── custom.css └── dygraph.css /GIFs/STATS19_scanner.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rcatlord/shinyapps/34cad8e8bef6fd8425b13bcc1a85a749631208f7/GIFs/STATS19_scanner.gif -------------------------------------------------------------------------------- /GIFs/brexit.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rcatlord/shinyapps/34cad8e8bef6fd8425b13bcc1a85a749631208f7/GIFs/brexit.gif -------------------------------------------------------------------------------- /GIFs/crime_map.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rcatlord/shinyapps/34cad8e8bef6fd8425b13bcc1a85a749631208f7/GIFs/crime_map.gif -------------------------------------------------------------------------------- /LISA/LISA.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Local Indicators of Spatial Association" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | orientation: rows 6 | vertical_layout: fill 7 | theme: lumen 8 | social: menu 9 | source_code: https://github.com/cat-lord/shinyapps/tree/master/LISA 10 | runtime: shiny 11 | --- 12 | 13 | ```{r setup, include=FALSE} 14 | library(flexdashboard) ; library(shiny); library(shinythemes); library(rgdal) ; library(spdep); library(dplyr) ; library(ggplot2) ; library(leaflet) 15 | 16 | crimes <- read.csv("ward_offences_2014_15.csv", header = T) 17 | category <- as.character(unique(crimes$category)) 18 | wards <- readOGR("wards.geojson", "OGRGeoJSON", verbose = FALSE) 19 | wards.nb <- poly2nb(wards, queen=TRUE) 20 | listw <- nb2listw(wards.nb) 21 | ``` 22 | 23 | Inputs {.sidebar} 24 | ------------------------------------- 25 | 26 |
27 | 28 | This tool visualizes the type and strength of spatial autocorrelation in ward level crime data recorded by the Metropolitan and City of London Police during 2014/15. 29 | 30 |
31 | 32 | **Instructions** 33 | 34 | Select an offence type: 35 | 36 | ```{r} 37 | selectInput(inputId = "selectedCategory", 38 | label = NULL, 39 | choices = category, selected = category[5]) 40 | 41 | selected <- reactive({ 42 | sub <- subset(crimes, category==input$selectedCategory) 43 | wards@data <- left_join(wards@data, sub, by = "GSS_CODE") 44 | wards$count_lag <- lag.listw(listw, wards$count) 45 | count_mean <- mean(wards$count) 46 | count_lag_mean <- mean(wards$count_lag) 47 | global_moran <- moran.test(wards$count, listw) 48 | statistic <- (global_moran$estimate) 49 | statistic <- round(statistic, 2) 50 | lisa <- localmoran(wards$count, listw) 51 | wards$quadrant <- c(rep(0,length(wards$count))) 52 | significance <- 0.05 53 | vec <- ifelse(lisa[,5] < significance, 1,0) 54 | wards$quadrant[wards$count >= count_mean & wards$count_lag >= count_lag_mean] <- 1 55 | wards$quadrant[wards$count < count_mean & wards$count_lag < count_lag_mean] <- 2 56 | wards$quadrant[wards$count < count_mean & wards$count_lag >= count_lag_mean] <- 3 57 | wards$quadrant[wards$count >= count_mean & wards$count_lag < count_lag_mean] <- 4 58 | wards$quadrant.data <- wards$quadrant*vec 59 | wards$quadrant.col[wards$quadrant.data==1] <- "High-High" 60 | wards$quadrant.col[wards$quadrant.data==2] <- "Low-Low" 61 | wards$quadrant.col[wards$quadrant.data==3] <- "Low-High" 62 | wards$quadrant.col[wards$quadrant.data==4] <- "High-Low" 63 | wards$quadrant.col[wards$quadrant.data==0] <- "Non-sig" 64 | wards$fill <- factor(wards$quadrant.data+1) 65 | wards$count_mean <- count_mean 66 | wards$count_lag_mean <- count_lag_mean 67 | wards$statistic <- statistic 68 | wards <- subset(wards, select = c(ward, borough, count, count_lag, quadrant, quadrant.data, 69 | quadrant.col, fill, count_mean, count_lag_mean, statistic)) 70 | }) 71 | ``` 72 | 73 | Then brush the points in the scatter plot to reveal the Local Moran's I values on the map and in a table. A first order, Queen’s contiguity spatial weights matrix was used. 74 | 75 |
76 | 77 | **Credits** 78 | The [spdep()](https://cran.r-project.org/web/packages/spdep/index.html) package was used to calculate the Moran's I values. I found Alessandra Carioli's blog post ["Moran plots in ggplot2"](https://aledemogr.wordpress.com/2015/04/22/moran-plots-in-ggplot2/) particularly helpful for plotting the results. Check [Anselin (1995)](http://onlinelibrary.wiley.com/doi/10.1111/j.1538-4632.1995.tb00338.x/abstract) for more information on LISA maps. 79 | 80 | **Data sources** 81 | London's ward boundary files were downloaded from the [London DataStore](http://data.london.gov.uk/dataset/statistical-gis-boundary-files-london). The police recorded crime data were extracted from the [Metropolitan Police](http://maps.met.police.uk/tables.htm) and [City of London Police](https://www.cityoflondon.police.uk/about-us/performance-and-statistics/Pages/Crime_figures.aspx) websites. Please note that the crime data may not exactly match current published figures. 82 | 83 | 84 | 85 | Row {data-height=650} 86 | ----------------------------------------------------------------------- 87 | 88 | ### 89 | 90 | ```{r} 91 | output$plot <- renderPlot({ 92 | ggplot(selected()@data, aes(count, count_lag)) + 93 | geom_point(aes(fill = selected()$fill), colour="black", size = 3, shape = 21)+ 94 | scale_fill_manual(name="", 95 | values = c("1" = "white", "2" = "red", "3" = "blue", "4" = "cyan", "5" ="pink"), 96 | labels=c("Non-sig", 97 | paste0("High-High (", sum(selected()$quadrant.data==1), ")"), 98 | paste0("Low-Low (", sum(selected()$quadrant.data==2), ")"), 99 | paste0("Low-High (", sum(selected()$quadrant.data==3), ")"), 100 | paste0("High-Low (", sum(selected()$quadrant.data==4), ")"))) + 101 | geom_vline(xintercept = unique(selected()$count_mean), colour = "grey", linetype = "longdash") + 102 | geom_hline(yintercept = unique(selected()$count_lag_mean), colour = "grey", linetype = "longdash") + 103 | stat_smooth(method="lm", se=FALSE, colour = "black", size = 0.5) + 104 | xlab("\nCount of offences per ward") + 105 | ylab("\nLag of offences per ward") + 106 | theme_bw() + 107 | ggtitle(paste0("Moran's I: ", unique(selected()$statistic),"\n")) + 108 | theme(plot.title = element_text(color = "darkorchid")) 109 | }) 110 | 111 | plotOutput("plot", height = 400, brush = brushOpts(id = "plot_brush")) 112 | ``` 113 | 114 | ### 115 | 116 | ```{r} 117 | output$map <- renderLeaflet({ 118 | factpal <- colorFactor(c("#f0f0f0", "red", "blue", "cyan", "pink"), 119 | domain = c("0", "1", "2", "3", "4")) 120 | 121 | popup <- paste0("Ward: ", 122 | selected()$ward, 123 | "
Borough: ", 124 | selected()$borough) 125 | 126 | leaflet() %>% 127 | addProviderTiles("CartoDB.Positron") %>% 128 | setView(-0.112270, 51.498915, 10) %>% 129 | addPolygons(data = selected(), fillColor = ~factpal(quadrant.data), 130 | fillOpacity = 0.7, color = "black", weight = 1, popup = popup) %>% 131 | addLegend(position = "topright", colors = c("#f0f0f0", "red", "blue", "cyan", "pink"), 132 | labels = c("Non-sig", "High-High", "Low-Low", "Low-High", "High-Low"), opacity = 0.7) 133 | }) 134 | 135 | brushed <- eventReactive(input$plot_brush, { 136 | x <- brushedPoints(selected(), input$plot_brush) 137 | }) 138 | 139 | observe({ 140 | req(brushed()) 141 | 142 | leafletProxy('map') %>% 143 | clearGroup(group = 'brushed') %>% 144 | addPolygons(data = brushed(), fill = FALSE, color = '#FFFF00', 145 | opacity = 1, group = 'brushed') 146 | 147 | }) 148 | 149 | leafletOutput("map") 150 | ``` 151 | 152 | Row {data-height=350} 153 | ----------------------------------------------------------------------- 154 | 155 | ### 156 | 157 | ```{r} 158 | output$table <- DT::renderDataTable({ 159 | tbl <- brushed() %>% 160 | as.data.frame() %>% 161 | select(Ward = ward, Borough = borough, Offences = count, LISA = quadrant.col) 162 | 163 | }, rownames = FALSE, options = list(pageLength = 5, dom = 'tip', 164 | autoWidth = TRUE)) 165 | 166 | DT::dataTableOutput("table") 167 | ``` 168 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | shinyapps 2 | ======= 3 | 4 | A collection of some [shiny](http://shiny.rstudio.com) apps that I have developed. 5 | -------------------------------------------------------------------------------- /STATS19_scanner/README.md: -------------------------------------------------------------------------------- 1 | ![STATS19_scanner](https://github.com/rcatlord/shinyapps/blob/master/GIFs/STATS19_scanner.gif) 2 | 3 | ##### Overview 4 | This [Shiny](https://cran.r-project.org/web/packages/shiny/index.html) application is designed to allow the user to interrogate road casualties reported in Greater London between 2005 and 2015. 5 | 6 | ##### Data sources 7 | STATS19 road traffic collision data for Greater London are available from [Transport for London](https://www.tfl.gov.uk/corporate/publications-and-reports/road-safety) and a guide to the variables can be found [here.](https://www.tfl.gov.uk/cdn/static/cms/documents/collision-data-guide.pdf) 8 | 9 | ##### Credits 10 | The [flexdashboard](https://cran.r-project.org/web/packages/flexdashboard/index.html), [leaflet](https://cran.r-project.org/web/packages/leaflet/index.html"), [highcharter](https://cran.r-project.org/web/packages/highcharter/index.html) and [DT](https://cran.r-project.org/web/packages/DT/index.html) R packages were used in this [Shiny](https://cran.r-project.org/web/packages/shiny/index.html) app. Some of the code for the STATS19_scanner was adapted from 11 | [Superzip](http://shiny.rstudio.com/gallery/superzip-example.html) by Joe Cheng. The ui was inspired by [blackspot](http://blackspot.org.uk) by Ben Moore and [Twin Cities Buses](https://gallery.shinyapps.io/086-bus-dashboard/) by Aron Atkins. 12 | 13 |
14 | 15 | The app is available at [https://rcatlord.shinyapps.io/STATS19_scanner](https://rcatlord.shinyapps.io/STATS19_scanner) 16 | -------------------------------------------------------------------------------- /STATS19_scanner/STATS19_scanner.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "STATS19 scanner" 3 | output: 4 | flexdashboard::flex_dashboard: 5 | orientation: rows 6 | vertical_layout: fill 7 | theme: lumen 8 | social: menu 9 | source_code: https://github.com/rcatlord/shinyapps/tree/master/STATS19_scanner 10 | runtime: shiny 11 | --- 12 | 13 | ```{r setup, include=FALSE} 14 | library(flexdashboard) ; library(shiny) ; library(dplyr) ; library(rgdal) ; library(leaflet) ; library(RColorBrewer) ; library(highcharter) ; library(DT) 15 | 16 | data <- readRDS(file="casualties_2005-15.Rda") 17 | data$date <- as.Date(data$date, "%Y-%m-%d") 18 | data$severity <- factor(data$severity, levels= c("Fatal", "Serious", "Slight"), ordered = TRUE) 19 | data$day <- factor(data$day, levels=c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"), ordered=T) 20 | boroughs <- readOGR("boroughs.geojson", "OGRGeoJSON") 21 | ``` 22 | 23 | ```{r reactive} 24 | casualties <- reactive({ 25 | if (is.null(input$borough)) 26 | subset(data, date >= input$date_range[1] & date <= input$date_range[2] & 27 | mode %in% input$mode & 28 | severity %in% input$severity) 29 | else 30 | subset(data, date >= input$date_range[1] & date <= input$date_range[2] & 31 | borough %in% input$borough & 32 | mode %in% input$mode & 33 | severity %in% input$severity) 34 | }) 35 | 36 | dataInBounds <- reactive({ 37 | if (is.null(input$map_bounds)) 38 | return(df[FALSE,]) 39 | bounds <- input$map_bounds 40 | latRng <- range(bounds$north, bounds$south) 41 | lngRng <- range(bounds$east, bounds$west) 42 | 43 | subset(casualties(), 44 | lat >= latRng[1] & lat <= latRng[2] & 45 | long >= lngRng[1] & long <= lngRng[2]) 46 | }) 47 | ``` 48 | 49 | Column {.sidebar} 50 | ----------------------------------------------------------------------- 51 | 52 | ```{r} 53 | dateRangeInput("date_range", 54 | label = "Date range", 55 | start = "2015-01-01", 56 | end = "2015-12-31", 57 | format = "yyyy-mm-dd") 58 | 59 | selectInput("borough", 60 | label = "Borough", 61 | choices = c("All" = "", levels(data$borough)), 62 | multiple = TRUE) 63 | 64 | selectInput("mode", 65 | label = "Mode of travel", 66 | choices = levels(data$mode), 67 | selected = "Pedal Cycle", 68 | multiple = TRUE) 69 | 70 | selectInput("severity", 71 | label = "Casualty severity", 72 | choices = levels(data$severity), 73 | selected = c("Fatal", "Serious", "Slight"), 74 | multiple = TRUE) 75 | ``` 76 | 77 | --- 78 | 79 |
80 | This [Shiny](https://cran.r-project.org/web/packages/shiny/index.html) application is designed to allow the user to interrogate road casualties reported in Greater London between 2005 and 2015. 81 | 82 | **Data sources:** STATS19 collision data for Greater London are available from [Transport for London](https://www.tfl.gov.uk/corporate/publications-and-reports/road-safety) and a guide to the variables can be found [here](https://www.tfl.gov.uk/cdn/static/cms/documents/collision-data-guide.pdf). 83 | 84 | **Credits:** The [flexdashboard](https://cran.r-project.org/web/packages/flexdashboard/index.html), [leaflet](https://cran.r-project.org/web/packages/leaflet/index.html), [highcharter](https://cran.r-project.org/web/packages/highcharter/index.html) and [DT](https://cran.r-project.org/web/packages/DT/index.html) R packages were used in this Shiny app. Some of the code for the STATS19_scanner app was adapted from [Superzip](http://shiny.rstudio.com/gallery/superzip-example.html) by Joe Cheng. The ui was inspired by [blackspot](http://blackspot.org.uk) by Ben Moore and [Twin Cities Buses](https://gallery.shinyapps.io/086-bus-dashboard/) by Aron Atkins. 85 | 86 | **Licence** Contains National Statistics data © Crown copyright and database right [2015] and Contains Ordnance Survey data © Crown copyright and database right [2015]. 87 | 88 | Row {data-height=50} 89 | ----------------------------------------------------------------------- 90 | 91 | ### 92 | ```{r} 93 | renderText({ 94 | df <- dataInBounds() 95 | print(paste0(format(nrow(df), format="d", big.mark=","), " casualties")) 96 | }) 97 | ``` 98 | 99 | ### 100 | ```{r} 101 | renderText({ 102 | df <- dataInBounds() %>% 103 | filter(severity == "Fatal" | severity == "Serious") 104 | print(paste0(format(nrow(df), format="d", big.mark=","), " KSIs")) 105 | }) 106 | ``` 107 | 108 | ### 109 | ```{r} 110 | renderText({ 111 | df <- dataInBounds() %>% 112 | distinct(AREFNO) 113 | print(paste0(format(nrow(df), format="d", big.mark=","), " collisions")) 114 | }) 115 | 116 | ``` 117 | 118 | Row 119 | ----------------------------------------------------------------------- 120 | 121 | ```{r} 122 | pal <- colorFactor(c("#b10026", "#fd8d3c", "#ffeda0"), domain = c("Fatal", "Serious", "Slight"), ordered = TRUE) 123 | 124 | output$map <- renderLeaflet({ 125 | leaflet(data = casualties()) %>% 126 | addProviderTiles("CartoDB.Positron", options = tileOptions(minZoom = 10)) %>% 127 | addPolygons(data = boroughs, fill = F, color = "#636363", weight = 1.5) %>% 128 | addCircleMarkers(data = casualties(), ~long, ~lat, 129 | color = "#636363", stroke = TRUE, weight = 1, 130 | fillColor = ~pal(severity), fillOpacity = 0.8, 131 | radius = 5, popup = ~text) %>% 132 | fitBounds(lng1 = max(casualties()$long), lat1 = max(casualties()$lat), 133 | lng2 = min(casualties()$long), lat2 = min(casualties()$lat)) %>% 134 | addLegend(position = "topright", colors = c("#b10026", "#fd8d3c", "#ffeda0"), 135 | labels = c("Fatal", "Serious", "Slight"), opacity = 1, title = "Severity") 136 | }) 137 | 138 | observe({ 139 | leafletProxy('map', session) %>% 140 | clearMarkers() 141 | }) 142 | 143 | leafletOutput("map") 144 | ``` 145 | 146 | Row {.tabset} 147 | ----------------------------------------------------------------------- 148 | 149 | ### Boroughs 150 | 151 | ```{r} 152 | output$borough_chart <- renderHighchart({ 153 | 154 | df <- dataInBounds() %>% 155 | group_by(borough) %>% 156 | summarise(count = n()) %>% 157 | arrange(desc(count)) 158 | 159 | highchart() %>% 160 | hc_title(text = "Casualties by borough") %>% 161 | hc_xAxis(categories = unique(df$borough)) %>% 162 | hc_add_series(name = "Frequency", data = df$count, type = 'column', color = "#636363") %>% 163 | hc_legend(enabled = FALSE) %>% 164 | hc_add_theme(hc_theme_smpl()) 165 | }) 166 | 167 | highchartOutput('borough_chart') 168 | ``` 169 | 170 | ### Months 171 | 172 | ```{r} 173 | output$month_chart <- renderHighchart({ 174 | 175 | df <- dataInBounds() %>% 176 | group_by(severity, month) %>% 177 | summarise(count = n()) %>% 178 | mutate(month = factor(month.name[month], levels = month.name)) %>% 179 | arrange(month) 180 | 181 | highchart() %>% 182 | hc_title(text = "Casualties by month") %>% 183 | hc_xAxis(categories = unique(df$month)) %>% 184 | hc_add_series(name = "Fatal", data = df[which(df$severity == "Fatal"), ]$count, color = "#b10026") %>% 185 | hc_add_series(name = "Serious", data = df[which(df$severity == "Serious"), ]$count, color = "#fd8d3c") %>% 186 | hc_add_series(name = "Slight", data = df[which(df$severity == "Slight"), ]$count, color = "#ffeda0") %>% 187 | hc_yAxis(title = list(text = ""), labels = list(format = "{value}")) %>% 188 | hc_legend(enabled = FALSE) %>% 189 | hc_add_theme(hc_theme_smpl()) 190 | }) 191 | 192 | highchartOutput('month_chart') 193 | ``` 194 | 195 | ### Hours 196 | 197 | ```{r} 198 | output$hour_chart <- renderHighchart({ 199 | 200 | df <- dataInBounds() %>% 201 | group_by(light, hour) %>% 202 | summarise(count = n()) %>% 203 | mutate(hour = factor(hour)) %>% 204 | arrange(hour) 205 | 206 | highchart() %>% 207 | hc_title(text = "Casualties by hour") %>% 208 | hc_xAxis(categories = unique(df$hour)) %>% 209 | hc_add_series(name = "Dark", data = df[which(df$light == "Dark"), ]$count, type = 'column', color = "midnightblue") %>% 210 | hc_add_series(name = "Daylight", data = df[which(df$light == "Daylight"), ]$count, type = 'column', color = "yellow") %>% 211 | hc_yAxis(title = list(text = ""), labels = list(format = "{value}")) %>% 212 | hc_legend(enabled = FALSE) %>% 213 | hc_add_theme(hc_theme_smpl()) 214 | }) 215 | 216 | highchartOutput('hour_chart') 217 | ``` 218 | 219 | ### Demographics 220 | 221 | ```{r} 222 | output$demog_chart <- renderHighchart({ 223 | 224 | df <- dataInBounds() %>% 225 | group_by(sex, ageband) %>% 226 | summarise(count = n()) %>% 227 | arrange(ageband) %>% 228 | mutate(ageband = as.character(ageband)) %>% 229 | mutate(ageband = replace(ageband, is.na(ageband), "Unknown")) 230 | 231 | highchart() %>% 232 | hc_title(text = "Casualties by ageband and gender") %>% 233 | hc_xAxis(categories = unique(df$ageband)) %>% 234 | hc_add_series(name = "Female", data = df[which(df$sex == "Female"), ]$count, type = 'column', color = "#c2a5cf") %>% 235 | hc_add_series(name = "Male", data = df[which(df$sex == "Male"), ]$count, type = 'column', color = "#a6dba0") %>% 236 | hc_yAxis(title = list(text = ""), labels = list(format = "{value}")) %>% 237 | hc_legend(enabled = FALSE) %>% 238 | hc_add_theme(hc_theme_smpl()) 239 | }) 240 | 241 | highchartOutput('demog_chart') 242 | ``` 243 | 244 | ### Data 245 | 246 | ```{r} 247 | output$table <- DT::renderDataTable({ 248 | 249 | df <- dataInBounds() %>% 250 | select(AREFNO, Date = date, Mode = mode, Severity = severity, Sex = sex, Ageband = ageband) 251 | 252 | }, rownames = FALSE, options = list(pageLength = 5, dom = 'tip', 253 | autoWidth = TRUE, columnDefs = list(list(className = 'dt-left', targets = 0:3)))) 254 | 255 | DT::dataTableOutput("table") 256 | ``` -------------------------------------------------------------------------------- /STATS19_scanner/Tidying STATS19 data.R: -------------------------------------------------------------------------------- 1 | ## Loading and tidying STATS19 data ## 2 | 3 | # STEP 1: load the necessary R packages 4 | library(dplyr) 5 | library(maptools) 6 | 7 | # STEP 2: merging multiple years of casualty data and attendant data 8 | # rbind() is used to match casualty (and attendant) data because the variables are identical between years 9 | 10 | # read the casualty data 11 | casualty_2005 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2005-gla-data-extract-casualty.csv", header=T) 12 | casualty_2006 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2006-gla-data-extract-casualty.csv", header=T) 13 | casualty_2007 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2007-gla-data-extract-casualty.csv", header=T) 14 | casualty_2008 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2008-gla-data-extract-casualty.csv", header=T) 15 | casualty_2009 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2009-gla-data-extract-casualty.csv", header=T) 16 | casualty_2010 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2010-gla-data-extract-casualty.csv", header=T) 17 | casualty_2011 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2011-gla-data-extract-casualty.csv", header=T) 18 | casualty_2012 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2012-gla-data-extract-casualty.csv", header=T) 19 | casualty_2013 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2013-gla-data-extract-casualty.csv", header=T) 20 | casualty_2014 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2014-gla-data-extract-casualty.csv", header=T) 21 | casualty_2015 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2015-gla-data-extract-casualty.csv", header=T) %>% 22 | rename(AREFNO = Accident.Ref.) 23 | 24 | # merge the casualty data 25 | casualty <- do.call(rbind, list(casualty_2005, casualty_2006, casualty_2007, casualty_2008, 26 | casualty_2009, casualty_2010, casualty_2011, casualty_2012, 27 | casualty_2013, casualty_2014, casualty_2015)) 28 | 29 | # remove the redundant dataframes from the R session 30 | rm(casualty_2005, casualty_2006, casualty_2007, casualty_2008, casualty_2009, casualty_2010, 31 | casualty_2011, casualty_2012, casualty_2013, casualty_2014, casualty_2015) 32 | 33 | # read the attendant data 34 | attendant_2005 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2005-gla-data-extract-attendant.csv", header=T) 35 | attendant_2006 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2006-gla-data-extract-attendant.csv", header=T) 36 | attendant_2007 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2007-gla-data-extract-attendant.csv", header=T) 37 | attendant_2008 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2008-gla-data-extract-attendant.csv", header=T) 38 | attendant_2009 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2009-gla-data-extract-attendant.csv", header=T) 39 | attendant_2010 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2010-gla-data-extract-attendant.csv", header=T) 40 | attendant_2011 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2011-gla-data-extract-attendant.csv", header=T) 41 | attendant_2012 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2012-gla-data-extract-attendant.csv", header=T) 42 | attendant_2013 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2013-gla-data-extract-attendant.csv", header=T) 43 | attendant_2014 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2014-gla-data-extract-attendant.csv", header=T) 44 | attendant_2015 <- read.csv("https://tfl.gov.uk/cdn/static/cms/documents/2015-gla-data-extract-attendant.csv", header=T) %>% 45 | rename(AREFNO = Accident.Ref.) 46 | 47 | # merge the attendant data 48 | attendant <- do.call(rbind, list(attendant_2005, attendant_2006, attendant_2007, attendant_2008, 49 | attendant_2009, attendant_2010, attendant_2011, attendant_2012, 50 | attendant_2013, attendant_2014, attendant_2015)) 51 | 52 | # remove the redundant dataframes from the R session 53 | rm(attendant_2005, attendant_2006, attendant_2007, attendant_2008, attendant_2009, attendant_2010, 54 | attendant_2011, attendant_2012, attendant_2013, attendant_2014) 55 | 56 | # STEP 3: merge the attendant and casualty data 57 | # merge() is used so that matching is based on a specific variable 58 | 59 | # merge using the AREFNO variable 60 | casualties <- merge(casualty, attendant, by="AREFNO") 61 | rm(casualty) 62 | rm(attendant) 63 | 64 | # STEP 4: add in borough data 65 | boroughs <- read.csv("boroughs.csv", header = T) 66 | casualties <- merge(casualties, boroughs, "Borough.x") 67 | 68 | # STEP 5: date/time variables 69 | # convert Accident.Date to a date 70 | casualties$Accident.Date <- as.Date(casualties$Accident.Date, "%d-%b-%y") 71 | # extract the year 72 | casualties$year <- format(casualties$Accident.Date, format="%Y") 73 | # extract the month 74 | casualties$month <- format(casualties$Accident.Date, format="%B") 75 | casualties$month <- as.factor(casualties$month) 76 | casualties$month <- factor(casualties$month,levels=month.name) 77 | # extract the day of the week 78 | casualties$day <- format(casualties$Accident.Date, format="%A") 79 | casualties$day <- factor(casualties$day, levels=c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday"), 80 | labels=c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday")) 81 | # add an hour band variable 82 | casualties$Time <- gsub("[ [:punct:]]", "" , casualties$Time) 83 | casualties$Time <- gsub("(\\d\\d)(\\d\\d)", "\\1:\\2", casualties$Time) 84 | casualties$hour<- as.POSIXlt(casualties$Time, format="%H:%M")$hour 85 | 86 | # STEP 6: factor variables 87 | # relabel the 'Casualty.Severity' categories 88 | casualties$Casualty.Severity <- factor(casualties$Casualty.Severity, 89 | levels= c("1 Fatal", "2 Serious", "3 Slight"), 90 | labels= c("Fatal", "Serious", "Slight")) 91 | # relabel the 'Mode.of.Travel' categories 92 | casualties$Mode.of.Travel <- factor(casualties$Mode.of.Travel, 93 | levels= c("1 Pedestrian", "2 Pedal Cycle", "3 Powered 2 Wheeler", "4 Car", 94 | "5 Taxi", "6 Bus Or Coach", "7 Goods Vehicle", "8 Other Vehicle"), 95 | labels= c("Pedestrian", "Pedal Cycle", "Powered 2 Wheeler", "Car", 96 | "Taxi", "Bus or Coach", "Goods Vehicle", "Other Vehicle")) 97 | # relabel the 'Casualty.Sex' categories 98 | casualties$Casualty.Sex <- factor(casualties$Casualty.Sex, 99 | levels= c("1 Male", "2 Female"), 100 | labels= c("Male", "Female")) 101 | # relabel the 'Light.Conditions..Banded.' categories 102 | casualties$Light.Conditions..Banded. <- factor(casualties$Light.Conditions..Banded., 103 | levels= c("1 Daylight", "2 Dark"), 104 | labels= c("Daylight", "Dark")) 105 | 106 | # recode 'Casualty.Age' as NA when 'Casualty.Age..Banded.' is Unknown 107 | casualties$Casualty.Age[casualties$Casualty.Age == 0 & casualties$Casualty.Age..Banded. == "Unknown"] <- NA 108 | 109 | # create age bands 110 | bands <- c("0-4","5-9","10-14","15-19","20-24","25-29","30-34","35-39", 111 | "40-44","45-49","50-54","55-59","60-64","65-69","70-74","75-79","80-84") 112 | casualties$ageband <- cut(casualties$Casualty.Age, 113 | breaks=c(0,4,9,14,19,24,29,34,39,44,49,54,59,64,69,74,79,84), 114 | labels = bands) 115 | # add a text variable 116 | casualties$Accident.Severity <- factor(casualties$Accident.Severity, 117 | levels= c("1 Fatal", "2 Serious", "3 Slight"), 118 | labels= c("Fatal", "Serious", "Slight")) 119 | casualties_desc <- function(row) 120 | with(as.list(row), paste0("At ", (Time), " on ", format.Date(Accident.Date, "%A %d %B %Y"), 121 | " a ", tolower(Accident.Severity), 122 | " collision occured involving ", (No..of.Vehicles.in.Acc.), " vehicle(s) and ", 123 | (No..of.Casualties.in.Acc.), " casualtie(s).")) 124 | strs <- apply(casualties, 1, casualties_desc) 125 | names(strs) <- NULL 126 | casualties$text <- strs 127 | 128 | # STEP 7: selecting and renaming variables 129 | casualties <- casualties %>% 130 | select(AREFNO, 131 | date = Accident.Date, 132 | year, month, day, hour, 133 | mode = Mode.of.Travel, 134 | severity = Casualty.Severity, 135 | light = Light.Conditions..Banded., 136 | sex = Casualty.Sex, ageband, 137 | borough = NAME, GSS_CODE, 138 | easting = Easting.x, northing = Northing.x, 139 | text) 140 | 141 | # STEP 8: tidying spatial data 142 | # convert the casualties into a SpatialPointsDataFrame 143 | coords <- SpatialPoints(casualties[,c("easting","northing")]) 144 | casualties_pts <- SpatialPointsDataFrame(coords,casualties) 145 | proj4string(casualties_pts) <- CRS("+init=epsg:27700") 146 | # convert to long, lat 147 | casualties_pts <- spTransform(casualties_pts, CRS("+init=epsg:4326")) 148 | # convert the SpatialPointsDataFrame back to a dataframe 149 | casualties <- as.data.frame(casualties_pts) 150 | # rename long, lat 151 | casualties <- casualties %>% 152 | select(everything(), 153 | long = easting.1, lat = northing.1) 154 | 155 | # STEP 9: export 156 | saveRDS(casualties, file="casualties_2005-145.Rda") -------------------------------------------------------------------------------- /STATS19_scanner/boroughs.csv: -------------------------------------------------------------------------------- 1 | NAME,Borough.x,GSS_CODE 2 | Barking and Dagenham,BARKING & DAGENHAM,E09000002 3 | Barnet,BARNET,E09000003 4 | Bexley,BEXLEY,E09000004 5 | Brent,BRENT,E09000005 6 | Bromley,BROMLEY,E09000006 7 | Camden,CAMDEN,E09000007 8 | City of London,CITY OF LONDON,E09000001 9 | Croydon,CROYDON,E09000008 10 | Ealing,EALING,E09000009 11 | Enfield,ENFIELD,E09000010 12 | Greenwich,GREENWICH,E09000011 13 | Hackney,HACKNEY,E09000012 14 | Hammersmith and Fulham,HAMMERSMITH & FULHAM,E09000013 15 | Haringey,HARINGEY,E09000014 16 | Harrow,HARROW,E09000015 17 | Havering,HAVERING,E09000016 18 | Hillingdon,HILLINGDON,E09000017 19 | Hounslow,HOUNSLOW,E09000018 20 | Islington,ISLINGTON,E09000019 21 | Kensington and Chelsea,KENSINGTON & CHELSEA,E09000020 22 | Kingston upon Thames,KINGSTON-UPON-THAMES,E09000021 23 | Lambeth,LAMBETH,E09000022 24 | Lewisham,LEWISHAM,E09000023 25 | Merton,MERTON,E09000024 26 | Newham,NEWHAM,E09000025 27 | Redbridge,REDBRIDGE,E09000026 28 | Richmond upon Thames,RICHMOND-UPON-THAMES,E09000027 29 | Southwark,SOUTHWARK,E09000028 30 | Sutton,SUTTON,E09000029 31 | Tower Hamlets,TOWER HAMLETS,E09000030 32 | Waltham Forest,WALTHAM FOREST,E09000031 33 | Wandsworth,WANDSWORTH,E09000032 34 | Westminster,WESTMINSTER,E09000033 -------------------------------------------------------------------------------- /STATS19_scanner/casualties_2005-15.Rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rcatlord/shinyapps/34cad8e8bef6fd8425b13bcc1a85a749631208f7/STATS19_scanner/casualties_2005-15.Rda -------------------------------------------------------------------------------- /brexit/README.md: -------------------------------------------------------------------------------- 1 | ![brexit](https://github.com/rcatlord/shinyapps/blob/master/GIFs/brexit.gif) 2 | 3 | ##### Overview 4 | This [shiny](http://shiny.rstudio.com) app uses voting data from [The Electoral Commission](http://www.electoralcommission.org.uk/find-information-by-subject/elections-and-referendums/upcoming-elections-and-referendums/eu-referendum/electorate-and-count-information) to explore the relationship between the votes cast during the EU Referendum (23 June 2016) and immigration levels by local authority. The app was inspired by a recent article in [theconversation.com/uk](http://theconversation.com/uk) called ['Hard Evidence: how areas with low immigration voted mainly for Brexit'](http://theconversation.com/hard-evidence-how-areas-with-low-immigration-voted-mainly-for-brexit-62138) 5 | 6 | ##### Credits 7 | [Plotly's](https://plot.ly/r/) R graphing library, [Leaflet](https://rstudio.github.io/leaflet/), [formattable](https://github.com/renkun-ken/formattable) and [flexdashboard](http://rmarkdown.rstudio.com/flexdashboard/) were used in this [shiny](http://shiny.rstudio.com") app. Code was borrowed and adapted from Kyle Walker's wonderful [shiny app of neighborhood diversity](https://walkerke.shinyapps.io/neighborhood_diversity/). 8 | 9 | ##### Licence 10 | The local authority vector boundaries for England and Wales were published by the Office for National Statistics and are available from [here](https://geoportal.statistics.gov.uk/geoportal/catalog/content/filelist.page?&pos=3&cat=#BD). This information is licensed under the terms of the [Open Government Licence](http://www.nationalarchives.gov.uk/doc/open-government-licence/version/3). 11 | 12 |
13 | 14 | The app is available at [https://rcatlord.shinyapps.io/brexit](https://pracademic.shinyapps.io/brexit) 15 | -------------------------------------------------------------------------------- /brexit/brexit.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "brexit app" 3 | resource_files: 4 | - england_wales.cpg 5 | - england_wales.dbf 6 | - england_wales.prj 7 | - england_wales.qpj 8 | - england_wales.shp 9 | - england_wales.shx 10 | runtime: shiny 11 | output: 12 | flexdashboard::flex_dashboard: 13 | orientation: rows 14 | social: menu 15 | source_code: https://github.com/cat-lord/shinyapps/tree/master/brexit 16 | theme: yeti 17 | --- 18 | 19 | ```{r setup, include=FALSE} 20 | 21 | library(flexdashboard) ; library(rgdal) ; library(sp) ; library(dplyr) ; library(shiny) ; library(leaflet) ; library(RColorBrewer) ; library(plotly) ; library(ggplot2) ; library(formattable) 22 | 23 | boundaries <- readOGR("england_wales.geojson", "OGRGeoJSON", verbose = FALSE) 24 | 25 | df <- data.frame(Area = c("England & Wales", ""), 26 | Region = c("",""), 27 | Electorate = c("41,227,815", ""), 28 | Leave = c(round(sum(boundaries$Leave) / sum(boundaries$Vts_Cst) * 100, 1), ""), 29 | Remain = c(round(sum(boundaries$Remain) / sum(boundaries$Vts_Cst) * 100, 1), ""), 30 | Turnout = c(round(sum(boundaries$Vts_Cst) / sum(boundaries$Electrt) * 100, 1), ""), 31 | Result = c("Leave", "")) %>% 32 | rename(`Leave (%)` = Leave, `Remain (%)` = Remain, `Turnout (%)` = Turnout) 33 | ``` 34 | 35 | Inputs {.sidebar data-width=400 data-padding=10} 36 | ------------------------------------- 37 | 38 |
39 | 40 | This app is designed to allow users to explore the relationship between levels of immigration - measured as the percentage of residents born outside the UK - and the results of the EU referendum on 23 June 2016. 41 | 42 | **Instructions** 43 | Use the lasso tool on the scatterplot to render corresponding local authorities on the map. Then click an area to reveal the referendum results for that specific local authority in the table at the bottom of the screen. 44 | 45 | **Credits** 46 | This app was inspired by an article in [theconversation.com](http://theconversation.com/uk) called ['Hard Evidence: how areas with low immigration voted mainly for Brexit'](http://theconversation.com/hard-evidence-how-areas-with-low-immigration-voted-mainly-for-brexit-62138) and by Kyle Walker's Shiny [app on neighborhood diversity](https://github.com/walkerke/neighborhood_diversity). 47 | 48 | **Data sources** 49 | 50 | - [EU referendum results](http://www.electoralcommission.org.uk/__data/assets/file/0014/212135/EU-referendum-result-data.csv) 51 | - [Population data from the 2011 Census](http://www.ons.gov.uk/ons/rel/census/2011-census/key-statistics-for-unitary-authorities-in-wales/rft-table-ks204ew.xls) 52 | - [Boundary layers](https://geoportal.statistics.gov.uk/geoportal/catalog/content/filelist.page?&pos=3&cat=#BD) 53 | 54 | 55 | Row {data-height=800} 56 | ----------------------------------------------------------------------- 57 | ### 58 | 59 | ```{r} 60 | 61 | # Here, we draw the diversity gradient with ggplotly 62 | output$scatter <- renderPlotly({ 63 | 64 | key <- boundaries$Area_Cd 65 | 66 | plot <- ggplot(boundaries@data) + 67 | geom_point(alpha = 0.4, aes(Non.UK, Pct_Lev, key = key)) + 68 | theme_minimal() + 69 | stat_smooth(aes(Non.UK, Pct_Lev), color = '#045a8d', method = 'loess', se = FALSE) + 70 | geom_vline(xintercept = 13.3, colour = '#045a8d') + geom_hline(yintercept = 50, colour = '#045a8d') + 71 | xlab('% of non-UK born residents (2011 Census)') + 72 | ylab('% of Leave votes') 73 | 74 | g <- ggplotly(plot, source = 'source') %>% 75 | layout(dragmode = 'lasso', 76 | margin = list(l = 100), 77 | font = list(family = 'Arial', size = 12)) 78 | 79 | # Need to manually set the hoverinfo to avoid the key appearing in it 80 | build <- plotly_build(g) 81 | 82 | build$data[[1]]$text <- paste0('Local authority: ', as.character(boundaries$Area),'
', 83 | 'Leave votes (%): ', as.character(round(boundaries$Pct_Lev, 1)), '
', 84 | 'non-UK residents (%): ', as.character(round(boundaries$Non.UK, 1))) 85 | 86 | build 87 | 88 | }) 89 | 90 | plotlyOutput('scatter') 91 | ``` 92 | 93 | ### 94 | 95 | ```{r} 96 | 97 | sub <- reactive({ 98 | eventdata <- event_data('plotly_selected', source = 'source') 99 | if (is.null(eventdata)) { 100 | return(NULL) 101 | } else { 102 | areas <- eventdata[['key']] 103 | if (length(areas) == 0) { 104 | areas <- 'nowhere' 105 | } 106 | if (!(areas %in% boundaries$Area_Cd)) { 107 | return(NULL) 108 | } else { 109 | sub <- boundaries[boundaries$Area_Cd %in% areas, ] 110 | return(sub) 111 | } 112 | } 113 | }) 114 | 115 | 116 | output$map <- renderLeaflet({ 117 | 118 | pal <- colorFactor(c("#80b1d3", "#ffffb3"), domain = c("Leave", "Remain")) 119 | 120 | if(is.null(sub())) {leaflet() %>% 121 | addProviderTiles('CartoDB.Positron') %>% 122 | addPolygons(data = boundaries, color = "#969696", weight = 1, 123 | fillColor = ~pal(Result), fillOpacity = 0.5, layerId = ~Area_Cd) %>% 124 | addLegend(position = "topright", colors = c("#ffffb3", "#80b1d3"), 125 | labels = c("Majority Remain", "Majority Leave"), opacity = 1)} 126 | else { 127 | leaflet(data = sub() ) %>% 128 | addProviderTiles('CartoDB.Positron') %>% 129 | addPolygons(data = boundaries, color = "#969696", weight = 1, 130 | fillColor = ~pal(Result), fillOpacity = 0.5, layerId = ~Area_Cd) %>% 131 | addPolygons(data = sub(), stroke = TRUE, color = '#525252', opacity = 1, weight = 1, 132 | fillColor = "white", fillOpacity = 1, 133 | layerId = ~Area_Cd) %>% 134 | fitBounds(lng1 = bbox(sub())[1], 135 | lat1 = bbox(sub())[2], 136 | lng2 = bbox(sub())[3], 137 | lat2 = bbox(sub())[4]) %>% 138 | addLegend(position = "topright", colors = c("#ffffb3", "#80b1d3"), 139 | labels = c("Majority Remain", "Majority Leave"), opacity = 1) 140 | } 141 | }) 142 | 143 | click_area <- eventReactive(input$map_shape_click, { 144 | x <- input$map_shape_click 145 | y <- x$id 146 | return(y) 147 | }) 148 | 149 | observe({ 150 | 151 | req(click_area()) 152 | 153 | map <- leafletProxy('map') %>% 154 | removeShape('highlighted') %>% 155 | addPolygons(data = boundaries[boundaries$Area_Cd == click_area(), ], fill = FALSE, 156 | color = 'red', opacity = 1, layerId = 'highlighted') 157 | 158 | }) 159 | 160 | click_area_data <- reactive({ 161 | return(boundaries@data[boundaries@data$Area_Cd == click_area(), ]) %>% 162 | select(Area, Region, 163 | Electorate = Electrt, 164 | `Leave (%)` = Pct_Lev, 165 | `Remain (%)` = Pct_Rmn, 166 | `Turnout (%)` = Pct_Trn, 167 | Result) %>% 168 | mutate(Electorate = format(Electorate, big.mark=",", scientific=FALSE), 169 | `Leave (%)` = round(`Leave (%)`, 1), 170 | `Remain (%)` = round(`Remain (%)`, 1), 171 | `Turnout (%)` = round(`Turnout (%)`, 1)) 172 | }) 173 | 174 | leafletOutput('map') 175 | ``` 176 | 177 | Row {data-height=80} 178 | ----------------------------------------------------------------------- 179 | 180 | ### 181 | 182 | ```{r} 183 | output$table <- renderFormattable({ 184 | if(is.null(input$map_shape_click)) { 185 | formattable(df[1,]) 186 | } else{ 187 | formattable(click_area_data()) 188 | } 189 | 190 | }) 191 | 192 | formattableOutput('table') 193 | ``` 194 | -------------------------------------------------------------------------------- /crime_map/README.md: -------------------------------------------------------------------------------- 1 | ![crime_map](https://github.com/rcatlord/shinyapps/blob/master/GIFs/crime_map.gif) 2 | 3 | ##### Overview 4 | This [shiny](http://shiny.rstudio.com) app enables users to interrogate open source police crime data recorded by Greater Manchester Police. 5 | 6 | ##### Data sources 7 | Greater Manchester Police recorded crime are available from [data.police.uk](https://data.police.uk/). The data are subject to an anonymisation process which means that crimes are geocoded to approximate not actual locations. For more information visit: [https://data.police.uk/about/#anonymisation](https://data.police.uk/about/#anonymisation) 8 | 9 | ##### Credits 10 | The [leaflet](https://rstudio.github.io/leaflet/) and [dygraphs](https://rstudio.github.io/dygraphs/) R packages were used in this [shiny](http://shiny.rstudio.com") app. 11 | 12 | ##### Licence 13 | The vector boundaries for Greater Manchester's metropolitan districts were published by the Office for National Statistics and are available from [data.gov.uk](https://data.gov.uk/dataset/county-and-unitary-authorities-ew-2012-boundaries-full-extent). This information is licensed under the terms of the [Open Government Licence](http://www.nationalarchives.gov.uk/doc/open-government-licence/version/3). 14 | 15 | ***** 16 | 17 | *To run the app locally just execute the following R code:* 18 | 19 | ``` r 20 | install.packages(c("shiny", "sp", "rgdal", "leaflet", "dygraphs", "xts", "tidyverse", "markdown")) 21 | shiny::runGitHub("rcatlord/shinyapps", subdir = "crime_map") 22 | ``` 23 | -------------------------------------------------------------------------------- /crime_map/about.md: -------------------------------------------------------------------------------- 1 | --- 2 | title: "about" 3 | output: 4 | html_document: 5 | highlight: monochrome 6 | theme: spacelab 7 | --- 8 | 9 |
10 | 11 | #### Overview 12 | This [shiny](http://shiny.rstudio.com) app enables users to interrogate open source police crime data recorded by Greater Manchester Police during 2015. 13 | 14 | #### Data sources 15 | Greater Manchester Police recorded crime are available from [data.police.uk](https://data.police.uk/). The data are subject to an anonymisation process which means that crimes are geocoded to approximate not actual locations. For more information visit: [https://data.police.uk/about/#anonymisation](https://data.police.uk/about/#anonymisation) 16 | 17 | #### Credits 18 | The [leaflet](https://rstudio.github.io/leaflet/) and [dygraphs](https://rstudio.github.io/dygraphs/) R packages were used in this [shiny](http://shiny.rstudio.com") app. 19 | 20 | #### Licence 21 | The vector boundaries for Greater Manchester's metropolitan districts were published by the Office for National Statistics and are available from [data.gov.uk](https://data.gov.uk/dataset/county-and-unitary-authorities-ew-2012-boundaries-full-extent). This information is licensed under the terms of the [Open Government Licence](http://www.nationalarchives.gov.uk/doc/open-government-licence/version/3). 22 | 23 | #### Code 24 | The GitHub respository containing the R code, crime data and vector boundaries can be found [here](https://github.com/cat-lord/shinyapps/tree/master/crime_map). 25 | 26 | 27 | 28 | 29 | 30 | -------------------------------------------------------------------------------- /crime_map/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) ; library(sp); library(rgdal) ; library(leaflet) ; library(dygraphs) ; library(xts) ; library(dplyr) ; library(markdown) 2 | 3 | crimes <- read.csv("crime_data.csv", header = T) 4 | boroughs <- readOGR("boroughs.geojson", "OGRGeoJSON") 5 | 6 | ui <- navbarPage(title = "Crime map", 7 | tabPanel("Interactive plots", tags$head( 8 | tags$style("body {background-color: #bdbdbd; }")), 9 | column(3, 10 | div(class="outer", 11 | tags$head(includeCSS('custom.css')), 12 | absolutePanel(id = "controls", class="panel panel-default", draggable = FALSE, fixed = TRUE, 13 | top = 95, left = 80, right = "auto", bottom = "auto", height = "auto", width = 300, 14 | h3("Instructions"), 15 | p('This ', a('shiny', href = 'http://shiny.rstudio.com'), 'app allows you to interactively visualise 16 | crime recorded by Greater Manchester Police which were downloaded from', a('data.police.uk', href = 'https://data.police.uk')), 17 | p('Use the dropdown menus below to select the borough and crime category 18 | of interest.'), 19 | p('Then zoom and pan around the map to explore clusters of crime. Click on 20 | the red circles for information on individual crimes.'), 21 | p('The map will also update when you interact with the time series chart.'), 22 | hr(), 23 | div(uiOutput('borough'), style = "color:#525252", align = "left"), 24 | div(uiOutput('category'), style = "color:#525252", align = "left")))), 25 | column(7, offset = 1, 26 | br(), 27 | div(h4(textOutput("title"), align = "left"), style = "color:#f0f0f0"), 28 | fluidRow( 29 | leafletOutput("map", width = "100%", height = "400"), 30 | absolutePanel(id = "controls", class="panel panel-default", draggable = TRUE, fixed = TRUE, 31 | top = 160, left = "auto", right = 160, bottom = "auto", height = "20", width = "220", 32 | strong(textOutput("frequency"), style = "color:red", align = "left"))), 33 | fluidRow( 34 | br(), 35 | dygraphOutput("dygraph", width = "100%", height = "130px")))), 36 | tabPanel("About", 37 | fluidRow( 38 | column(8, offset = 1, 39 | includeMarkdown("about.md"), style = "color:#f0f0f0")))) 40 | 41 | server <- function(input, output, session) { 42 | 43 | output$borough <- renderUI({ 44 | selectInput("borough", label = "Select a borough", 45 | choices = levels(droplevels(crimes$borough)), 46 | selected = "Manchester") 47 | }) 48 | 49 | output$category <- renderUI({ 50 | selectInput("category", label = "Select a crime category", 51 | choices = levels(droplevels(crimes$category)), 52 | selected = "Burglary") 53 | }) 54 | 55 | selected_crimes <- reactive({crimes %>% 56 | filter(borough == input$borough & category == input$category)}) 57 | 58 | output$title <- renderText({ 59 | req(input$dygraph_date_window[[1]]) 60 | paste0(input$category, " in ", input$borough, " between ", strftime(input$dygraph_date_window[[1]], "%B %Y"), " and ", 61 | strftime(input$dygraph_date_window[[2]], "%B %Y")) 62 | }) 63 | 64 | output$dygraph <- renderDygraph({ 65 | req(input$category) 66 | df <- selected_crimes() %>% 67 | mutate(date = as.Date(date, format = '%Y-%m-%d')) %>% 68 | group_by(date) %>% 69 | summarize(n = n()) %>% 70 | select(date, n) 71 | 72 | df.xts <- xts(df$n, order.by = as.Date(df$date, "%Y-%m-%d"), frequency = 12) 73 | 74 | dygraph(df.xts, main = NULL) %>% 75 | dySeries("V1", label = "Crimes", color = "white", fillGraph = TRUE, strokeWidth = 2, drawPoints = TRUE, pointSize = 4) %>% 76 | dyAxis("y", axisLabelWidth = 20) %>% 77 | dyOptions(retainDateWindow = TRUE, includeZero = TRUE, drawGrid = FALSE, 78 | axisLineWidth = 2, axisLineColor = "#f0f0f0", axisLabelFontSize = 11, axisLabelColor = "#f0f0f0") %>% 79 | dyCSS("dygraph.css") 80 | }) 81 | 82 | points <- reactive({crimes %>% 83 | mutate(date = as.Date(date, format = '%Y-%m-%d')) %>% 84 | filter(borough == input$borough & 85 | category == input$category & 86 | date >= input$dygraph_date_window[[1]], date <= input$dygraph_date_window[[2]]) 87 | 88 | }) 89 | 90 | output$map <- renderLeaflet({ 91 | req(input$borough) 92 | 93 | boundary <- boroughs[boroughs$CTYUA12NM == input$borough,] 94 | bb <- as.vector(boundary@bbox) 95 | 96 | leaflet(boroughs) %>% 97 | addProviderTiles("CartoDB.Positron") %>% 98 | fitBounds(bb[1], bb[2], bb[3], bb[4]) %>% 99 | addPolygons(data = boroughs, color = "#525252", weight = 2, fillColor = "transparent") 100 | }) 101 | 102 | observe({ 103 | req(input$dygraph_date_window[[1]]) 104 | 105 | popup <- paste0("Location: ", points()$location, 106 | "
Borough: ", points()$borough, 107 | "
Category: ", points()$category, 108 | "
Date: ", points()$date) 109 | 110 | leafletProxy("map", data = points()) %>% 111 | clearMarkerClusters() %>% 112 | addCircleMarkers(data = points(), ~long, ~lat, radius = 5, stroke = TRUE, 113 | color = "red", weight = 3, opacity = 0.8, fillColor = "white", 114 | popup = popup, 115 | clusterOptions = markerClusterOptions( 116 | # zoom to cluster bounds when clicked 117 | zoomToBoundsOnClick = TRUE, 118 | # render cluster markers when lowest zoom level clicked 119 | spiderfyOnMaxZoom = TRUE, 120 | # maximum cluster radius in pixels from central marker 121 | maxClusterRadius = 50)) 122 | }) 123 | 124 | 125 | dataInBounds <- reactive({ 126 | df <- points() 127 | if (is.null(input$map_bounds)) 128 | return(df[FALSE,]) 129 | bounds <- input$map_bounds 130 | latRng <- range(bounds$north, bounds$south) 131 | lngRng <- range(bounds$east, bounds$west) 132 | 133 | subset(df, 134 | lat >= latRng[1] & lat <= latRng[2] & 135 | long >= lngRng[1] & long <= lngRng[2]) 136 | }) 137 | 138 | output$frequency <- renderText({ 139 | req(input$map_bounds) 140 | 141 | df <- dataInBounds() %>% 142 | group_by(category) %>% 143 | summarize(n = n()) 144 | 145 | paste0(df$n, " crimes displayed") 146 | }) 147 | 148 | } 149 | 150 | shinyApp(ui, server) -------------------------------------------------------------------------------- /crime_map/custom.css: -------------------------------------------------------------------------------- 1 | #controls { 2 | /* Appearance */ 3 | background-color: white; 4 | padding: 0 20px 20px 20px; 5 | cursor: move; 6 | /* Fade out while not hovering */ 7 | opacity: 0.65; 8 | zoom: 0.9; 9 | transition: opacity 500ms 1s; 10 | } 11 | #controls:hover { 12 | /* Fade in while hovering */ 13 | opacity: 0.95; 14 | transition-delay: 0; 15 | } -------------------------------------------------------------------------------- /crime_map/dygraph.css: -------------------------------------------------------------------------------- 1 | .dygraph-legend { 2 | color: #636363; 3 | font-weight: bold; 4 | background: transparent !important; 5 | } --------------------------------------------------------------------------------