Ap phs pub linkage

app.R

@@ -1,69 +1,107 @@
-#Code to create chart of hepatitis c by board.
+######################.
+### Analyst notes ----
+######################.
 
-############################.
-## Global ----
-############################.
-############################.
-##Packages 
+# This script prepares a data file and a shiny app to be embedded on the following page of the scotpho website: https://www.scotpho.org.uk/health-conditions/hepatitis-c/data/scotland-and-uk/
 
-library(dplyr) #data manipulation
-library(plotly) #charts
-library(shiny)
+# instructions:
+# Source new data from [add instructions] and save it in the following folder: /PHI_conf/ScotPHO/Website/Charts/Health Conditions/Hepatitis C/shiny_data
+# Un-comment the code in part 1 below and update the following:
+# a. current_data filepath to [add instructions] 
+# b. the filepath for reading in the hep_c data
+# c. the population lookups file and year
 
-#Preparing data - not needed unless new data coming through
+# This will prepare a data file within this repository to use to create the chart in the shiny app 
+# Make sure to comment the code back out again when deploying the shiny app, otherwise it won't work properly!
+
+
+# Part 1 - data prep
+# Part 2 - shiny app 
+
+
+###########################.
+### Part 1 -  data prep ----
+###########################.
+
+# packages
 # library(tidyr)
-# library(readr)
+# library(readr) # for reading in csv
+# library(janitor) # for data cleaning
+# library(dplyr) # data manipulation
+
+# #Set filepaths 
+# cl_out_pop <- "/conf/linkage/output/lookups/Unicode/Populations/Estimates/" #population lookups to calculate rates
+# filepath <- "/PHI_conf/ScotPHO/Website/Charts/Health Conditions/Hepatitis C/shiny_data" #shiny data
 # 
-# cl_out_pop <- "/conf/linkage/output/lookups/Unicode/Populations/Estimates/"
+# #read in currently deployed data
+# current_data <- read_csv(paste0(filepath, "/hepatitisc_data_to_2021.csv"))
 # 
-# hep_c <- read_csv("data/hepatitisc_board.csv") %>%
-#   mutate_if(is.character, factor) %>%  #converting characters into factors
-#   setNames(tolower(names(.))) %>% #variable names to lower case
-#   gather(year, number, -nhsboard) %>% # to long format
-#   mutate(year = as.numeric(gsub("y", "", year))) #taking out y from year
+# #read in new data
+# hep_c <- read_csv(paste0(filepath, "/hepatitisc_data_2022.csv")) |> 
+#   mutate_if(is.character, factor) |>  #converting characters into factors
+#   clean_names() #variable names to lower case
 # 
-# # Bringing population to calculate rates
-# pop_lookup <- readRDS(paste0(cl_out_pop, "HB2019_pop_est_1981_2018.rds")) %>%
-#   setNames(tolower(names(.))) %>%  #variables to lower case
-#   subset(year>2008) %>%  #select only 2002+
+# #bring in population to calculate rates
+# pop_lookup <- readRDS(paste0(cl_out_pop, "HB2019_pop_est_1981_2022.rds")) |>
+#   clean_names() |>   #variables to lower case
+#   subset(year=="2022") |>   #select only new year to be appended
 #   # Aggregating to get hb totals
-#   rename(code = hb2019) %>%  select(code, year, pop) %>% group_by(code, year) %>%
-#   summarise(denominator = sum(pop)) %>% ungroup %>% group_by(year) %>%
+#   rename(code = hb2019) |>  
+#   select(code, year, pop) |>  
+#   group_by(code, year) |> 
+#   summarise(denominator = sum(pop)) |>  ungroup() |>  group_by(year) |> 
 #   # Adding Scotland totals
-#   bind_rows(summarise_all(., list(~if(is.numeric(.)) sum(.) else "S00000001"))) %>%
-#   ungroup()
+#   adorn_totals("row", name = "S00000001") |>
+#   mutate(year = case_when(code == "S00000001" ~ 2022, TRUE ~ year)) #Update this line with newest year to match other rows
 # 
 # #Codes and names for areas
