In fergustaylor/openprescribingR: Load OpenPrescribing data directly into R
library(openprescribingR)
library(tidyverse)
library(sf)
library(ggiraph)
library(stringr)
library(deldir)
library(rgdal)
library(wesanderson)
library(viridis)
ccggeom <- CCG_boundaries_or_location(as_sf = TRUE)
#ccggeom without empty geoms
ccggeom <- ccggeom[c(!is.na(st_dimension(st_sfc(ccggeom$geometry)))),]
#centroids
ccggeom <- ccggeom %>%
mutate(
lon = map_dbl(geometry, ~st_centroid(.x)[[1]]),
lat = map_dbl(geometry, ~st_centroid(.x)[[2]])
)
list <- list_size()
list <- list[list$row_name %in% ccggeom$name,]
list <- list$row_id %>%
unique() %>%
as.character()
#clinics <- lapply(list, function (x){
# location_function(CCG_code = x, as_sf = TRUE)
#} )
#save(clinics, file="clinics.Rda")
load("clinics.Rda")
#add ccg to clinics
for (i in 1:length(clinics)) {
clinics[[i]]$ccg <- list[i]
}
bbox_polygon <- function(x) {
bb <- sf::st_bbox(x)
p <- matrix(
c(bb["xmin"], bb["ymin"],
bb["xmin"], bb["ymax"],
bb["xmax"], bb["ymax"],
bb["xmax"], bb["ymin"],
bb["xmin"], bb["ymin"]),
ncol = 2, byrow = T
)
sf::st_polygon(list(p))
}
#Produce the ccg polygons
nc_centroids <- st_centroid(ccggeom)
box <- st_sfc(bbox_polygon(nc_centroids))
v <- st_voronoi(st_union(nc_centroids), box)
rm(nc_centroids, box)
polygons <- st_intersection(st_cast(v), st_union(ccggeom)) %>%
as_Spatial() %>%
fortify()
length(unique(polygons$piece))
length(unique(polygons$id))
length(unique(polygons$group))
ccggeom$id <- str_c("ID", 1:nrow(ccggeom))
#for (i in 1:length(ccggeom$id)){
#polygons$name[!is.na(match(polygons$id, ccggeom$id[i]))] <- as.character(ccggeom$name[i])
}
#rm(v)
st_transform(ccggeom, 29101) %>%
st_centroid() %>%
# this is the crs from d, which has no EPSG code:
st_transform(., '+proj=longlat +ellps=GRS80 +no_defs') %>%
# since you want the centroids in a second geometry col:
st_geometry()
st_transform(ccggeom, 4326) %>%
st_centroid()
4326
st_crs(ccggeom)
plot11 = ggplot(ccggeom) +
geom_map_interactive(aes(map_id = id, map = polygons)) +
coord_sf(crs= 4326, datum = sf::st_crs(4326))
ggiraph(code = {print(plot11)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 13.46, width=1) %>%
htmlwidgets::saveWidget("plot11.html")
plot11 = ggplot(ccggeom) +
geom_polygon_interactive(data = polygons, aes(x = long, y = lat, group = group, tooltip = name, data_id = id)) +
coord_sf(crs= 4326, datum = sf::st_crs(4326)) +
geom_point(aes(x = lon, y = lat), color = "grey", size=0.1)
ggiraph(code = {print(plot11)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 13.46, width=1) %>%
htmlwidgets::saveWidget("plot11.html")
rm(polygons)
cliniclist <- do.call("rbind", clinics)
rm(clinics)
cliniclist2 <- cliniclist %>%
filter(org_type == "clinic")
cliniclist2 <- subset(cliniclist2, select = -c(org_type, setting))
rm(cliniclist)
ccgpolygons <- fortify(as_Spatial(ccggeom$geometry))
ccggeom$id <- str_c("ID", 1:nrow(ccggeom))
for (i in 1:length(ccggeom$id)){
ccgpolygons$name[!is.na(match(ccgpolygons$id, ccggeom$id[i]))] <- as.character(ccggeom$name[i])
}
Plot 1
plot1 = ggplot(ccggeom) +
geom_polygon_interactive(data = ccgpolygons, aes(x = long, y = lat, group = group, tooltip = name, data_id = id)) +
coord_sf(crs= 4326, datum = sf::st_crs(4326))
ggiraph(code = {print(plot1)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 13.46, width=1) %>%
htmlwidgets::saveWidget("plot1.html")
Plot 2
plot2 = ggplot(ccggeom) +
geom_polygon_interactive(data = ccgpolygons, aes(x = long, y = lat, group = group, tooltip = name, data_id = id)) +
geom_sf(data=cliniclist2, color = "grey", size=0.1) +
coord_sf(crs= 4326, datum = sf::st_crs(4326))
ggiraph(code = {print(plot2)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 13.46, width=1) %>%
htmlwidgets::saveWidget("plot2.html")
nc_centroids <- cliniclist2$geometry
box <- st_sfc(bbox_polygon(nc_centroids))
v <- st_voronoi(st_union(nc_centroids), box)
rm(box, nc_centroids)
clinicpolygons <- st_intersection(st_cast(v), st_union(ccggeom)) %>%
as_Spatial() %>%
fortify()
rm(v)
cliniclist2$name <- str_replace_all(cliniclist2$name, "'", " ")
cliniclist2$id <- str_c("ID", 1:nrow(cliniclist2))
for (i in 1:length(cliniclist2$id)){
clinicpolygons$name[!is.na(match(clinicpolygons$id, cliniclist2$id[i]))] <- as.character(cliniclist2$name[i])
}
plot6 = ggplot(ccggeom) +
geom_polygon_interactive(data = clinicpolygons, aes(x = long, y = lat, group = group, tooltip = name, data_id = id)) +
geom_sf(data=cliniclist2, color = "grey", size=0.1) +
coord_sf(crs= 4326, datum = sf::st_crs(4326))
ggiraph(code = {print(plot6)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 13.46, width=1) %>%
htmlwidgets::saveWidget("plot6.html")
spendingdata <- spending_by_practice(BNF_section_code = "2.12", practice_code = "G82732")
spendingdata$date <- as.Date(spendingdata$date)
ccgpracticespendingdata <- spending_by_practice(BNF_section_code = "2.12", CCG_code = "99J")
ccgpracticespendingdata$date <- as.Date(ccgpracticespendingdata$date)
CCGdata <- location_function(CCG_code = "99J", as_sf = TRUE) %>%
mutate(
lon = map_dbl(geometry, ~st_centroid(.x)[[1]]),
lat = map_dbl(geometry, ~st_centroid(.x)[[2]])
)
CCGdata$name <- str_replace_all(CCGdata$name, "'", " ")
ccgpracticespendingdata2 <- spending_by_practice(BNF_section_code = "2.12", CCG_code = "99J") %>%
group_by(date) %>%
summarise(`Q1`=quantile(actual_cost, probs=0.25),
`Q2`=quantile(actual_cost, probs=0.5),
`Q3`=quantile(actual_cost, probs=0.75),
`Min`=min(actual_cost),
`Max`=max(actual_cost),
`Total`=sum(actual_cost)) %>%
mutate(Clinic = spendingdata[, 'actual_cost'])
ccgpracticespendingdata2$date <- as.Date(ccgpracticespendingdata2$date)
#summarise to 2 sig figures
ccgpracticespendingdata2$Q1 <- round(ccgpracticespendingdata2$Q1,2)
ccgpracticespendingdata2$Q2 <- round(ccgpracticespendingdata2$Q2,2)
ccgpracticespendingdata2$Q3 <- round(ccgpracticespendingdata2$Q3,2)
ccgpracticespendingdata2$Min <- round(ccgpracticespendingdata2$Min,2)
ccgpracticespendingdata2$Max <- round(ccgpracticespendingdata2$Max,2)
ccgpracticespendingdata2$Total <- round(ccgpracticespendingdata2$Total,2)
ccgpracticespendingdata2$Clinic <- round(ccgpracticespendingdata2$Clinic,2)
tidyr <- ccgpracticespendingdata2 %>%
gather(key = group, value = actual_cost, -date, -Total) %>%
select(-Total) %>%
mutate(label = str_c(date, ": ", group, ", £", actual_cost))
tidyr$date <- as.Date(tidyr$date)
centres <- CCGdata[2:86,]
centres <- centres %>%
filter(!name == "OPHTHALMOLOGY-APCOS-NOK") %>%
filter(!name == "INTEGRATED CARE 24 LIMITED OOH")
nc_centroids <- st_centroid(centres)
box <- st_sfc(bbox_polygon(nc_centroids))
v <- st_voronoi(st_union(nc_centroids), box)
rm(nc_centroids, box)
Kentvoronoipolygon <- st_intersection(st_cast(v), st_union(CCGdata[1,])) %>%
as_Spatial() %>%
fortify()
rm(v)
#not sure why different lengths?
#centres$id <- str_c("ID", 1:nrow(centres))
#for (i in 1:length(centres$id)){
#Kentvoronoipolygon$name[!is.na(match(Kentvoronoipolygon$id, centres$id[i]))] <- as.character(centres$name[i])
#}
#overlay names
#css changes for points
plot7 = ggplot() +
geom_sf(data = CCGdata[1,]) +
geom_point_interactive(data = CCGdata[2:86,], aes(x = lon, y = lat, tooltip = name)) +
geom_point_interactive(data = CCGdata[57,], aes(x = lon, y = lat, tooltip = name), colour = "red") +
geom_text(data = CCGdata[57,], aes(x=lon, y=lat, label=name), hjust = 0, nudge_x = 0.05) +
theme(legend.position="none") +
coord_sf(crs= 4326, datum = sf::st_crs(4326))
ggiraph(code = {print(plot7)}, width_svg = 17.07, height_svg = 14.75, width=1) %>%
htmlwidgets::saveWidget("plot7.html")
#use centre names as polygons tooltips. polygons fill = none, css change = fill change colour?
plot7.5 = ggplot() +
geom_sf(data = CCGdata[1,]) +
geom_polygon_interactive(data = Kentvoronoipolygon, aes(x = long, y = lat, group = group, tooltip = id, data_id = id),
alpha = 0.1
) +
geom_point(data = CCGdata[2:86,], aes(x = lon, y = lat), colour = "white") +
geom_point(data = CCGdata[57,], aes(x = lon, y = lat), colour = "red") +
geom_text(data = CCGdata[57,], aes(x=lon, y=lat, label=name), hjust = 0, nudge_x = 0.05) +
theme(legend.position="none") +
coord_sf(crs= 4326, datum = sf::st_crs(4326))
ggiraph(code = {print(plot7.5)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 14.75, width=1) %>%
htmlwidgets::saveWidget("plot7.5.html")
rm(CCGdata)
#add points to graph
#add voronoi to graph
#css change to point within voronoi
plot8 = ggplot(spendingdata) +
geom_ribbon(data = ccgpracticespendingdata2,
aes(x = date, ymin = Min, ymax = Max), alpha=0.75, fill = "grey80") +
geom_ribbon(data = ccgpracticespendingdata2,
aes(x = date, ymin = Q1, ymax = Q3), alpha=0.75, fill = "grey70") +
geom_line_interactive(data = filter(tidyr, group=="Q3"|group=="Q1"),
aes(x= date, y=actual_cost, group=group, colour=group, tooltip = label), colour = "grey70") +
geom_line_interactive(data = filter(tidyr, group=="Max"|group=="Min"),
aes(x= date, y=actual_cost, group=group, colour=group, tooltip = label), colour = "grey80") +
geom_line_interactive(data = filter(tidyr, group=="Clinic"|group=="Q2"),
aes(x= date, y=actual_cost, group=group, colour=group, tooltip = label), alpha=0.5, size=2) +
theme(axis.text.x=element_text(angle=45, hjust = 1)) +
labs(title="Actual_cost spending on 'BNF Section 2.12 Drugs - Lipid-Regulating Drugs'")
ggiraph(code = {print(plot8)}, width_svg = 17.07, height_svg = 7.375, width=1) %>%
htmlwidgets::saveWidget("plot8.html")
#overlay voronoi
#add css changes to nearest point
filter(tidyr, group=="Q3"|group=="Q1")
filter(tidyr, group=="Max"|group=="Min")
filter(tidyr, group=="Clinic"|group=="Q2")
plot8.5 = ggplot(spendingdata) +
geom_ribbon(data = ccgpracticespendingdata2, aes(x = date, ymin = Min, ymax = Max), alpha=0.75, fill = "grey80") +
geom_ribbon(data = ccgpracticespendingdata2, aes(x = date, ymin = Q1, ymax = Q3), alpha=0.75, fill = "grey70") +
geom_line_interactive(data = filter(tidyr, group=="Q3"|group=="Q1"), aes(x= date, y=actual_cost, group=group, colour=group), colour = "grey70") +
geom_point_interactive(data = filter(tidyr, group=="Q3"|group=="Q1"), aes(x= date, y=actual_cost, group=group, tooltip = label), colour = "grey70", alpha=0.5, size=2) +
geom_line_interactive(data = filter(tidyr, group=="Max"|group=="Min"), aes(x= date, y=actual_cost, group=group, colour=group), colour = "grey80") +
geom_point_interactive(data = filter(tidyr, group=="Max"|group=="Min"), aes(x= date, y=actual_cost, group=group, tooltip = label), colour = "grey80", alpha=0.5, size=2) +
geom_line_interactive(data = filter(tidyr, group=="Clinic"|group=="Q2"), aes(x= date, y=actual_cost, group=group, colour=group), alpha=0.5, size=2) +
geom_point_interactive(data = filter(tidyr, group=="Clinic"|group=="Q2"), aes(x= date, y=actual_cost, group=group, colour=group, tooltip = label), alpha=0.5, size=2) +
theme(axis.text.x=element_text(angle=45, hjust = 1)) +
labs(title="Actual_cost spending on 'BNF Section 2.12 Drugs - Lipid-Regulating Drugs'")
ggiraph(code = {print(plot8.5)}, width_svg = 17.07, height_svg = 7.375, width=1) %>%
htmlwidgets::saveWidget("plot8.5.html")
ccgpracticespendingdata$date <- as.Date(ccgpracticespendingdata$date)
ccgpracticespendingdata <- ccgpracticespendingdata %>%
mutate(label = str_c(date, ": ", row_name, ", £", actual_cost))
ccgpracticespendingdata$label <- str_replace_all(ccgpracticespendingdata$label, "'", " ")
tidyr$label <- str_replace_all(tidyr$label, "'", " ")
#add voronoi
plot10 = ccgpracticespendingdata %>%
ggplot() +
geom_ribbon(data = ccgpracticespendingdata2,
aes(x = date, ymin = Min, ymax = Max), fill = "grey80", alpha=0.75) +
geom_ribbon(data = ccgpracticespendingdata2,
aes(x = date, ymin = Q1, ymax = Q3), fill = "grey70", alpha=0.75) +
geom_line_interactive(aes(group = row_id, x=date, y=actual_cost, tooltip = label)) +
geom_point_interactive(aes(group = row_id, x=date, y=actual_cost, tooltip = label), alpha=0.1, size=2) +
geom_line_interactive(data = filter(tidyr, group=="Clinic"|group=="Q2"),
aes(x= date, y=actual_cost, group=group, colour=group), size=2) +
geom_point_interactive(data = filter(tidyr, group=="Clinic"|group=="Q2"),
aes(x= date, y=actual_cost, group=group, colour=group, tooltip = label), alpha=0.1, size=2) +
#geom_text(data = filter(ccgpracticespendingdata, date == "2017-05-01"), aes(label = row_id, x=date, y=actual_cost, vjust = 1, hjust = 0, angle=45)) +
theme(axis.text.x=element_text(angle=45, hjust = 1)) +
labs(title="Actual_cost spending on 'BNF Section 2.12 Drugs - Lipid-Regulating Drugs'")
ggiraph(code = {print(plot10)}, width_svg = 17.07, height_svg = 7.375, width=1) %>%
htmlwidgets::saveWidget("plot10.html")
rm(ccgpracticespendingdata, ccgpracticespendingdata2, tidyr)
Chloropleth
list <- list_size()
list <- list[list$row_name %in% ccggeom$name,]
list <- list$row_id %>%
unique() %>%
as.character()
#clinicsspending <- lapply(list[1:50], function (x){
# spending_by_practice(CCG_code = x, BNF_section_code = "7.4.5")
#})
#clinicsspending2 <- lapply(list[51:100], function (x){
# spending_by_practice(CCG_code = x, BNF_section_code = "7.4.5")
#})
#clinicsspending3 <- lapply(list[101:150], function (x){
# spending_by_practice(CCG_code = x, BNF_section_code = "7.4.5")
#})
#clinicsspending4 <- lapply(list[151:207], function (x){
# spending_by_practice(CCG_code = x, BNF_section_code = "7.4.5")
#})
#spending <- c(clinicsspending, clinicsspending2, clinicsspending3, clinicsspending4)
#fixing ccgs
#for (i in 1:length(list)){
# spending[[i]]$ccg <- list[i]
#}
#rm(clinicsspending, clinicsspending2, clinicsspending3, clinicsspending4, list)
#save(spending, file="spending.Rda")
load("spending.Rda")
Combine dataframes
clinicsbnfspending <- do.call("rbind", spending)
rm(spending, list, i)
#plot12 = ggplot(ccggeom) +
# geom_polygon_interactive(data = clinicpolygons, aes(x = long, y = #lat, group = group, tooltip = name)) +
#geom_sf(data=cliniclist2, color = "grey", size=0.1) +
# coord_sf(crs= 4326, datum = sf::st_crs(4326))
#ggiraph(code = {print(plot12)}, width_svg = 17.07, height_svg = 13.46, width=1) %>%
#htmlwidgets::saveWidget("plot12.html")
selecteddata <- clinicsbnfspending %>%
filter(date == "2018-01-01") %>%
rename(name = "row_name")
#ccgs in recent data
selecteddatalist <- unique(selecteddata$ccg)
#Recurring names in a specific ccg
repeatlist <- list()
for (i in 1:length(selecteddatalist)) {
repeatlist[[i]] <- selecteddata %>%
filter(ccg == selecteddatalist[i]) %>%
select('name') %>%
duplicated()
repeatlist[[i]] <- filter(selecteddata, ccg == selecteddatalist[i])$name[repeatlist[[i]]] %>%
as.character()
}
#Find positions of repeats
length <- lapply(repeatlist, length) %>%
unlist()
positions <- which(length > 0)
rm(length)
#Filter out values which can't be fixed to a specific position
filteredselecteddata <- selecteddata
for (i in 1:length(positions)) {
filteredselecteddata <- filteredselecteddata %>%
filter(!(ccg == selecteddatalist[positions[i]] & name == repeatlist[[positions[i]]][1]))
}
rm(selecteddata, selecteddatalist, repeatlist, positions)
rm(i)
left <- left_join(filteredselecteddata, cliniclist2, by=c("name", "ccg"))
duplicatedlist <- left$row_id[duplicated(left$row_id)]
duplicatedrows <- filter(left, row_id %in% duplicatedlist)
#Selected first example of each row_id
ukdata <- left[unique(left$row_id),]
#Polygons
nc_centroids <- ukdata$geometry
box <- st_sfc(bbox_polygon(nc_centroids))
v <- st_voronoi(st_union(nc_centroids), box)
rm(box, nc_centroids)
ukdatapolygons <- st_intersection(st_cast(v), st_union(ccggeom)) %>%
as_Spatial() %>%
fortify()
rm(v)
ukdata$name <- str_replace_all(ukdata$name, "'", " ")
ukdata$id <- str_c("ID", 1:nrow(ukdata))
for (i in 1:length(ukdata$id)){
ukdatapolygons$name[!is.na(match(ukdatapolygons$id, ukdata$id[i]))] <- as.character(ukdata$name[i])
ukdatapolygons$actual_cost[!is.na(match(ukdatapolygons$id, ukdata$id[i]))] <- as.character(ukdata$actual_cost[i])
}
ukdatapolygons$actual_cost <- as.numeric(ukdatapolygons$actual_cost)
#Label
ukdatapolygons$label <- str_c(ukdatapolygons$name, " £", round(ukdatapolygons$actual_cost, 2))
pal <- wes_palette("Zissou", 100, type = "continuous")
plot12 = ggplot(ccggeom) +
geom_polygon_interactive(data = clinicpolygons, aes(x = long, y = lat, group = group, tooltip = name, data_id = id)) +
#geom_sf(data=cliniclist2, color = "grey", size=0.1) +
coord_sf(crs= 4326, datum = sf::st_crs(4326))
ggiraph(code = {print(plot12)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 13.46, width=1) %>%
htmlwidgets::saveWidget("plot12.html")
plot12.5 = ggplot(ccggeom) +
geom_polygon_interactive(data = ukdatapolygons, aes(x = long, y = lat, group = group, tooltip = label, fill = actual_cost, data_id = id)) +
coord_sf(crs= 4326, datum = sf::st_crs(4326)) +
scale_fill_gradientn(colours = pal) +
labs(title="Actual_cost spending on 'BNF Section 7.4.5 Drugs'")
ggiraph(code = {print(plot12.5)}, hover_css = "stroke:white;", width_svg = 17.07, height_svg = 13.46, width=1) %>%
htmlwidgets::saveWidget("plot12.5.html")
plot12.5.1 = ggplot(ccggeom) +
geom_polygon_interactive(data = ukdatapolygons, aes(x = long, y = lat, group = group, tooltip = label, fill = actual_cost, data_id = id)) +
coord_sf(crs= 4326, datum = sf::st_crs(4326)) +
scale_fill_viridis(begin = 0.2, end = 1) +
labs(title="Actual_cost spending on 'BNF Section 7.4.5 Drugs'")
ggiraph(code = {print(plot12.5.1)}, hover_css = "stroke:white;", width_svg = 17.07, height_svg = 13.46, width=1) %>%
htmlwidgets::saveWidget("plot12.5.1.html")
plot12.5.5 = ggplot(ccggeom) +
geom_polygon_interactive(data = ukdatapolygons, aes(x = long, y = lat, group = group, tooltip = label, fill = actual_cost, data_id = id)) +
geom_sf(data=ukdata, color = "white", size=0.1) +
coord_sf(crs= 4326, datum = sf::st_crs(4326)) +
scale_fill_gradientn(colours = pal) +
scale_fill_continuous(breaks = c(2500, 5000, 7500, 10000),
labels = c("£2500", "£5000", "£7500", "£10000")) +
labs(title="Actual_cost spending on 'BNF Section 7.4.5 Drugs'")
ggiraph(code = {print(plot12.5.5)}, hover_css = "stroke:white;", width_svg = 17.07, height_svg = 13.46, width=1) %>%
htmlwidgets::saveWidget("plot12.5.5.html")
plot12.5.5.5 = ggplot(ccggeom) +
geom_polygon_interactive(data = ukdatapolygons, aes(x = long, y = lat, group = group, tooltip = label, fill = actual_cost, data_id = id)) +
geom_sf(data=ukdata, color = "white", size=0.1) +
coord_sf(crs= 4326, datum = sf::st_crs(4326)) +
scale_fill_viridis(begin = 0.2, end = 1) +
labs(title="Actual_cost spending on 'BNF Section 7.4.5 Drugs'")
ggiraph(code = {print(plot12.5.5.5)}, hover_css = "stroke:white;", width_svg = 17.07, height_svg = 13.46, width=1) %>%
htmlwidgets::saveWidget("plot12.5.5.5.html")
fergustaylor/openprescribingR documentation built on May 31, 2019, 1:15 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
library(openprescribingR) library(tidyverse) library(sf) library(ggiraph) library(stringr) library(deldir) library(rgdal) library(wesanderson) library(viridis)
ccggeom <- CCG_boundaries_or_location(as_sf = TRUE) #ccggeom without empty geoms ccggeom <- ccggeom[c(!is.na(st_dimension(st_sfc(ccggeom$geometry)))),] #centroids ccggeom <- ccggeom %>% mutate( lon = map_dbl(geometry, ~st_centroid(.x)[[1]]), lat = map_dbl(geometry, ~st_centroid(.x)[[2]]) )
list <- list_size() list <- list[list$row_name %in% ccggeom$name,] list <- list$row_id %>% unique() %>% as.character() #clinics <- lapply(list, function (x){ # location_function(CCG_code = x, as_sf = TRUE) #} ) #save(clinics, file="clinics.Rda") load("clinics.Rda") #add ccg to clinics for (i in 1:length(clinics)) { clinics[[i]]$ccg <- list[i] }
bbox_polygon <- function(x) { bb <- sf::st_bbox(x) p <- matrix( c(bb["xmin"], bb["ymin"], bb["xmin"], bb["ymax"], bb["xmax"], bb["ymax"], bb["xmax"], bb["ymin"], bb["xmin"], bb["ymin"]), ncol = 2, byrow = T ) sf::st_polygon(list(p)) }
#Produce the ccg polygons nc_centroids <- st_centroid(ccggeom) box <- st_sfc(bbox_polygon(nc_centroids)) v <- st_voronoi(st_union(nc_centroids), box) rm(nc_centroids, box) polygons <- st_intersection(st_cast(v), st_union(ccggeom)) %>% as_Spatial() %>% fortify() length(unique(polygons$piece)) length(unique(polygons$id)) length(unique(polygons$group)) ccggeom$id <- str_c("ID", 1:nrow(ccggeom)) #for (i in 1:length(ccggeom$id)){ #polygons$name[!is.na(match(polygons$id, ccggeom$id[i]))] <- as.character(ccggeom$name[i]) } #rm(v)
st_transform(ccggeom, 29101) %>% st_centroid() %>% # this is the crs from d, which has no EPSG code: st_transform(., '+proj=longlat +ellps=GRS80 +no_defs') %>% # since you want the centroids in a second geometry col: st_geometry() st_transform(ccggeom, 4326) %>% st_centroid() 4326 st_crs(ccggeom) plot11 = ggplot(ccggeom) + geom_map_interactive(aes(map_id = id, map = polygons)) + coord_sf(crs= 4326, datum = sf::st_crs(4326)) ggiraph(code = {print(plot11)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 13.46, width=1) %>% htmlwidgets::saveWidget("plot11.html") plot11 = ggplot(ccggeom) + geom_polygon_interactive(data = polygons, aes(x = long, y = lat, group = group, tooltip = name, data_id = id)) + coord_sf(crs= 4326, datum = sf::st_crs(4326)) + geom_point(aes(x = lon, y = lat), color = "grey", size=0.1) ggiraph(code = {print(plot11)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 13.46, width=1) %>% htmlwidgets::saveWidget("plot11.html") rm(polygons)
cliniclist <- do.call("rbind", clinics) rm(clinics) cliniclist2 <- cliniclist %>% filter(org_type == "clinic") cliniclist2 <- subset(cliniclist2, select = -c(org_type, setting)) rm(cliniclist)
ccgpolygons <- fortify(as_Spatial(ccggeom$geometry)) ccggeom$id <- str_c("ID", 1:nrow(ccggeom)) for (i in 1:length(ccggeom$id)){ ccgpolygons$name[!is.na(match(ccgpolygons$id, ccggeom$id[i]))] <- as.character(ccggeom$name[i]) }
Plot 1
plot1 = ggplot(ccggeom) + geom_polygon_interactive(data = ccgpolygons, aes(x = long, y = lat, group = group, tooltip = name, data_id = id)) + coord_sf(crs= 4326, datum = sf::st_crs(4326)) ggiraph(code = {print(plot1)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 13.46, width=1) %>% htmlwidgets::saveWidget("plot1.html")
Plot 2
plot2 = ggplot(ccggeom) + geom_polygon_interactive(data = ccgpolygons, aes(x = long, y = lat, group = group, tooltip = name, data_id = id)) + geom_sf(data=cliniclist2, color = "grey", size=0.1) + coord_sf(crs= 4326, datum = sf::st_crs(4326)) ggiraph(code = {print(plot2)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 13.46, width=1) %>% htmlwidgets::saveWidget("plot2.html")
nc_centroids <- cliniclist2$geometry box <- st_sfc(bbox_polygon(nc_centroids)) v <- st_voronoi(st_union(nc_centroids), box) rm(box, nc_centroids) clinicpolygons <- st_intersection(st_cast(v), st_union(ccggeom)) %>% as_Spatial() %>% fortify() rm(v) cliniclist2$name <- str_replace_all(cliniclist2$name, "'", " ") cliniclist2$id <- str_c("ID", 1:nrow(cliniclist2)) for (i in 1:length(cliniclist2$id)){ clinicpolygons$name[!is.na(match(clinicpolygons$id, cliniclist2$id[i]))] <- as.character(cliniclist2$name[i]) }
plot6 = ggplot(ccggeom) + geom_polygon_interactive(data = clinicpolygons, aes(x = long, y = lat, group = group, tooltip = name, data_id = id)) + geom_sf(data=cliniclist2, color = "grey", size=0.1) + coord_sf(crs= 4326, datum = sf::st_crs(4326)) ggiraph(code = {print(plot6)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 13.46, width=1) %>% htmlwidgets::saveWidget("plot6.html")
spendingdata <- spending_by_practice(BNF_section_code = "2.12", practice_code = "G82732") spendingdata$date <- as.Date(spendingdata$date) ccgpracticespendingdata <- spending_by_practice(BNF_section_code = "2.12", CCG_code = "99J") ccgpracticespendingdata$date <- as.Date(ccgpracticespendingdata$date) CCGdata <- location_function(CCG_code = "99J", as_sf = TRUE) %>% mutate( lon = map_dbl(geometry, ~st_centroid(.x)[[1]]), lat = map_dbl(geometry, ~st_centroid(.x)[[2]]) ) CCGdata$name <- str_replace_all(CCGdata$name, "'", " ") ccgpracticespendingdata2 <- spending_by_practice(BNF_section_code = "2.12", CCG_code = "99J") %>% group_by(date) %>% summarise(`Q1`=quantile(actual_cost, probs=0.25), `Q2`=quantile(actual_cost, probs=0.5), `Q3`=quantile(actual_cost, probs=0.75), `Min`=min(actual_cost), `Max`=max(actual_cost), `Total`=sum(actual_cost)) %>% mutate(Clinic = spendingdata[, 'actual_cost']) ccgpracticespendingdata2$date <- as.Date(ccgpracticespendingdata2$date) #summarise to 2 sig figures ccgpracticespendingdata2$Q1 <- round(ccgpracticespendingdata2$Q1,2) ccgpracticespendingdata2$Q2 <- round(ccgpracticespendingdata2$Q2,2) ccgpracticespendingdata2$Q3 <- round(ccgpracticespendingdata2$Q3,2) ccgpracticespendingdata2$Min <- round(ccgpracticespendingdata2$Min,2) ccgpracticespendingdata2$Max <- round(ccgpracticespendingdata2$Max,2) ccgpracticespendingdata2$Total <- round(ccgpracticespendingdata2$Total,2) ccgpracticespendingdata2$Clinic <- round(ccgpracticespendingdata2$Clinic,2) tidyr <- ccgpracticespendingdata2 %>% gather(key = group, value = actual_cost, -date, -Total) %>% select(-Total) %>% mutate(label = str_c(date, ": ", group, ", £", actual_cost)) tidyr$date <- as.Date(tidyr$date)
centres <- CCGdata[2:86,] centres <- centres %>% filter(!name == "OPHTHALMOLOGY-APCOS-NOK") %>% filter(!name == "INTEGRATED CARE 24 LIMITED OOH") nc_centroids <- st_centroid(centres) box <- st_sfc(bbox_polygon(nc_centroids)) v <- st_voronoi(st_union(nc_centroids), box) rm(nc_centroids, box) Kentvoronoipolygon <- st_intersection(st_cast(v), st_union(CCGdata[1,])) %>% as_Spatial() %>% fortify() rm(v) #not sure why different lengths? #centres$id <- str_c("ID", 1:nrow(centres)) #for (i in 1:length(centres$id)){ #Kentvoronoipolygon$name[!is.na(match(Kentvoronoipolygon$id, centres$id[i]))] <- as.character(centres$name[i]) #} #overlay names #css changes for points plot7 = ggplot() + geom_sf(data = CCGdata[1,]) + geom_point_interactive(data = CCGdata[2:86,], aes(x = lon, y = lat, tooltip = name)) + geom_point_interactive(data = CCGdata[57,], aes(x = lon, y = lat, tooltip = name), colour = "red") + geom_text(data = CCGdata[57,], aes(x=lon, y=lat, label=name), hjust = 0, nudge_x = 0.05) + theme(legend.position="none") + coord_sf(crs= 4326, datum = sf::st_crs(4326)) ggiraph(code = {print(plot7)}, width_svg = 17.07, height_svg = 14.75, width=1) %>% htmlwidgets::saveWidget("plot7.html") #use centre names as polygons tooltips. polygons fill = none, css change = fill change colour? plot7.5 = ggplot() + geom_sf(data = CCGdata[1,]) + geom_polygon_interactive(data = Kentvoronoipolygon, aes(x = long, y = lat, group = group, tooltip = id, data_id = id), alpha = 0.1 ) + geom_point(data = CCGdata[2:86,], aes(x = lon, y = lat), colour = "white") + geom_point(data = CCGdata[57,], aes(x = lon, y = lat), colour = "red") + geom_text(data = CCGdata[57,], aes(x=lon, y=lat, label=name), hjust = 0, nudge_x = 0.05) + theme(legend.position="none") + coord_sf(crs= 4326, datum = sf::st_crs(4326)) ggiraph(code = {print(plot7.5)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 14.75, width=1) %>% htmlwidgets::saveWidget("plot7.5.html") rm(CCGdata)
#add points to graph #add voronoi to graph #css change to point within voronoi plot8 = ggplot(spendingdata) + geom_ribbon(data = ccgpracticespendingdata2, aes(x = date, ymin = Min, ymax = Max), alpha=0.75, fill = "grey80") + geom_ribbon(data = ccgpracticespendingdata2, aes(x = date, ymin = Q1, ymax = Q3), alpha=0.75, fill = "grey70") + geom_line_interactive(data = filter(tidyr, group=="Q3"|group=="Q1"), aes(x= date, y=actual_cost, group=group, colour=group, tooltip = label), colour = "grey70") + geom_line_interactive(data = filter(tidyr, group=="Max"|group=="Min"), aes(x= date, y=actual_cost, group=group, colour=group, tooltip = label), colour = "grey80") + geom_line_interactive(data = filter(tidyr, group=="Clinic"|group=="Q2"), aes(x= date, y=actual_cost, group=group, colour=group, tooltip = label), alpha=0.5, size=2) + theme(axis.text.x=element_text(angle=45, hjust = 1)) + labs(title="Actual_cost spending on 'BNF Section 2.12 Drugs - Lipid-Regulating Drugs'") ggiraph(code = {print(plot8)}, width_svg = 17.07, height_svg = 7.375, width=1) %>% htmlwidgets::saveWidget("plot8.html")
#overlay voronoi #add css changes to nearest point filter(tidyr, group=="Q3"|group=="Q1") filter(tidyr, group=="Max"|group=="Min") filter(tidyr, group=="Clinic"|group=="Q2") plot8.5 = ggplot(spendingdata) + geom_ribbon(data = ccgpracticespendingdata2, aes(x = date, ymin = Min, ymax = Max), alpha=0.75, fill = "grey80") + geom_ribbon(data = ccgpracticespendingdata2, aes(x = date, ymin = Q1, ymax = Q3), alpha=0.75, fill = "grey70") + geom_line_interactive(data = filter(tidyr, group=="Q3"|group=="Q1"), aes(x= date, y=actual_cost, group=group, colour=group), colour = "grey70") + geom_point_interactive(data = filter(tidyr, group=="Q3"|group=="Q1"), aes(x= date, y=actual_cost, group=group, tooltip = label), colour = "grey70", alpha=0.5, size=2) + geom_line_interactive(data = filter(tidyr, group=="Max"|group=="Min"), aes(x= date, y=actual_cost, group=group, colour=group), colour = "grey80") + geom_point_interactive(data = filter(tidyr, group=="Max"|group=="Min"), aes(x= date, y=actual_cost, group=group, tooltip = label), colour = "grey80", alpha=0.5, size=2) + geom_line_interactive(data = filter(tidyr, group=="Clinic"|group=="Q2"), aes(x= date, y=actual_cost, group=group, colour=group), alpha=0.5, size=2) + geom_point_interactive(data = filter(tidyr, group=="Clinic"|group=="Q2"), aes(x= date, y=actual_cost, group=group, colour=group, tooltip = label), alpha=0.5, size=2) + theme(axis.text.x=element_text(angle=45, hjust = 1)) + labs(title="Actual_cost spending on 'BNF Section 2.12 Drugs - Lipid-Regulating Drugs'") ggiraph(code = {print(plot8.5)}, width_svg = 17.07, height_svg = 7.375, width=1) %>% htmlwidgets::saveWidget("plot8.5.html")
ccgpracticespendingdata$date <- as.Date(ccgpracticespendingdata$date) ccgpracticespendingdata <- ccgpracticespendingdata %>% mutate(label = str_c(date, ": ", row_name, ", £", actual_cost)) ccgpracticespendingdata$label <- str_replace_all(ccgpracticespendingdata$label, "'", " ") tidyr$label <- str_replace_all(tidyr$label, "'", " ")
#add voronoi plot10 = ccgpracticespendingdata %>% ggplot() + geom_ribbon(data = ccgpracticespendingdata2, aes(x = date, ymin = Min, ymax = Max), fill = "grey80", alpha=0.75) + geom_ribbon(data = ccgpracticespendingdata2, aes(x = date, ymin = Q1, ymax = Q3), fill = "grey70", alpha=0.75) + geom_line_interactive(aes(group = row_id, x=date, y=actual_cost, tooltip = label)) + geom_point_interactive(aes(group = row_id, x=date, y=actual_cost, tooltip = label), alpha=0.1, size=2) + geom_line_interactive(data = filter(tidyr, group=="Clinic"|group=="Q2"), aes(x= date, y=actual_cost, group=group, colour=group), size=2) + geom_point_interactive(data = filter(tidyr, group=="Clinic"|group=="Q2"), aes(x= date, y=actual_cost, group=group, colour=group, tooltip = label), alpha=0.1, size=2) + #geom_text(data = filter(ccgpracticespendingdata, date == "2017-05-01"), aes(label = row_id, x=date, y=actual_cost, vjust = 1, hjust = 0, angle=45)) + theme(axis.text.x=element_text(angle=45, hjust = 1)) + labs(title="Actual_cost spending on 'BNF Section 2.12 Drugs - Lipid-Regulating Drugs'") ggiraph(code = {print(plot10)}, width_svg = 17.07, height_svg = 7.375, width=1) %>% htmlwidgets::saveWidget("plot10.html") rm(ccgpracticespendingdata, ccgpracticespendingdata2, tidyr)
Chloropleth
list <- list_size() list <- list[list$row_name %in% ccggeom$name,] list <- list$row_id %>% unique() %>% as.character() #clinicsspending <- lapply(list[1:50], function (x){ # spending_by_practice(CCG_code = x, BNF_section_code = "7.4.5") #}) #clinicsspending2 <- lapply(list[51:100], function (x){ # spending_by_practice(CCG_code = x, BNF_section_code = "7.4.5") #}) #clinicsspending3 <- lapply(list[101:150], function (x){ # spending_by_practice(CCG_code = x, BNF_section_code = "7.4.5") #}) #clinicsspending4 <- lapply(list[151:207], function (x){ # spending_by_practice(CCG_code = x, BNF_section_code = "7.4.5") #}) #spending <- c(clinicsspending, clinicsspending2, clinicsspending3, clinicsspending4) #fixing ccgs #for (i in 1:length(list)){ # spending[[i]]$ccg <- list[i] #} #rm(clinicsspending, clinicsspending2, clinicsspending3, clinicsspending4, list) #save(spending, file="spending.Rda") load("spending.Rda")
Combine dataframes
clinicsbnfspending <- do.call("rbind", spending) rm(spending, list, i)
#plot12 = ggplot(ccggeom) + # geom_polygon_interactive(data = clinicpolygons, aes(x = long, y = #lat, group = group, tooltip = name)) + #geom_sf(data=cliniclist2, color = "grey", size=0.1) + # coord_sf(crs= 4326, datum = sf::st_crs(4326)) #ggiraph(code = {print(plot12)}, width_svg = 17.07, height_svg = 13.46, width=1) %>% #htmlwidgets::saveWidget("plot12.html")
selecteddata <- clinicsbnfspending %>% filter(date == "2018-01-01") %>% rename(name = "row_name") #ccgs in recent data selecteddatalist <- unique(selecteddata$ccg) #Recurring names in a specific ccg repeatlist <- list() for (i in 1:length(selecteddatalist)) { repeatlist[[i]] <- selecteddata %>% filter(ccg == selecteddatalist[i]) %>% select('name') %>% duplicated() repeatlist[[i]] <- filter(selecteddata, ccg == selecteddatalist[i])$name[repeatlist[[i]]] %>% as.character() } #Find positions of repeats length <- lapply(repeatlist, length) %>% unlist() positions <- which(length > 0) rm(length) #Filter out values which can't be fixed to a specific position filteredselecteddata <- selecteddata for (i in 1:length(positions)) { filteredselecteddata <- filteredselecteddata %>% filter(!(ccg == selecteddatalist[positions[i]] & name == repeatlist[[positions[i]]][1])) } rm(selecteddata, selecteddatalist, repeatlist, positions) rm(i) left <- left_join(filteredselecteddata, cliniclist2, by=c("name", "ccg")) duplicatedlist <- left$row_id[duplicated(left$row_id)] duplicatedrows <- filter(left, row_id %in% duplicatedlist) #Selected first example of each row_id ukdata <- left[unique(left$row_id),] #Polygons nc_centroids <- ukdata$geometry box <- st_sfc(bbox_polygon(nc_centroids)) v <- st_voronoi(st_union(nc_centroids), box) rm(box, nc_centroids) ukdatapolygons <- st_intersection(st_cast(v), st_union(ccggeom)) %>% as_Spatial() %>% fortify() rm(v) ukdata$name <- str_replace_all(ukdata$name, "'", " ") ukdata$id <- str_c("ID", 1:nrow(ukdata)) for (i in 1:length(ukdata$id)){ ukdatapolygons$name[!is.na(match(ukdatapolygons$id, ukdata$id[i]))] <- as.character(ukdata$name[i]) ukdatapolygons$actual_cost[!is.na(match(ukdatapolygons$id, ukdata$id[i]))] <- as.character(ukdata$actual_cost[i]) } ukdatapolygons$actual_cost <- as.numeric(ukdatapolygons$actual_cost) #Label ukdatapolygons$label <- str_c(ukdatapolygons$name, " £", round(ukdatapolygons$actual_cost, 2))
pal <- wes_palette("Zissou", 100, type = "continuous") plot12 = ggplot(ccggeom) + geom_polygon_interactive(data = clinicpolygons, aes(x = long, y = lat, group = group, tooltip = name, data_id = id)) + #geom_sf(data=cliniclist2, color = "grey", size=0.1) + coord_sf(crs= 4326, datum = sf::st_crs(4326)) ggiraph(code = {print(plot12)}, hover_css = "fill:red; fill-opacity:0.5;", width_svg = 17.07, height_svg = 13.46, width=1) %>% htmlwidgets::saveWidget("plot12.html") plot12.5 = ggplot(ccggeom) + geom_polygon_interactive(data = ukdatapolygons, aes(x = long, y = lat, group = group, tooltip = label, fill = actual_cost, data_id = id)) + coord_sf(crs= 4326, datum = sf::st_crs(4326)) + scale_fill_gradientn(colours = pal) + labs(title="Actual_cost spending on 'BNF Section 7.4.5 Drugs'") ggiraph(code = {print(plot12.5)}, hover_css = "stroke:white;", width_svg = 17.07, height_svg = 13.46, width=1) %>% htmlwidgets::saveWidget("plot12.5.html") plot12.5.1 = ggplot(ccggeom) + geom_polygon_interactive(data = ukdatapolygons, aes(x = long, y = lat, group = group, tooltip = label, fill = actual_cost, data_id = id)) + coord_sf(crs= 4326, datum = sf::st_crs(4326)) + scale_fill_viridis(begin = 0.2, end = 1) + labs(title="Actual_cost spending on 'BNF Section 7.4.5 Drugs'") ggiraph(code = {print(plot12.5.1)}, hover_css = "stroke:white;", width_svg = 17.07, height_svg = 13.46, width=1) %>% htmlwidgets::saveWidget("plot12.5.1.html") plot12.5.5 = ggplot(ccggeom) + geom_polygon_interactive(data = ukdatapolygons, aes(x = long, y = lat, group = group, tooltip = label, fill = actual_cost, data_id = id)) + geom_sf(data=ukdata, color = "white", size=0.1) + coord_sf(crs= 4326, datum = sf::st_crs(4326)) + scale_fill_gradientn(colours = pal) + scale_fill_continuous(breaks = c(2500, 5000, 7500, 10000), labels = c("£2500", "£5000", "£7500", "£10000")) + labs(title="Actual_cost spending on 'BNF Section 7.4.5 Drugs'") ggiraph(code = {print(plot12.5.5)}, hover_css = "stroke:white;", width_svg = 17.07, height_svg = 13.46, width=1) %>% htmlwidgets::saveWidget("plot12.5.5.html") plot12.5.5.5 = ggplot(ccggeom) + geom_polygon_interactive(data = ukdatapolygons, aes(x = long, y = lat, group = group, tooltip = label, fill = actual_cost, data_id = id)) + geom_sf(data=ukdata, color = "white", size=0.1) + coord_sf(crs= 4326, datum = sf::st_crs(4326)) + scale_fill_viridis(begin = 0.2, end = 1) + labs(title="Actual_cost spending on 'BNF Section 7.4.5 Drugs'") ggiraph(code = {print(plot12.5.5.5)}, hover_css = "stroke:white;", width_svg = 17.07, height_svg = 13.46, width=1) %>% htmlwidgets::saveWidget("plot12.5.5.5.html")
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.