diff --git a/Gestation at birth/Gestation at birth context charts.R b/Gestation at birth/Gestation at birth context charts.R
index b20daf1..d591744 100755
--- a/Gestation at birth/Gestation at birth context charts.R
+++ b/Gestation at birth/Gestation at birth context charts.R
@@ -8,122 +8,134 @@ gest_at_birth_context_data <- reactive({
# selects data
req(input$hbname)
-
+
data <- gest_at_birth_data %>%
- filter(hbname == Selected$HBName &
- period == "Q" &
- hbtype == Selected$HBType &
- measure_cat != "under 37 weeks"
- ) %>%
- mutate(mytext = if_else(measure_cat == "between 18 and 44 weeks (inclusive)",
- paste0("Quarter: ",
- quarter_label,
- "
",
- "Number of singleton live births with a known gestation (18-44 weeks)",
- ": ",
- prettyNum(num, big.mark = ",")
- ),
- paste0("Quarter: ",
- quarter_label,
- "
",
- "Number of singleton live births at ",
- formatted_name,
- ": ",
- prettyNum(num, big.mark = ",")
- )
- )
- ) %>%
+ filter(hbname == Selected$HBName &
+ period == "Q" &
+ hbtype == Selected$HBType &
+ measure_cat != "under 37 weeks"
+ ) %>%
+ mutate(mytext = if_else(measure_cat == "between 18 and 44 weeks (inclusive)",
+ paste0("Quarter: ",
+ quarter_label,
+ "
",
+ "Number of singleton live births with a known gestation (18-44 weeks)",
+ ": ",
+ prettyNum(num, big.mark = ",")
+ ),
+ paste0("Quarter: ",
+ quarter_label,
+ "
",
+ "Number of singleton live births at ",
+ formatted_name,
+ ": ",
+ prettyNum(num, big.mark = ",")
+ )
+ )
+ ) %>%
+
+ droplevels()
- droplevels()
-
-if (is.null(data()))
-{
- return()
-}
-
-else {
- data
-}
+ if (is.null(data()))
+ {
+ return()
+ }
+
+ else {
+ data
+ }
})
# b) chart ----
+plotdata <- reactive({gest_at_birth_context_data()})
+
output$gest_at_birth_context_charts <- renderPlotly({
+
+ # ensures ticks and tick labels correspond (different for ABC, TERMINATIONS, SMR02)
-# ensures ticks and tick labels correspond (different for ABC, TERMINATIONS, SMR02)
+ select_date_tickvals <- SMR02_date_tickvals
+ select_date_ticktext <- SMR02_date_ticktext
-select_date_tickvals <- SMR02_date_tickvals
-select_date_ticktext <- SMR02_date_ticktext
-
-xaxis_plots <- orig_xaxis_plots
-xaxis_plots[["tickmode"]] <- "array"
-xaxis_plots[["tickvals"]] <- select_date_tickvals
-xaxis_plots[["ticktext"]] <- select_date_ticktext
-
-yaxis_plots <- orig_yaxis_plots
-yaxis_plots[["title"]] <- list(text = "Number of births",
- standoff = 30) # distance between axis and chart
-
-term_chart <- plot_ly(
- data = filter(gest_at_birth_context_data(),
- measure_cat %in% term),
- x = ~ date,
- y = ~ num,
- type = "scatter",
- mode = "lines+markers",
- color = ~ formatted_name,
- colors = ~ selected_colours[1:5],
- symbol = ~ formatted_name,
- symbols = ~ c("circle", "square-x-open", "diamond", "star", "circle-open"),
- line = list(width = 2),
- hovertext = ~ mytext,
- hoverinfo = "text"
+ # adds an asterisk to these Board names when there is a related footnote to show
+
+ # legend_board_name <- if_else(
+ # (first(plotdata()$measure == "TYPE OF BIRTH") &
+ # first(plotdata()$hbname == "NHS Borders")
+ # ),
+ # paste0(first(plotdata()$hbname), "*"),
+ # first(plotdata()$hbname)
+ # )
+
+ xaxis_plots <- orig_xaxis_plots
+ xaxis_plots[["tickmode"]] <- "array"
+ xaxis_plots[["tickvals"]] <- select_date_tickvals
+ xaxis_plots[["ticktext"]] <- select_date_ticktext
+
+ yaxis_plots <- orig_yaxis_plots
+ yaxis_plots[["title"]] <- list(text = "Number of births",
+ standoff = 30) # distance between axis and chart
+
+ term_chart <- plot_ly(
+ data = filter(plotdata(),
+ measure_cat %in% term),
+ x = ~ date,
+ y = ~ num,
+ type = "scatter",
+ mode = "lines+markers",
+ color = ~ formatted_name,
+ colors = ~ selected_colours[1:5],
+ symbol = ~ formatted_name,
+ symbols = ~ c("circle", "square-x-open", "diamond", "star", "circle-open"),
+ line = list(width = 2),
+ hovertext = ~ mytext,
+ hoverinfo = "text"
) %>%
- layout(
- xaxis = xaxis_plots,
- yaxis = yaxis_plots
- )
-
-not_term_chart <- plot_ly(
- data = filter(gest_at_birth_context_data(),
- measure_cat %in% not_term),
- x = ~ date,
- y = ~ num,
- type = "scatter",
- mode = "lines+markers",
- color = ~ formatted_name,
- colors = ~ selected_colours[1:5],
- symbol = ~ formatted_name,
- symbols = ~ c("circle", "square-x-open", "diamond", "star", "circle-open"),
- line = list(width = 2),
- hovertext = ~ mytext,
- hoverinfo = "text"
+ layout(
+ xaxis = xaxis_plots,
+ yaxis = yaxis_plots
+ )
+
+ not_term_chart <- plot_ly(
+ data = filter(plotdata(),
+ measure_cat %in% not_term),
+ x = ~ date,
+ y = ~ num,
+ type = "scatter",
+ mode = "lines+markers",
+ color = ~ formatted_name,
+ colors = ~ selected_colours[1:5],
+ symbol = ~ formatted_name,
+ symbols = ~ c("circle", "square-x-open", "diamond", "star", "circle-open"),
+ line = list(width = 2),
+ hovertext = ~ mytext,
+ hoverinfo = "text"
) %>%
layout(
- xaxis = xaxis_plots,
- yaxis = yaxis_plots
+ xaxis = xaxis_plots,
+ yaxis = yaxis_plots
)
-
-chart <- subplot(term_chart, not_term_chart,
- margin = 0.05,
- shareX = TRUE,
- shareY = FALSE,
- titleY = TRUE) %>%
- layout(
- legend = list(
- title = list(text = paste0(gest_at_birth_context_data()$hbname, "
")),
- orientation = "v",
- x = 1.0,
- y = 0.5,
- xref = "paper",
- yref = "paper",
- xanchor = "left",
- itemclick = FALSE),
- # groupclick = "togglegroup")
- margin = list(pad = 30) # distance between axis and first data point
+
+ chart <- subplot(term_chart, not_term_chart,
+ margin = 0.05,
+ shareX = TRUE,
+ shareY = FALSE,
+ titleY = TRUE) %>%
+ layout(
+ legend = list(
+ title = list(text = paste0(plotdata()$hbname, "
")), # legend_board_name if needed
+ orientation = "v",
+ x = 1.0,
+ y = 0.5,
+ xref = "paper",
+ yref = "paper",
+ xanchor = "left",
+ itemclick = FALSE),
+ # groupclick = "togglegroup")
+ margin = list(pad = 30) # distance between axis and first data point
) %>%
-config(displaylogo = F, displayModeBar = FALSE)
-
+ config(displaylogo = F, displayModeBar = FALSE)
+
})
diff --git a/Type of birth/Type of birth context charts.R b/Type of birth/Type of birth context charts.R
index 0039ac3..a040782 100755
--- a/Type of birth/Type of birth context charts.R
+++ b/Type of birth/Type of birth context charts.R
@@ -7,49 +7,49 @@ type_of_birthNames = c("all live births (where type is known)", "spontaneous vag
"assisted vaginal births (including forceps, ventouse, and vaginal breech births)",
width = 50), collapse = "
"))
-type_of_birth_context_data <- reactive({
+type_of_birth_context_data <- reactive({
# selects data
req(input$hbname)
-
-data <- type_of_birth_data %>%
- filter(hbname == Selected$HBName &
- period == "Q" &
- hbtype == Selected$HBType &
- measure_cat != "all caesarean births") %>%
- mutate(measure_cat = if_else(measure_cat == "assisted vaginal births",
- paste(
- strwrap(
- "assisted vaginal births (including forceps, ventouse, and vaginal breech births)",
- width = 50), collapse = "
"),
- measure_cat
- )
- )
-
-# pick one category to get den (all live births)
-
-den_data <- filter(data, measure_cat == "spontaneous vaginal births") %>% # pick one category to get den (all live births)
- mutate(measure_cat = "all live births (where type is known)",
- num = den
- )
-
-data <- bind_rows(den_data, data) %>%
+
+ data <- type_of_birth_data %>%
+ filter(hbname == Selected$HBName &
+ period == "Q" &
+ hbtype == Selected$HBType &
+ measure_cat != "all caesarean births") %>%
+ mutate(measure_cat = if_else(measure_cat == "assisted vaginal births",
+ paste(
+ strwrap(
+ "assisted vaginal births (including forceps, ventouse, and vaginal breech births)",
+ width = 50), collapse = "
"),
+ measure_cat
+ )
+ )
+
+ # pick one category to get den (all live births)
+
+ den_data <- filter(data, measure_cat == "spontaneous vaginal births") %>% # pick one category to get den (all live births)
+ mutate(measure_cat = "all live births (where type is known)",
+ num = den
+ )
+
+ data <- bind_rows(den_data, data) %>%
mutate(measure_cat = factor(measure_cat,
- levels = type_of_birthNames),
+ levels = type_of_birthNames),
mytext1 = paste0("Quarter: ",
quarter_label,
"
",
str_to_sentence(measure_cat),
": ",
prettyNum(num, big.mark = ",")
- )
+ )
)
-
+
if (is.null(data()))
{
return()
}
-
+
else {
data
}
@@ -61,40 +61,50 @@ output$type_of_birth_context_charts <- renderPlotly({
y_max <- max(type_of_birth_context_data()$den, na.rm = TRUE) # allows a margin to be set around y-axis
- # ensures ticks and tick labels correspond (different for ABC, TERMINATIONS, SMR02)
-
- select_date_tickvals <- SMR02_date_tickvals
- select_date_ticktext <- SMR02_date_ticktext
-
- xaxis_plots <- orig_xaxis_plots
- xaxis_plots[["tickmode"]] <- "array"
- xaxis_plots[["tickvals"]] <- select_date_tickvals
- xaxis_plots[["ticktext"]] <- select_date_ticktext
-
- yaxis_plots <- orig_yaxis_plots
- yaxis_plots[["range"]] <- list(0, y_max * 1.05) # expands the y-axis range to prevent cut-offs
- yaxis_plots[["title"]] <- list(text = "Number of births",
- standoff = 30) # distance between axis and chart
+ # ensures ticks and tick labels correspond (different for ABC, TERMINATIONS, SMR02)
+
+ select_date_tickvals <- SMR02_date_tickvals
+ select_date_ticktext <- SMR02_date_ticktext
+
+ # adds an asterisk to these Board names when there is a related footnote to show
+
+ legend_board_name <- if_else(
+ (first(type_of_birth_context_data()$measure == "TYPE OF BIRTH") &
+ first(type_of_birth_context_data()$hbname == "NHS Borders")
+ ),
+ paste0(first(type_of_birth_context_data()$hbname), "*"),
+ first(type_of_birth_context_data()$hbname)
+ )
+
+ xaxis_plots <- orig_xaxis_plots
+ xaxis_plots[["tickmode"]] <- "array"
+ xaxis_plots[["tickvals"]] <- select_date_tickvals
+ xaxis_plots[["ticktext"]] <- select_date_ticktext
+
+ yaxis_plots <- orig_yaxis_plots
+ yaxis_plots[["range"]] <- list(0, y_max * 1.05) # expands the y-axis range to prevent cut-offs
+ yaxis_plots[["title"]] <- list(text = "Number of births",
+ standoff = 30) # distance between axis and chart
plot_ly(
- data = type_of_birth_context_data(),
- x = ~ date,
- y = ~ num,
- type = "scatter",
- mode = "lines+markers",
- color = ~ measure_cat,
- colors = selected_colours[1:5],
- symbol = ~ measure_cat,
- symbols = ~ c("circle", "square-x-open", "diamond", "star", "circle-open"),
- line = list(width = 2),
- hovertext = ~ mytext1,
- hoverinfo = "text"
- ) %>%
+ data = type_of_birth_context_data(),
+ x = ~ date,
+ y = ~ num,
+ type = "scatter",
+ mode = "lines+markers",
+ color = ~ measure_cat,
+ colors = selected_colours[1:5],
+ symbol = ~ measure_cat,
+ symbols = ~ c("circle", "square-x-open", "diamond", "star", "circle-open"),
+ line = list(width = 2),
+ hovertext = ~ mytext1,
+ hoverinfo = "text"
+ ) %>%
layout(
xaxis = xaxis_plots,
yaxis = yaxis_plots,
legend = list(
- title = list(text = paste0(type_of_birth_context_data()$hbname, "
")),
+ title = list(text = paste0(legend_board_name, "
")),
orientation = "v",
x = 1.0,
y = 0.5,
@@ -102,10 +112,10 @@ output$type_of_birth_context_charts <- renderPlotly({
yref = "paper",
xanchor = "left",
itemclick = FALSE),
- # groupclick = "togglegroup")
+ # groupclick = "togglegroup")
margin = list(pad = 30) # distance between axis and first data point
) %>%
config(displaylogo = F, displayModeBar = FALSE)
-
+
})
diff --git a/Type of birth/Type of birth runcharts.R b/Type of birth/Type of birth runcharts.R
index 6c27136..dfcb915 100755
--- a/Type of birth/Type of birth runcharts.R
+++ b/Type of birth/Type of birth runcharts.R
@@ -3,8 +3,8 @@
max_plots_type_of_birth <- 5
type_of_birthplotListNames = c("Caesarean births", "Assisted births",
- "Planned caesarean births", "Unplanned caesarean births",
- "Spontaneous vaginal births")
+ "Planned caesarean births", "Unplanned caesarean births",
+ "Spontaneous vaginal births")
type_of_birth_runchart_data <- reactive({
# selects data
@@ -24,7 +24,7 @@ type_of_birth_runchart_data <- reactive({
den = "Total number of births: ",
median = " average to Oct-Dec 2019",
extended = " projected average from Jan-Mar 2020")
-
+
new_labels = unique(c(data$num_label, data$measure_label))
data <- data %>%
@@ -68,49 +68,50 @@ planned_title <- reactive({
if_else(Selected$HBName == "NHS Borders",
"planned caesarean births*",
"planned caesarean births")
- })
+})
unplanned_title <- reactive({
if_else(Selected$HBName == "NHS Borders",
"unplanned caesarean births*",
"unplanned caesarean births")
- })
+})
# Insert the right number of plot output objects into the web page
- output$type_of_birth_runcharts <- renderUI({
+
+output$type_of_birth_runcharts <- renderUI({
+
+ tagList(
+ fluidRow(
+ column(4,
+ h4("caesarean births"),
+ plotlyOutput(type_of_birthplotListNames[1])
+ ),
+ column(4,
+ h4(planned_title()),
+ plotlyOutput(type_of_birthplotListNames[3])
+ ),
+ column(4,
+ h4(unplanned_title()),
+ plotlyOutput(type_of_birthplotListNames[5])
+ )
+ ), # fluidRow
- tagList(
- fluidRow(
- column(4,
- h4("caesarean births"),
- plotlyOutput(type_of_birthplotListNames[1])
- ),
- column(4,
- h4(planned_title()),
- plotlyOutput(type_of_birthplotListNames[3])
- ),
- column(4,
- h4(unplanned_title()),
- plotlyOutput(type_of_birthplotListNames[5])
- )
- ), # fluidRow
-
- br(),
-
- fluidRow(
- column(4,
- h4( "assisted vaginal births (includes forceps, ventouse and vaginal breech births)"),
- plotlyOutput(type_of_birthplotListNames[2])
- ),
- column(7,
- h4( "spontaneous vaginal births"),
- br(),
- plotlyOutput(type_of_birthplotListNames[4])
- )
- ) # fluidRow
- )
- })
+ br(),
+
+ fluidRow(
+ column(4,
+ h4( "assisted vaginal births (includes forceps, ventouse and vaginal breech births)"),
+ plotlyOutput(type_of_birthplotListNames[2])
+ ),
+ column(7,
+ h4( "spontaneous vaginal births"),
+ br(),
+ plotlyOutput(type_of_birthplotListNames[4])
+ )
+ ) # fluidRow
+ )
+})
for (i in 1:max_plots_type_of_birth) {
# Need local so that each item gets its own number. Without it, the value
@@ -123,13 +124,13 @@ for (i in 1:max_plots_type_of_birth) {
output[[plotname]] <- renderPlotly({
creates_runcharts(plotdata = type_of_birth_runchart_data()[[my_i]]) %>%
layout(xaxis = list(#dtick = "6",
- tickangle = -45),
- yaxis = list(range = c(0, y_max_type_of_birth * 1.05)), # forces y axis to same value on all charts
- legend = list(orientation = "v",
- x = 1.2,
- y = 0.5,
- xref = "container",
- xanchor = "left"))
+ tickangle = -45),
+ yaxis = list(range = c(0, y_max_type_of_birth * 1.05)), # forces y axis to same value on all charts
+ legend = list(orientation = "v",
+ x = 1.2,
+ y = 0.5,
+ xref = "container",
+ xanchor = "left"))
})
})
}
diff --git a/app.R b/app.R
index ce47798..b921a97 100755
--- a/app.R
+++ b/app.R
@@ -2361,6 +2361,13 @@ type_of_birth <- tabItem(
),
+ column(12,
+ p(textOutput("Borders_caesarean_footnote3") %>%
+ tagAppendAttributes(style = "font-size:14px;
+ text-align: left;")
+ )
+ ),
+
column(12,
p(paste0("Data refreshed on ", pretty_refresh_date, "."),
class = "notes-style"
@@ -4096,16 +4103,16 @@ server <- function(input, output, session) {
output$Borders_caesarean_footnote1 <- renderText({
if(grepl("planned", input$tob)) {
- "* Data for NHS Borders for elective and emergency caesarean sections show some unusual patterns from April 2022 to date. We have been liaising with NHS Borders and believe this to be a recording issue rather than a true reflection of the numbers. We are working with the board to try to further understand and rectify the issue."
+ "* Data for NHS Borders for planned and unplanned caesarean births show some unusual patterns from April 2022 to date. We have been liaising with NHS Borders and believe this to be a recording issue rather than a true reflection of the numbers. We are working with the board to try to further understand and rectify the issue."
}
})
)
# footnote for Type of Birth - Individual Board - Borders caesarean anomolies
- output$Borders_caesarean_footnote2 <- renderText({
+ output$Borders_caesarean_footnote2 <- output$Borders_caesarean_footnote3 <- renderText({
if(input$hbname == "NHS Borders") {
- "* Data for NHS Borders for elective and emergency caesarean sections show some unusual patterns from April 2022 to date. We have been liaising with NHS Borders and believe this to be a recording issue rather than a true reflection of the numbers. We are working with the board to try to further understand and rectify the issue."
+ "* Data for NHS Borders for planned and unplanned caesarean births show some unusual patterns from April 2022 to date. We have been liaising with NHS Borders and believe this to be a recording issue rather than a true reflection of the numbers. We are working with the board to try to further understand and rectify the issue."
}
})
diff --git a/functions.R b/functions.R
index f396a00..9a6f4b3 100755
--- a/functions.R
+++ b/functions.R
@@ -807,7 +807,7 @@ creates_runcharts <- function(plotdata,
font = plotly_global_font,
xaxis = xaxis_plots,
yaxis = yaxis_plots,
- legend = list(title = list(text = paste0(legend_board_name, "
")), #plotdata$hbname
+ legend = list(title = list(text = paste0(legend_board_name, "
")),
tracegroupgap = 15,
orientation = "v",
x = 1.0,
@@ -939,6 +939,8 @@ creates_context_charts <- function(plotdata,
den_hover = "mytext2",
yaxislabel = "Number of births"){
+ plotdata <- droplevels(plotdata) # drop unused factor levels
+
y_max <- max(plotdata$den, na.rm = TRUE) # allows a margin to be set around y-axis
# include_legend = TRUE for ONE of multiple runcharts (otherwise the legends get repeated)
@@ -981,6 +983,16 @@ creates_context_charts <- function(plotdata,
"GESTATION AT BIRTH" = SMR02_multiples_date_ticktext,
"APGAR5" = SMR02_date_ticktext
)
+
+ # adds an asterisk to these Board names when there is a related footnote to show
+
+ legend_board_name <- if_else(
+ (first(plotdata$measure == "TYPE OF BIRTH") &
+ first(plotdata$hbname == "NHS Borders")
+ ),
+ paste0(first(plotdata$hbname), "*"),
+ first(plotdata$hbname)
+ )
xaxis_plots <- orig_xaxis_plots
xaxis_plots[["tickmode"]] <- "array"
@@ -1046,7 +1058,7 @@ context_charts <-
xaxis = xaxis_plots,
yaxis = yaxis_plots,
legend = list(
- title = list(text = paste0(plotdata$hbname, "
")),
+ title = list(text = paste0(legend_board_name, "
")),
orientation = "v",
x = 1.0,
y = 0.5,