-# names_lookup <- readRDS("/PHI_conf/ScotPHO/Profiles/Data/Lookups/Geography/HBdictionary.rds") %>%
-#   mutate(areaname = gsub("NHS ", "", areaname), 
+# names_lookup <- readRDS("/PHI_conf/ScotPHO/Profiles/Data/Lookups/Geography/HBdictionary.rds") |> 
+#   mutate(areaname = gsub("NHS ", "", areaname),
 #          areaname = gsub(" and ", " & ", areaname))
 # 
 # # merging with codes
-# hep_c <- left_join(hep_c, names_lookup, by = c("nhsboard" = "areaname")) %>%
+# hep_c <- left_join(hep_c, names_lookup, by = c("nhsboard" = "areaname")) |> 
 #   mutate(code = case_when(nhsboard == "Scotland" ~ "S00000001", TRUE ~ code))
 # 
-# hep_c <- left_join(hep_c, pop_lookup, c("code", "year")) %>%
-#   mutate(rate = round(number/denominator*100000, 1)) %>% # calculate rate
-#   select(-denominator, -code) %>%
-#   gather(measure, value, c(-nhsboard, -year)) %>%
+# hep_c <- left_join(hep_c, pop_lookup, c("code", "year")) |> 
+#   mutate(rate = round(number/denominator*100000, 1))  |>  # calculate rate
+#   select(-denominator, -code) |> 
+#   gather(measure, value, c(-nhsboard, -year))  |> 
 #   mutate(measure = recode(measure, "number" = "Number", "rate" = "Rate"))
 # 
-# saveRDS(hep_c, "data/hepatitisc_board.rds")
+# #append new data onto current data
+# hep_c <- rbind(current_data, hep_c)
+# 
+# 
+# write.csv(hep_c, paste0(filepath, "/hepatitisc_data_to_2022.csv"), row.names = FALSE)
+# 
+# # uncomment to create data folder in repository if running for first time 
+# #dir.create("data/")
+# 
+# # save rds data in data folder
+# saveRDS(hep_c, "data/shiny_data_hepatitisc_board.rds")
+# 
 
-hep_c <- readRDS("data/hepatitisc_board.rds") #reading data for app
+
+#########################.
+# Part 2 - shiny app ----
+########################.
+
+# packages
+library(highcharter) #charts
+library(phsstyles) #for chart colors
+library(shiny) #shiny app
+library(tidyr)
+library(dplyr)
+
+
+# data prepared and saved from part 1 
+hep_c <- readRDS("data/shiny_data_hepatitisc_board.rds") # reading data for app
 
 #Use for selection of areas
 board_list <- sort(unique(hep_c$nhsboard[hep_c$nhsboard != "Scotland"]))
 
-#ScotPHO logo. 
-#Needs to be https address or if local in code 64 (the latter does not work with 4.7 plotly)
-scotpho_logo <-  list(source ="https://raw.githubusercontent.com/ScotPHO/plotly-charts/master/scotpho.png",
-                      xref = "paper", yref = "paper",
-                      x= -0.09, y= 1.2, sizex = 0.22, sizey = 0.18, opacity = 1)
-
-############################.
-## Visual interface ----
-############################.
+# UI
 #Height and widths as percentages to allow responsiveness
 #Using divs as issues with classing css 
 ui <- fluidPage(style="width: 650px; height: 500px; ", 
@@ -78,73 +116,58 @@ ui <- fluidPage(style="width: 650px; height: 500px; ",
                             choices = board_list))
                 ),
                 div(style= "width:100%; float: left;", #Main panel
-                  plotlyOutput("chart", width = "100%", height = "350px"),
+                  highchartOutput("line_chart"),
+                  #plotlyOutput("chart", width = "100%", height = "350px"),
                   p(div(style = "width: 25%; float: left;", #Footer
-                        HTML("Source: <a href='https://hpspubsrepo.blob.core.windows.net/hps-website/nss/2834/documents/1_hcv-testing-diagnosis-treatment-scotland-2018.pdf' target='_blank'>HPS</a>")),
+                        HTML("Source: <a href='https://hpspubsrepo.blob.core.windows.net/hps-website/nss/2834/documents/1_hcv-testing-diagnosis-treatment-scotland-2018.pdf' target='_blank'>HPS</a> (2009-18)"),
+                        HTML("Source: <a href='https://www.publichealthscotland.scot/publications/surveillance-of-hepatitis-c-in-scotland/surveillance-of-hepatitis-c-in-scotland-progress-on-elimination-of-hepatitis-c-as-a-major-public-health-concern-2023-update/' target='_blank'>PHS</a> (2021-)")),
                     div(style = "width: 25%; float: left;",
                         downloadLink('download_data', 'Download data')),
                     div(style = "width: 50%; float: left;",
-                        "Note: Year of earliest positive specimen.")
+                        "Notes: Year of earliest positive specimen. Publication of 2019 and 2020 data was prevented by the COVID-19 pandemic.")
                         )
                   )
                 )
 
