R/default_plot_functions.R

Defines functions get_time_series_bar_chart get_sankey_diagram get_bar_chart_with_errors get_unstacked_vertical_bar_with_errors get_unstacked_bar_chart_with_errors get_time_series_plot_with_errors get_unstacked_horizontal_bar get_horizontal_bar get_unstacked_vertical_bar get_vertical_bar get_bar_chart get_unstacked_bar_chart get_stacked_bar_chart get_stacked_time_series_plot get_time_series_plot get_map_plot

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)

}
xaviermiles/portalLite documentation built on Jan. 28, 2022, 9:10 a.m.