Skip to content

Commit

Permalink
Merge pull request #11 from Public-Health-Scotland/Borders_caesarean_…
Browse files Browse the repository at this point in the history 
…note

Borders caesarean note
  • Loading branch information
@bevthewitch
bevthewitch authored May 30, 2024
2 parents e3bcc7e + f168832 commit 7d4eb87
Show file tree
Hide file tree
Showing 12 changed files with 362 additions and 244 deletions.
4 changes: 0 additions & 4 deletions .rscignore
View file

This file was deleted.

216 changes: 114 additions & 102 deletions Gestation at birth/Gestation at birth context charts.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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,
"<br>",
"Number of singleton live births with a known gestation (18-44 weeks)",
": ",
prettyNum(num, big.mark = ",")
),
paste0("Quarter: ",
quarter_label,
"<br>",
"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,
"<br>",
"Number of singleton live births with a known gestation (18-44 weeks)",
": ",
prettyNum(num, big.mark = ",")
),
paste0("Quarter: ",
quarter_label,
"<br>",
"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, "<br>")),
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, "<br>")), # 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)
})


4 changes: 2 additions & 2 deletions Multi indicator overview/Multi indicator overview chart.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ output$multi_indicator_chart <- renderPlotly({
if(Selected$HBName %in% island_names){ # Orkney, Shetland, Western Isles
!hbname %in% c("Scotland",
as.character(Selected$HBName),
"NHS Orkney, NHS Shetland and NHS Western Isles*")
"NHS Orkney, NHS Shetland and NHS Western Isles")
} else {
!hbname %in% c("Scotland",
Selected$HBName)
Expand Down Expand Up @@ -140,7 +140,7 @@ output$multi_indicator_chart <- renderPlotly({
fig %>%

add_markers(data = filter(multi_indicator_chart_data(),
hbname == "NHS Orkney, NHS Shetland and NHS Western Isles*" # dots for Island Boards (av gest at termination)
hbname == "NHS Orkney, NHS Shetland and NHS Western Isles" # dots for Island Boards (av gest at termination)
),
x = ~ RESCALED,
y = ~ label,
Expand Down
2 changes: 1 addition & 1 deletion Multi indicator overview/Multi indicator overview table.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,7 @@ multi_indicator_table_data_hb <- reactive({
date == Selected$Date &
hbtype == Selected$HBType &
if(Selected$HBName %in% island_names) {
hbname == "NHS Orkney, NHS Shetland and NHS Western Isles*" |
hbname == "NHS Orkney, NHS Shetland and NHS Western Isles" |
hbname == Selected$HBName
} else { hbname == Selected$HBName
}
Expand Down
16 changes: 11 additions & 5 deletions Terminations/Average gestation at termination runcharts.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ gest_at_termination_runchart_data <- reactive({
req(input$hbname)

Selected$HBName_terminations <- if_else(input$hbname %in% island_names,
"NHS Orkney, NHS Shetland and NHS Western Isles*",
"NHS Orkney, NHS Shetland and NHS Western Isles",
input$hbname)

data <- gest_at_termination_data %>%
Expand Down Expand Up @@ -62,9 +62,15 @@ creates_runcharts(plotdata = gest_at_termination_runchart_data(),
# c) chart title ----

output$gest_at_terminaton_runcharts_title <- renderText({
paste0("Board of ",
str_to_sentence(input$organisation),
": ",
Selected$HBName_terminations
if_else(input$hbname %in% island_names,
paste0("Board of ",
str_to_sentence(input$organisation),
": ",
Selected$HBName_terminations,
"*"),
paste0("Board of ",
str_to_sentence(input$organisation),
": ",
input$hbname)
)
})
8 changes: 4 additions & 4 deletions Terminations/Average gestation at termination small multiples.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,14 +4,14 @@ gest_at_termination_small_multiples_data <- reactive({
# selects data

req(input$organisation)

data <- gest_at_termination_data %>%
filter(hbtype == Selected$HBType) %>%
mutate(hbname2 = if_else(hbname == "NHS Orkney, NHS Shetland and NHS Western Isles*",
mutate(hbname2 = if_else(hbname == "NHS Orkney, NHS Shetland and NHS Western Isles",
"NHS Orkney, NHS Shetland <br> and NHS Western Isles*",
hbname),
hbname2 = factor(hbname2,
levels = HBnames_alternative), # includes grouped Island Boards),
levels = HBnames),
mytext = paste0(hbname,
"<br>",
"Month: ",
Expand All @@ -25,7 +25,7 @@ gest_at_termination_small_multiples_data <- reactive({
" weeks"
),
hbgroup = factor(
if_else(hbname == "NHS Orkney, NHS Shetland and NHS Western Isles*", "island", "mainland"),
if_else(hbname == "NHS Orkney, NHS Shetland and NHS Western Isles", "island", "mainland"),
levels = c("mainland", "island"), ordered = TRUE)
) %>%
group_by(hbgroup, hbtype) %>%
Expand Down
Loading

0 comments on commit 7d4eb87

Please sign in to comment.