-############################.
-## Server ----
-############################.
+# Server
 server <- function(input, output) {
 
   # Allowing user to download data
   output$download_data <- downloadHandler( 
     filename =  'hepatitisc_data.csv', content = function(file) { 
       write.csv(hep_c, file, row.names=FALSE) })
 
-  ############################.
-  #Visualization
-  output$chart <- renderPlotly({
-    #For Island plots and rates plot an empty chart
-    if (input$area == "Island Boards" & input$measure == "Rate") {
-        text_na <- list(x = 5, y = 5, text = "Rates are not published for the island boards" ,
-                        xref = "x", yref = "y",  showarrow = FALSE, size=15)
-        plot_ly() %>%
-          layout(annotations = text_na,
-                 yaxis = list(showline = FALSE, showticklabels = FALSE, showgrid = FALSE, fixedrange=TRUE),
-                 xaxis = list(showline = FALSE, showticklabels = FALSE, showgrid = FALSE, fixedrange=TRUE),
-                 font = list(family = 'Arial, sans-serif')) %>% 
-          config( displayModeBar = FALSE) # taking out plotly logo and collaborate button
-      } else {
-
-    #Data for Scotland line
-    data_scot <- hep_c %>% subset(nhsboard=="Scotland" & measure==input$measure)
-    #Data for Health board line
-    data_board <- hep_c %>% subset(nhsboard==input$area & measure==input$measure)
+  #Creating chart 
+  output$line_chart <- renderHighchart({
+
+    #Data for plot
+    data_chart <- hep_c |> subset(measure == input$measure & nhsboard == input$area)
+
+    #Separate Scotland data out for separate series
+    data_scot <- hep_c |> subset(measure == input$measure & nhsboard == "Scotland")
 
     #y axis title
-    yaxistitle <- ifelse(input$measure == "Rate", "Rate per 100,000", "Number of diagnosis")
+    yaxistitle <- ifelse(input$measure == "Number", "Number of diagnoses",
+                         "Rate per 100,000")
+
+    #Creating dynamic text for if Island Board rates selected
+    validate(
+      need((input$area != "Island Boards" | input$measure == "Number"), "Rates are not published for the island boards"))
 
-    plot <- plot_ly(data=data_board, x=~year, y = ~value, 
-                    type = "scatter", mode = 'lines',  line = list(color = '#08519c'),
-                    name = unique(data_board$nhsboard), width = 650, height = 350) %>% 
-      add_lines(data = data_scot, y = ~value, mode = 'lines', 
-                name = "Scotland", line = list(color = '#000000')) %>%
-    #Layout
-      layout(annotations = list(), #It needs this because of a buggy behaviour
-           yaxis = list(title = yaxistitle, rangemode="tozero", fixedrange=TRUE), 
-           xaxis = list(title = "Year",  fixedrange=TRUE),  
-           font = list(family = 'Arial, sans-serif'), #font
-           margin = list(pad = 4, t = 50), #margin-paddings
-           hovermode = 'false',  # to get hover compare mode as default
-           images = scotpho_logo) %>% 
-      config(displayModeBar= T, displaylogo = F, collaborate=F, editable =F) # taking out plotly logo and collaborate button
-      }
-    }) 
+    highchart() |>
+      hc_add_series(data_chart, "line", hcaes(y = value, x = year), name = input$area) |>  
+      hc_add_series(data_scot, "line", hcaes(y = value, x = year), name = "Scotland") |>  
+      hc_xAxis(title = list(text = "Year")) |> 
+      hc_yAxis(title = list(text = yaxistitle)) |> 
+      hc_legend(align = "left", verticalAlign = "top")
+
+  })
 
   } # end of server part
 
-############################.
-## Calling app ----
-############################.
 
+
+# calling app 
 shinyApp(ui = ui, server = server)
 
 ##END