---
title: "Patients Discharged from Psychiatric Hospitals in Scotland, 2002-2020"
output:
flexdashboard::flex_dashboard:
orientation: row
vertical_layout: fill
social: ["menu"]
source_code: embed
theme:
version: 4
---
<style>
.value-box .value {
color: white;
}
.value-box .icon .fa {
color: white;
}
#number-of-datapoints .inner .caption {
color: white;
font-weight: 500;
}
.navbar.navbar-inverse {
font-size: 1rem;
font-weight: 400;
font-family: Roboto;
background-color: #5D085D !important;
}
.nav-tabs-custom .nav-tabs li.active a {
font-size: 1rem;
font-weight: 400;
font-family: Roboto;
color: #5D085D;
}
.nav-tabs-custom .nav-tabs li:not(.active) a {
font-family: Roboto;
font-size: 1rem;
font-weight: 600;
color: #758A0C;
}
.section.sidebar {
background-color: white;
}
p {
font-family: Roboto;
font-size: 1rem;
}
</style>
```{r setup, include=FALSE}
# Based on a YouTube tutorial by Maj Daniel Baller: https://www.youtube.com/watch?v=Opa_Nf88mCU
# See also GitHub repository: https://github.com/danielpballer/Advanced_Dashboarding_in_R
library(flexdashboard)
library(ggplot2) # plots and charts
library(plotly) # interactive plots and charts
library(tidyverse)
library(sf) # geospatial data
library(classInt) # creating classes of data
library(DT) # create data tables
library(trelliscopejs)
```
```{r load-data, include=FALSE}
hospital <- read.csv("./data/all_data.csv")
```
```{r clean-data, include=FALSE}
# Format the text in the period column to show just the year ranges without the additional text:
hospital$period <- gsub(" financial years; 3-year aggregates", "", hospital$period)
# Then replace the forward slash (/) with a hyphen (-)
hospital$period <- gsub ("/", "-", hospital$period)
# Subset data to create a smaller dataframe of all rows, and columns 2 to 8 inclusive.
hospital_subset <- hospital[, 2:8]
# Change 'period' to factor to ensure it renders correctly on graphs and charts
hospital_subset$period <- factor(hospital_subset$period)
# Change quintile and geography_code to factors
hospital_subset$quintile <- factor(hospital_subset$quintile)
hospital_subset$geography_code <- factor(hospital_subset$geography_code)
```
```{r mapping-prep, include=FALSE}
# One approach is to filter the appropriate factor levels from 'quintile'
quint_diff <- hospital_subset %>%
filter(quintile %in% c("1 - most deprived", "5 - least deprived"))
# View the first few rows to check all is ok
head(quint_diff)
# Then reshape the data and carry out the calculation before returning the data to 'long', or tidy format:
deprivation_diff <- pivot_wider(data = quint_diff, # Create a new variable, using the filtered data from the previous step
id_cols = c(geography_code, period), # Specify the columns to be reshaped
names_from = quintile, # Select the names of the factor levels to be new columns
values_from = indicator_measure) %>% # Apply the appropriate values to their quintiles
mutate(diff = `1 - most deprived` - `5 - least deprived`) %>% # Create a new column called 'diff', subtracting the indicator_measure of quintile 5 from quintile 1
pivot_longer(cols = c('1 - most deprived', '5 - least deprived'), # Reshape the data into tidy format by returning the quintiles to one column
names_to = "quintile", # Restore the original name
values_to = "indicator_measure") # Restore values to their respective levels in the quintile column
# Read the shapefile into R with the following code (this may not work in RMarkdown due to errors with the shapefile, but it executes from the console)
scotland_map <- st_read(dsn = "Local_Authority_Boundaries_-_Scotland", "pub_las")
# Join the shapefile to the hospitalisation data
# Create a new object and merge the data on column 'code' from the scotland_map shapefile just created and 'geography code' from the deprivation_diff dataset
map_data_depdiff <- merge(scotland_map, deprivation_diff, by.x = "code", by.y = "geography_code")
# Select the most recent set of data
map_2020 <- map_data_depdiff %>%
filter(period == "2017-18 to 2019-20")
# Create breaks in the data using classIntervals function, and specifying the diff variable and rounding, number of breaks, and the method by which this information is to be interpreted by ggplot
# Nine breaks are to be used
breaks_qt_2020 <- classIntervals(c(min(map_2020$diff) - .0001, map_2020$diff), n = 9, style = "quantile")
# Add these breaks to the mapping object combining the shapefile and hospitalisation dataset
quantile_breaks_2020 <- mutate(map_2020, diff_cat = cut(diff, breaks_qt_2020$brks))
```
Maps and charts {data-navmenu="Pages"}
======
Sidebar {.sidebar}
------
{width=50%}
### Data Summary
Data from the Scottish Public Health Observatory showing people discharged from psychiatric hospitals in Scotland between 2002 and 2020, presented as a 3-year rolling average, and linked to Scottish Index of Multiple Deprivation.
Number of datapoints `r nrow(hospital_subset)`
Row
------
### Number of datapoints
```{r valuebox}
valueBox(nrow(hospital_subset),
icon = "fa-hospital",
color = "#758A0C") # Background colour for the value box
```
Column {.tabset}
-----------------------------------------------------------------------
### Map: Psychiatric patient hospital discharges in Scotland attributable to deprivation, 2017-18 to 2019-2020
```{r map-plotting}
# Plot the data onto a map using the object just created
# Use geom_sf to plot the shapefile and use the breaks specified in previous steps to categorise the council areas and use the correct colour based on the differences between quintiles 1 and 5
# A palette of blues, useful for colour-blindness, is used to colour the areas of the map according to the breaks
# Legend labels have been changed from the breaks values to something easier to interpret
# Similar theme formatting has been applied
hosp_map = ggplot(quantile_breaks_2020) +
geom_sf(aes(fill = diff_cat), lwd = 0.05, color = "black") +
labs(caption = "Source: Scottish Public Health Observatory 2021",
fill = "Deprivation categories") +
scale_fill_brewer(palette = "Purples",
labels = c("1 - least deprivation", "2", "3", "4", "5", "6", "7", "8", "9 - most deprivation")) +
theme_bw() +
theme(panel.background = element_blank(), # Removes background colour
panel.border = element_blank(), # Removes the borders
panel.grid.major = element_blank(), # Removes the gridlines
plot.subtitle = element_text(size = 10, vjust = 1, lineheight = 1.5),
plot.caption = element_text(size = 8, vjust = -1, hjust = 0),
legend.title = element_text(size = 8),
legend.text = element_text(size = 6),
legend.key.height = unit(0.25, "cm"),
legend.key.width = unit(0.25, "cm"),
axis.text.x = element_blank(), # Removes the latitude/ longitude
axis.text.y = element_blank(), # Removes the latitude/ longitude
axis.ticks = element_blank()) # Removes all latitude/ longitude markers
# View the map
hosp_map
```
<!-- ### Barplots: Difference in discharges based on deprivation (lowest and highest quintiles) -->
<!-- <p>Select the arrows in the bottom right corner of the grid to expand and shrink the view</p> -->
<!-- ```{r barplot, fig.asp = 0.8, fig.width = 14, fig.height= 7, out.width="100%"} -->
<!-- library(ggplotlyExtra) -->
<!-- hosp_bar = hospital_subset %>% -->
<!-- filter(quintile %in% c("1 - most deprived", "5 - least deprived")) %>% -->
<!-- ggplot(aes(x = period, y = indicator_measure, fill = quintile)) + -->
<!-- geom_bar(stat = "identity", -->
<!-- position = "dodge", -->
<!-- width = 0.8) + -->
<!-- geom_errorbar(aes(ymin = lower_confidence_interval, -->
<!-- ymax = upper_confidence_interval), -->
<!-- width = 0.4, -->
<!-- position = position_dodge(width = 0.8)) + -->
<!-- labs(subtitle = "Age-standardised rate per 100,000", -->
<!-- caption = "Source: Scottish Public Health Observatory 2021") + -->
<!-- scale_fill_viridis_d(alpha = 0.5) + -->
<!-- facet_trelliscope(~geography_code, ncol = 4, nrow = 2, path = ".", self_contained = TRUE) + -->
<!-- theme_bw() + -->
<!-- theme(panel.background = element_blank(), # Removes heavy background formatting -->
<!-- panel.border = element_blank(), # Removes the outline border around the plot -->
<!-- strip.background = element_rect(fill = "white"), # Changes the background fill from the plot titles ("1 most deprived", "5 - least deprived") from gray to colour of choice -->
<!-- strip.text.x = element_text(size = 8), # Changes text size of plot titles ("1 most deprived", "5 - least deprived") -->
<!-- legend.position = "none", # Removes the legend -->
<!-- plot.subtitle = element_text(size = 8, vjust = 1, lineheight = 1.5), # Modifies the features of the subtitle: text size, vertical adjustment and lineheight -->
<!-- plot.caption = element_text(size = 8, vjust = -1, hjust = 0), # Modifies the caption attributes, including horizontal adjustment -->
<!-- axis.title.x = element_blank(), # Removes the x axis title -->
<!-- axis.title.y = element_blank(), # Removes the y axis title -->
<!-- axis.text.x = element_text(size = 8, color = "black", angle = 90), # Modifies the x axis text -->
<!-- axis.text.y = element_text(size = 8, color = "black")) # Modifies the y axis text -->
<!-- hosp_bar -->
<!-- ``` -->
### Boxplots: Comparison of psychiatric patient hospital discharges from most deprived and least deprived areas of Scotland, 2002 to 2020
```{r boxplots}
hosp_box = ggplot(subset(hospital_subset,
quintile %in% c("1 - most deprived", "5 - least deprived")),
aes(x = period, y = indicator_measure, fill = quintile)) +
geom_boxplot(width = 0.5) +
labs(subtitle = "Age-standardised rate per 100,000",
caption = "Source: Scottish Public Health Observatory 2021") +
scale_fill_viridis_d(alpha = 0.5) +
coord_cartesian(ylim = c(0, 1200)) +
facet_wrap(quintile~.) +
theme_bw() +
theme(panel.background = element_blank(), # Removes heavy background formatting
panel.border = element_blank(), # Removes the outline border around the plot
strip.background = element_rect(fill = "white"), # Changes the background fill from the plot titles ("1 most deprived", "5 - least deprived") from gray to colour of choice
strip.text.x = element_text(size = 8), # Changes text size of plot titles ("1 most deprived", "5 - least deprived")
legend.position = "none", # Removes the legend
plot.subtitle = element_text(size = 8, vjust = 1, lineheight = 1.5), # Modifies the features of the subtitle: text size, vertical adjustment and lineheight
plot.caption = element_text(size = 8, vjust = -1, hjust = 0), # Modifies the caption attributes, including horizontal adjustment
axis.title.x = element_blank(), # Removes the x axis title
axis.title.y = element_blank(), # Removes the y axis title
axis.text.x = element_text(size = 8, color = "black", angle = 90), # Modifies the x axis text
axis.text.y = element_text(size = 8, color = "black")) # Modifies the y axis text
hosp_box
```
Dataset {data-navmenu="Pages"}
======
```{r data-table}
# Use DT to create a data table; more options can be found at datatables.net
hospital_subset %>%
datatable(extensions = "Buttons", # adds a button to the datatable
options = list(dom = "Blfrtip",
buttons = c("copy",
"csv",
"excel",
"pdf",
"print")))
```
