get_map_plot <- function(data_object, input, indicator_definition) {
mapdata <- (download_map_data("countries/nz/nz-all"))
test_data <- data.frame(
region = REGION_LABELS,
value = 1:(length(REGION_LABELS)),
stringsAsFactors = FALSE
)
plot <- highcharter::highchart() %>%
highcharter::hc_add_series_map(mapdata, test_data,
name = "Fake data",
value = "value", joinBy = c("woe-name", "region"),
dataLabels = list(
enabled = TRUE,
format = "{point.name}"
)
) %>%
highcharter::hc_colorAxis(stops = color_stops()) %>%
highcharter::hc_legend(valueDecimals = 0, valueSuffix = "%") %>%
highcharter::hc_mapNavigation(enabled = TRUE)
return(plot)
}
get_time_series_plot <- function(
data_object,
input,
indicator_definition,
type = "line",
stacking = "normal"
) {
group_index <- which(sapply(
indicator_definition$groups,
function(x) x$name) == input$line_selector
)
if (length(group_index) == 0) {
return(NULL)
}
group_definition <- indicator_definition$groups[[group_index]]
if (!is.null(group_definition$format_dates)) {
format_dates <- eval(parse(text = group_definition$format_dates))
}
data <- cbind(data_object$dates, data_object$values)
names(data) <- c("date", data_object$value_names)
if (
!is.null(indicator_definition$include_date_slider) &&
indicator_definition$include_date_slider
) {
range <- input$range_selector
time_range_index <- which(data_object$dates <= range[2] & data_object$dates >= range[1])
} else {
time_range_index <- 1:length(data_object$dates)
}
plot <- highcharter::highchart()
plot <- highcharter::hc_exporting(
plot,
enabled = TRUE,
filename = paste0(input$indicator_selector),
buttons = list(
contextButton = list(
menuItems = list('downloadPNG', 'downloadPDF')
)
)
)
lang <- getOption("highcharter.lang")
lang$numericSymbols <- highcharter::JS("['K','M','B','T']") #Change default the SI prefixes
options(highcharter.lang = lang)
dates <- data_object$dates[time_range_index]
year_label <- ""
if (length(dates) == 0) {
return(NULL)
}
duration <- abs(as.numeric(difftime(
dates[[1]],
dates[[length(dates)]],
units = c("days")
)))
if (duration < 7 & length(dates) > 7) {
categories <- format(dates, "%d-%b %H:%M")
} else if (length(unique(lubridate::year(dates))) == 1) {
year_label <- paste0("(", lubridate::year(dates)[[1]], ")")
categories <- format(dates, "%d-%b")
} else if (duration < 360) {
categories <- format(dates, "%d-%b-%y")
} else {
categories <- format(dates, "%b-%y")
}
if (all(data_object$value_names %in% 2010:2030)) {
year_label <- ""
categories <- format(dates, "%d-%b")
}
if (!is.null(indicator_definition$frequency)) {
if (indicator_definition$frequency %in% c("Monthly", "Quarterly")) {
categories <- format(dates, "%b-%Y")
if (!is.null(group_definition$x_axis_label)) {
year_label <- group_definition$x_axis_label
} else {
year_label <- NULL
}
}
}
if (!is.null(group_definition$x_axis_label)) {
year_label <- paste0(year_label, group_definition$x_axis_label)
}
if (!is.null(group_definition$format_dates)) {
categories <- format_dates(dates)
}
norm_factor_and_unit <- get_normalisation_factor(!is.na(data_object$values))
if (!is.null(group_definition$visible)) {
visible <- data_object$value_names %in% group_definition$visible
} else if (!is.null(group_definition$non_visible)) {
visible <- !(data_object$value_names %in% group_definition$non_visible)
}
else {
visible <- rep(TRUE, length(data_object$value_names))
}
for (i in 1:length(data_object$value_names)) {
if ("data.table" %in% class(data_object$values) && F) {
time_series_data <- (data_object$values[, ..i][[1]])[time_range_index]
} else {
time_series_data <- data_object$values[, i][time_range_index]
}
plot <- plot %>% highcharter::hc_add_series(
round(time_series_data / norm_factor_and_unit$factor, norm_factor_and_unit$digits),
name = data_object$value_names[[i]],
showInLegend = TRUE,
type = type,
visible = visible[[i]]
)
}
title <- group_definition$title
plot <- plot %>% highcharter::hc_title(
text = render_title(title),
style = list( color = "black", fontWeight = "bold", fontFamily = "Source Sans Pro")
)
y_label <- group_definition$units
if (!is.null(group_definition$x_axis_label)) {
year_label <- group_definition$x_axis_label
}
else{
year_label <- NULL
}
if (!is.null(group_definition$include_quarters)) {
df_quarters <- data.frame(categories = data_object$dates)
df_quarters$quarters <- lubridate::quarter(df_quarters$categories, with_year = TRUE)
df_quarters$quarters <- stringr::str_replace(as.character(df_quarters$quarters), "\\.", "\\.Q")
df_quarters$categories <- format_dates(df_quarters$categories)
categories_grouped <- df_quarters %>%
group_by(name = quarters) %>%
do(categories = as.list(.$categories)) %>%
list_parse()
plot <- highcharter::hc_xAxis(
plot,
categories = categories_grouped,
title = list(
text = year_label,
style = list(fontSize = "12px", color = "black", fontFamily = "Source Sans Pro")
),
labels = list(
style = list(
fontSize = "12px",
color = "black",
fontFamily = "Source Sans Pro",
textOverflow = 'none'
)
)
) %>%
highcharter::hc_add_dependency("plugins/grouped-categories.js")
} else {
plot <- highcharter::hc_xAxis(
plot,
categories = categories,
title = list(
text = year_label,
style = list(fontSize = "20px", color = "black", fontFamily = "Source Sans Pro")
),
labels = list(
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro",
textOverflow = 'none'
)
),
tickInterval = ceiling(length(categories) / 8)
)
}
tool_tip <- get_tool_tip(group_definition$units)
plot <- plot %>%
highcharter::hc_yAxis(
title = list(
text = paste(y_label, norm_factor_and_unit$unit),
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro"
)
),
labels = list(
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro"
)
)
) %>%
highcharter::hc_add_theme(
highcharter::hc_theme(
chart = list(animation = FALSE, zoomType = "xy")
)
) %>%
highcharter::hc_plotOptions(
bar = list(
dataLabels = list(enabled = FALSE),
enableMouseTracking = TRUE,
animation = FALSE
),
line = list(animation = FALSE),
column = list(
dataLabels = list(enabled = FALSE),
stacking = stacking,
animation = FALSE,
enableMouseTracking = TRUE),
style = list(fontSize = "30px")
) %>%
highcharter::hc_tooltip(
table = TRUE,
sort = TRUE,
pointFormat = paste0(
'<br> <span style="color:{point.color}">\u25CF</span>',
" {series.name}: ",
tool_tip$prefix,
"{point.y} ",
norm_factor_and_unit$unit,
tool_tip$suffix
),
headerFormat = '<span style="font-size: 13px">{point.key}</span>'
) %>%
highcharter::hc_colors(get_brand_colours("graph", 1:9))
if (!is.null(indicator_definition$show_zero) && indicator_definition$show_zero) {
plot <- highcharter::hc_yAxis(plot, min = 0)
}
return(plot)
}
get_stacked_time_series_plot <- function(
data_object,
input,
indicator_definition,
type = "line",
stacking = "normal"
) {
group_index <- which(sapply(
indicator_definition$groups,
function(x) x$name) == input$line_selector
)
if (length(group_index) == 0) {
return(NULL)
}
group_definition <- indicator_definition$groups[[group_index]]
data <- cbind(data_object$categories, data_object$values)
names(data) <- c("categories", data_object$value_names)
plot <- highcharter::highchart()
plot <- highcharter::hc_exporting(
plot,
enabled = TRUE,
filename = paste0(input$indicator_selector),
buttons = list(
contextButton = list(
menuItems = list('downloadPNG', 'downloadPDF')
)
)
)
categories <- data_object$categories
year_label <- ""
norm_factor_and_unit <- get_normalisation_factor(data_object$values)
if (!is.null(group_definition$visible)) {
visible <- data_object$value_names %in% group_definition$visible
} else {
visible <- rep(TRUE, length(data_object$value_names))
}
for (i in 1:length(data_object$value_names)) {
if ("data.table" %in% class(data_object$values) && F) {
time_series_data <- (data_object$values[, ..i][[1]])
} else {
time_series_data <- data_object$values[, i]
}
plot <- plot %>% highcharter::hc_add_series(
data = round(time_series_data / norm_factor_and_unit$factor, norm_factor_and_unit$digits),
name = data_object$value_names[[i]],
showInLegend = TRUE,
type = type,
visible = visible[[i]]
)
}
title <- group_definition$title
plot <- plot %>% highcharter::hc_title(
text = render_title(title),
style = list( color = "black", fontWeight = "bold", fontFamily = "Source Sans Pro")
)
y_label <- group_definition$units
plot <- highcharter::hc_xAxis(
plot,
categories = categories,
title = list(
text = year_label,
style = list(fontSize = "20px", color = "black", fontFamily = "Source Sans Pro")
),
labels = list(style = list(fontSize = "20px", color = "black", fontFamily = "Source Sans Pro")),
tickInterval = ceiling(length(categories) / 8)
)
tool_tip <- get_tool_tip(group_definition$units)
plot <- plot %>%
highcharter::hc_yAxis(
title = list(
text = paste(y_label, norm_factor_and_unit$unit),
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro"
)
),
labels = list(
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro"
)
)
) %>%
highcharter::hc_add_theme(
highcharter::hc_theme(
chart = list(animation = FALSE, zoomType = "xy")
)
) %>%
highcharter::hc_plotOptions(
bar = list(
dataLabels = list(enabled = FALSE),
enableMouseTracking = TRUE,
animation = FALSE
),
line = list(animation = FALSE),
column = list(
dataLabels = list(enabled = FALSE),
stacking = stacking,
animation = FALSE,
enableMouseTracking = TRUE),
style = list(fontSize = "30px")
) %>%
highcharter::hc_tooltip(
table = TRUE,
sort = TRUE,
pointFormat = paste0(
'<br> <span style="color:{point.color}">\u25CF</span>',
" {series.name}: ",
tool_tip$prefix,
"{point.y} ",
norm_factor_and_unit$unit,
tool_tip$suffix
),
headerFormat = '<span style="font-size: 13px">{point.key}</span>'
) %>%
highcharter::hc_colors(get_brand_colours("graph", 1:9))
if (!is.null(indicator_definition$show_zero) && indicator_definition$show_zero) {
plot <- highcharter::hc_yAxis(plot, min = 0)
}
return(plot)
}
get_stacked_bar_chart <- function(data, input, indicator_definition) {
get_time_series_plot(data, input, indicator_definition, type = "column")
}
get_unstacked_bar_chart <- function(data, input, indicator_definition) {
get_time_series_plot(data, input, indicator_definition, type = "column", stacking = NULL)
}
get_bar_chart <- function(
data_object,
input,
indicator_definition,
type,
rotation,
stacking = "normal"
) {
plot <- highcharter::highchart()
group_index <- which(sapply(
indicator_definition$groups,
function(x) x$name) == input$line_selector
)
group_definition <- indicator_definition$groups[[group_index]]
if (!is.null(group_definition$format_dates)) {
format_dates <- eval(parse(text = group_definition$format_dates))
}
plot <- highcharter::highchart()
plot <- highcharter::hc_exporting(
plot,
enabled = TRUE,
filename = paste0(input$indicator_selector),
buttons = list(
contextButton = list(
menuItems = list('downloadPNG', 'downloadPDF')
)
)
)
categories <- data_object$categories
if (length(categories) == 1) {
categories <- rep(categories, 2)
}
label_suffix <- ""
if (!is.null(group_definition$format_dates)) {
categories <- format_dates(dates)
}
norm_factor_and_unit <- get_normalisation_factor(data_object$values)
if (!is.null(group_definition$visible)) {
visible <- data_object$value_names %in% group_definition$visible
} else {
visible <- rep(TRUE, length(data_object$value_names))
}
for (i in 1:length(data_object$value_names)) {
if ("data.table" %in% class(data_object$values) && F) {
time_series_data <- (data_object$values[, ..i][[1]])
} else {
time_series_data <- data_object$values[, i]
}
plot <- plot %>% highcharter::hc_add_series(
round(time_series_data / norm_factor_and_unit$factor, norm_factor_and_unit$digits),
name = data_object$value_names[[i]],
showInLegend = TRUE,
type = type,
visible = visible[[i]]
)
}
title <- group_definition$title
plot <- plot %>% highcharter::hc_title(
text = render_title(title),
style = list( color = "black", fontWeight = "bold", fontFamily = "Source Sans Pro")
)
y_label <- group_definition$units
if (!is.null(group_definition$x_axis_label)) {
x_label <- group_definition$x_axis_label
} else {
x_label <- NULL
}
categories <-
if (label_suffix != "") {
plot <- highcharter::hc_xAxis(
plot,
title = list(
text = paste(x_label),
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro"
)
),
categories = categories,
labels = list(
style = list(
fontSize = "14px",
color = "black",
fontFamily = "Source Sans Pro"
),
step = 1,
rotation = rotation
)
)
} else {
plot <- highcharter::hc_xAxis(
plot,
title = list(
text = paste(x_label),
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro"
)
),
categories = categories,
labels = list(
style = list(
fontSize = "14px",
color = "black",
fontFamily = "Source Sans Pro"
),
step = 1,
rotation = rotation
)
)
}
tool_tip <- get_tool_tip(group_definition$units)
plot <- plot %>%
highcharter::hc_yAxis(
title = list(
text = paste(y_label, norm_factor_and_unit$unit),
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro"
)
),
labels = list(
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro"
)
)
) %>%
highcharter::hc_add_theme(
highcharter::hc_theme(
chart = list(animation = FALSE, zoomType = "xy")
)
) %>%
highcharter::hc_plotOptions(bar = list(
dataLabels = list(enabled = FALSE),
enableMouseTracking = TRUE,
stacking = stacking,
animation = FALSE),
line = list(animation = FALSE),
column = list(
dataLabels = list(enabled = FALSE),
stacking = stacking,
animation = FALSE,
enableMouseTracking = TRUE),
style = list(fontSize = "30px")
) %>%
highcharter::hc_tooltip(
table = TRUE,
sort = TRUE,
pointFormat = paste0(
'<br> <span style="color:{point.color}">\u25CF</span>',
" {series.name}: ",
tool_tip$prefix,
"{point.y} ",
norm_factor_and_unit$unit,
tool_tip$suffix
),
headerFormat = '<span style="font-size: 13px">{point.key}</span>'
) %>%
highcharter::hc_colors(get_brand_colours("graph", 1:9))
if (!is.null(indicator_definition$show_zero) && indicator_definition$show_zero) {
plot <- highcharter::hc_yAxis(plot, min = 0)
}
return(plot)
}
get_vertical_bar <- function(data, input, indicator_definition) {
get_bar_chart(data, input, indicator_definition, type = "column", rotation = -45)
}
get_unstacked_vertical_bar <- function(data, input, indicator_definition) {
group_index <- which(sapply(
indicator_definition$groups,
function(x) x$name) == input$line_selector
)
if (length(group_index) == 0) {
return(NULL)
}
group_definition <- indicator_definition$groups[[group_index]]
if (!is.null(group_definition$rotation)) {
rotation <- group_definition$rotation
} else {
rotation <- -45
}
get_bar_chart(
data,
input,
indicator_definition,
type = "column",
rotation = rotation,
stacking = NULL
)
}
get_horizontal_bar <- function(data, input, indicator_definition) {
get_bar_chart(data, input, indicator_definition, type = "bar", rotation = 0)
}
get_unstacked_horizontal_bar <- function(data, input, indicator_definition) {
get_bar_chart(data, input, indicator_definition, type = "bar", rotation = 0, stacking = NULL)
}
get_time_series_plot_with_errors <- function(
data_object,
input,
indicator_definition,
type = "line",
stacking = "normal"
) {
group_index <- which(sapply(
indicator_definition$groups,
function(x) x$name) == input$line_selector
)
if (length(group_index) == 0) {
return(NULL)
}
group_definition <- indicator_definition$groups[[group_index]]
if (!is.null(group_definition$format_dates)) {
format_dates <- eval(parse(text = group_definition$format_dates))
}
data <- cbind(data_object$dates, data_object$values, data_object$lower, data_object$upper)
names(data) <- c(
"date",
data_object$value_names,
paste0(data_object$value_names, "_lower"),
paste0(data_object$value_names, "_upper")
)
if (!is.null(indicator_definition$include_date_slider) &&
indicator_definition$include_date_slider) {
range <- input$range_selector
time_range_index <- which(data_object$dates <= range[2] & data_object$dates >= range[1])
} else {
time_range_index <- 1:(length(data_object$dates))
}
plot <- highcharter::highchart()
plot <- highcharter::hc_exporting(
plot,
enabled = TRUE,
filename = paste0(input$indicator_selector),
buttons = list(
contextButton = list(
menuItems = list('downloadPNG', 'downloadPDF')
))
)
dates <- data_object$dates[time_range_index]
year_label <- ""
if (length(dates) == 0) {
return(NULL)
}
duration <- abs(as.numeric(difftime(
dates[[1]],
dates[[length(dates)]],
units = c("days")
)))
if (duration < 7 & length(dates) > 7) {
categories <- format(dates, "%d-%b %H:%M")
} else if (length(unique(lubridate::year(dates))) == 1) {
year_label <- paste0("(", lubridate::year(dates)[[1]], ")")
categories <- format(dates, "%d-%b")
} else if (duration < 360) {
categories <- format(dates, "%d-%b-%y")
} else {
categories <- format(dates, "%b-%y")
}
if (all(data_object$value_names %in% 2010:2030)) {
year_label <- ""
categories <- format(dates, "%d-%b")
}
if (!is.null(group_definition$format_dates)) {
categories <- format_dates(dates)
}
if (!is.null(indicator_definition$frequency)) {
if (indicator_definition$frequency %in% c("Monthly", "Quarterly")) {
categories <- format(dates, "%b-%Y")
categories <- rep(categories, 2)
if (!is.null(group_definition$x_axis_label)) {
year_label <- group_definition$x_axis_label
}
else{
year_label <- NULL
}
}
}
norm_factor_and_unit <- get_normalisation_factor(data_object$values)
tool_tip <- get_tool_tip(group_definition$units)
if (!is.null(group_definition$visible)) {
visible <- data_object$value_names %in% group_definition$visible
} else {
visible <- rep(TRUE, length(data_object$value_names))
}
for (i in 1:length(data_object$value_names)) {
time_series_data <- data_object$values[, i][time_range_index]
error_limits <- as.data.frame(
list(
low = data_object$lower[, i][time_range_index],
high = data_object$upper[, i][time_range_index])
)
plot <- plot %>%
highcharter::hc_add_series(
round(time_series_data / norm_factor_and_unit$factor, norm_factor_and_unit$digits),
name = data_object$value_names[[i]],
showInLegend = TRUE,
type = type,
visible = visible[[i]],
tooltip = list(
table = TRUE,
sort = TRUE,
pointFormat = paste0(
'<br> <span style="color:{point.color}">\u25CF</span>',
" {series.name}: ",
tool_tip$prefix,
"{point.y} ",
norm_factor_and_unit$unit,
tool_tip$suffix
),
headerFormat = '<span style="font-size: 13px">{point.key}</span>'
)
) %>%
highcharter::hc_add_series(
data = list_parse(round(error_limits, 1)),
type = "errorbar",
color = "black",
name = paste(data_object$value_names[[i]], "- error"),
tooltip = list(
table = TRUE,
sort = TRUE,
pointFormat = paste0(
'<br> <span style="color:{point.color}">\u25CF</span>',
" {series.name}: ",
tool_tip$prefix,
"{point.low}-{point.high}",
norm_factor_and_unit$unit,
tool_tip$suffix
),
headerFormat = '<span style="font-size: 13px">{point.key}</span>'
)
)
}
title <- group_definition$title
plot <- plot %>% highcharter::hc_title(
text = render_title(title),
style = list( color = "black", fontWeight = "bold", fontFamily = "Source Sans Pro")
)
y_label <- group_definition$units
if (!is.null(group_definition$x_axis_label)) {
year_label <- group_definition$x_axis_label
}
else{
year_label <- NULL
}
plot <- highcharter::hc_xAxis(
plot,
categories = categories,
title = list(
text = year_label,
style = list(fontSize = "20px", color = "black", fontFamily = "Source Sans Pro")
),
labels = list(style = list(fontSize = "20px", color = "black", fontFamily = "Source Sans Pro")),
tickInterval = ceiling(length(categories) / 8)
)
plot <- plot %>%
highcharter::hc_yAxis(
title = list(
text = paste(y_label, norm_factor_and_unit$unit),
style = list(fontSize = "20px", color = "black", fontFamily = "Source Sans Pro")
),
labels = list(
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro"
)
)
) %>%
highcharter::hc_add_theme(
highcharter::hc_theme(
chart = list(animation = FALSE, zoomType = "xy")
)
) %>%
highcharter::hc_plotOptions(bar = list(
dataLabels = list(enabled = FALSE),
enableMouseTracking = TRUE,
animation = FALSE),
line = list(animation = FALSE),
column = list(
dataLabels = list(enabled = FALSE),
stacking = stacking,
animation = FALSE,
enableMouseTracking = TRUE),
style = list(fontSize = "30px")
) %>%
highcharter::hc_tooltip(table = TRUE) %>%
highcharter::hc_colors(get_brand_colours("graph", 1:9))
if (!is.null(indicator_definition$show_zero) && indicator_definition$show_zero) {
plot <- highcharter::hc_yAxis(plot, min = 0)
}
return(plot)
}
get_unstacked_bar_chart_with_errors <- function(data, input, indicator_definition) {
get_time_series_plot_with_errors(
data,
input,
indicator_definition,
type = "column",
stacking = NULL
)
}
get_unstacked_vertical_bar_with_errors <- function(data, input, indicator_definition) {
get_bar_chart_with_errors(
data,
input,
indicator_definition,
type = "column",
rotation = -45,
stacking = NULL
)
}
get_bar_chart_with_errors <- function(
data_object,
input,
indicator_definition,
type,
rotation,
stacking = "normal"
) {
plot <- highcharter::highchart()
group_index <- which(sapply(
indicator_definition$groups,
function(x) x$name) == input$line_selector
)
group_definition <- indicator_definition$groups[[group_index]]
plot <- highcharter::highchart()
data <- cbind(data_object$dates, data_object$values, data_object$lower, data_object$upper)
names(data) <- c(
"parameter",
data_object$value_names,
paste0(data_object$value_names, "_lower"),
paste0(data_object$value_names, "_upper")
)
if (!is.null(indicator_definition$include_date_slider) &&
indicator_definition$include_date_slider) {
range <- input$range_selector
time_range_index <- which(data_object$dates <= range[2] & data_object$dates >= range[1])
} else {
time_range_index <- 1:(length(data_object$dates))
}
plot <- highcharter::hc_exporting(
plot,
enabled = TRUE,
filename = paste0(input$indicator_selector),
buttons = list(
contextButton = list(
menuItems = list('downloadPNG', 'downloadPDF')
)
)
)
categories <- data$parameter
label_suffix <- ""
norm_factor_and_unit <- get_normalisation_factor(data_object$values)
tool_tip <- get_tool_tip(group_definition$units)
if (!is.null(group_definition$visible)) {
visible <- data_object$value_names %in% group_definition$visible
} else {
visible <- rep(TRUE, length(data_object$value_names))
}
for (i in 1:length(data_object$value_names)) {
if ("data.table" %in% class(data_object$values) && F) {
time_series_data <- (data_object$values[, ..i][[1]])
} else {
time_series_data <- data_object$values[, i]
}
error_limits <- as.data.frame(
list(
low = data_object$lower[, i][time_range_index],
high = data_object$upper[, i][time_range_index])
)
plot <- plot %>% highcharter::hc_add_series(
round(time_series_data / norm_factor_and_unit$factor, norm_factor_and_unit$digits),
name = data_object$value_names[[i]],
showInLegend = TRUE,
type = type,
visible = visible,
tooltip = list(
table = TRUE,
sort = TRUE,
pointFormat = paste0(
'<br> <span style="color:{point.color}">\u25CF</span>',
" {series.name}: ",
tool_tip$prefix,
"{point.y} ",
norm_factor_and_unit$unit,
tool_tip$suffix
),
headerFormat = '<span style="font-size: 13px">{point.key}</span>'
)
) %>%
highcharter::hc_add_series(
data = list_parse(round(error_limits, 1)),
type = "errorbar",
color = "black",
name = paste(data_object$value_names[[i]], "- error"),
tooltip = list(
table = TRUE,
sort = TRUE,
pointFormat = paste0(
'<br> <span style="color:{point.color}">\u25CF</span>',
" {series.name}: ",
tool_tip$prefix,
"{point.low}-{point.high}",
norm_factor_and_unit$unit,
tool_tip$suffix
),
headerFormat = '<span style="font-size: 13px">{point.key}</span>'
)
)
}
title <- group_definition$title
plot <- plot %>% highcharter::hc_title(
text = render_title(title),
style = list( color = "black", fontWeight = "bold", fontFamily = "Source Sans Pro")
)
y_label <- group_definition$units
if (!is.null(group_definition$x_axis_label)) {
x_label <- group_definition$x_axis_label
} else {
x_label <- NULL
}
categories <-
if (label_suffix != "") {
plot <- highcharter::hc_xAxis(
plot,
title = list(
text = paste(x_label),
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro"
)
),
categories = categories,
labels = list(
style = list(
fontSize = "14px",
color = "black",
fontFamily = "Source Sans Pro"
),
step = 1,
rotation = rotation
)
)
} else {
plot <- highcharter::hc_xAxis(
plot,
title = list(
text = paste(x_label),
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro"
)
),
categories = categories,
labels = list(
style = list(
fontSize = "14px",
color = "black",
fontFamily = "Source Sans Pro"
),
step = 1,
rotation = rotation
)
)
}
tool_tip <- get_tool_tip(group_definition$units)
plot <- plot %>%
highcharter::hc_yAxis(
title = list(
text = paste(y_label, norm_factor_and_unit$unit),
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro"
)
),
labels = list(
style = list(
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro"
)
)
) %>%
highcharter::hc_add_theme(
highcharter::hc_theme(
chart = list(animation = FALSE, zoomType = "xy")
)
) %>%
highcharter::hc_plotOptions(bar = list(
dataLabels = list(enabled = FALSE),
enableMouseTracking = TRUE,
stacking = stacking,
animation = FALSE),
line = list(animation = FALSE),
column = list(
dataLabels = list(enabled = FALSE),
stacking = stacking,
animation = FALSE,
enableMouseTracking = TRUE),
style = list(fontSize = "30px")
) %>%
highcharter::hc_tooltip(
table = TRUE,
sort = TRUE,
pointFormat = paste0(
'<br> <span style="color:{point.color}">\u25CF</span>',
" {series.name}: ",
tool_tip$prefix,
"{point.y} ",
norm_factor_and_unit$unit,
tool_tip$suffix
),
headerFormat = '<span style="font-size: 13px">{point.key}</span>'
) %>%
highcharter::hc_colors(get_brand_colours("graph", 1:9))
if (!is.null(indicator_definition$show_zero) && indicator_definition$show_zero) {
plot <- highcharter::hc_yAxis(plot, min = 0)
}
plot <- highcharter::hc_yAxis(plot, max = max(data_object$values) + 5)
return(plot)
}
get_sankey_diagram <- function(data_object, input, indicator_definition, stacking = "normal") {
group_index <- which(sapply(
indicator_definition$groups,
function(x) x$name) == input$line_selector
)
if (length(group_index) == 0) {
return(NULL)
}
group_definition <- indicator_definition$groups[[group_index]]
data <- cbind(data_object$dates, data_object$values)
names(data) <- c("date", data_object$value_names)
plot <- highcharter::highchart()
plot <- highcharter::hc_exporting(
plot,
enabled = TRUE,
filename = paste0(input$indicator_selector),
buttons = list(
contextButton = list(
menuItems = list('downloadPNG', 'downloadPDF')
)
)
)
if (
!is.null(indicator_definition$include_date_slider) &&
indicator_definition$include_date_slider
) {
range <- input$range_selector
time_range_index <- which(data_object$dates <= range[2] & data_object$dates >= range[1])
} else {
time_range_index <- 1:length(data_object$dates)
}
dates <- data_object$dates[time_range_index]
title <- group_definition$title
tool_tip <- get_tool_tip(group_definition$units)
norm_factor_and_unit <- get_normalisation_factor(data_object$values[[3]])
data <- data %>%
filter(date <= range[2] & date >= range[1]) %>%
group_by(src, destination) %>%
summarise(total = sum(count), .groups = 'drop')
dat <- data.frame(from = data$src, to = data$destination, weight = data$total)
plot <- plot %>%
highcharter::hc_chart(type = 'sankey') %>%
highcharter::hc_add_series(data = dat, name = "Flow") %>%
highcharter::hc_title(
text = render_title(title),
style = list(
color = "black",
fontWeight = "bold",
fontFamily = "Source Sans Pro"
)
) %>%
highcharter::hc_colors(get_brand_colours("graph", 1:9)) %>%
highcharter::hc_plotOptions(sankey = list(
dataLabels = list(
enabled = TRUE,
fontSize = "20px",
color = "black",
fontFamily = "Source Sans Pro",
align = "left",
allowOverlap = TRUE
),
enableMouseTracking = TRUE,
animation = FALSE
),
style = list(fontSize = "30px")) %>%
highcharter::hc_tooltip(
table = TRUE,
sort = TRUE,
pointFormat = paste0(
'<br> <span style="color:{point.color}">\u25CF</span>',
"{point.fromNode.name} → {point.toNode.name}: ",
tool_tip$prefix,
"{point.weight} ",
norm_factor_and_unit$unit,
tool_tip$suffix
),
headerFormat = '<span style="font-size: 13px">{series.name}</span>'
)
return(plot)
}
get_time_series_bar_chart <- function(data_object, input, indicator_definition) {
bar_ind <- unlist(indicator_definition$bar_cols)
lines <- data.frame(categories = data_object$categories)
lines$quarters <- lubridate::quarter(dmy(paste0('01-', lines$categories)), with_year = TRUE)
lines$quarters <- stringr::str_replace(as.character(lines$quarters), "\\.", "\\.Q")
lines$categories <- as.character(lines$categories)
bars <- data_object$clone()
bars <- bars$subset_values(bar_ind)
bars <- bars$subset_value_names(bar_ind)
bars$categories <- as.character(bars$categories)
categories_grouped <- lines %>%
group_by(name = quarters) %>%
do(categories = as.list(.$categories)) %>%
list_parse()
plot <- get_unstacked_vertical_bar(data = bars, input = input,
indicator_definition = indicator_definition)
plot <- plot %>%
highcharter::hc_xAxis(
categories = categories_grouped,
labels = list(
rotation = 0
)
) %>%
highcharter::hc_add_dependency("plugins/grouped-categories.js")
return(plot)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.