R/quick_charts.R

Defines functions area_profiles map box_plots population trends compare_indicators overview compare_areas

Documented in area_profiles box_plots compare_areas compare_indicators map overview population trends

#' Plot compare areas chart
#'
#' Returns ggplot of compare areas chart
#' @return a ggplot of a compare areas chart
#' @param data data.frame object to plot using ggplot2 functions
#' @param area field containing variable to be plotted on y axis (unquoted)
#' @param value field containing variable to be plotted on x axis (unquoted)
#' @param lowerci field containing variable to be plotted as lower confidence
#'   interval (unquoted - not required)
#' @param upperci string; field containing variable to be plotted as upper confidence
#'   interval (unquoted - not required)
#' @param fill field to be used to determine the colouring of the bars (unquoted)
#' @param order one of "alphabetical", "asc" or "desc" - to determine how to
#'   order the bars
#' @param top_areas character vector; the areas to fix at the top of the chart
#' @param title string; title of chart
#' @param xlab string; x-axis title
#' @param ylab string; y-axis title
#' @param legend.position the position of legends ("none", "left", "right",
#'   "bottom", "top", or two-element numeric vector)
#' @param display.values logical; where or not to display the rounded values
#'   next to the bars on the chart
#' @param dps number; number of decimal places to be displayed when
#'   display.values = TRUE. The default is 1.
#' @family quick charts
#' @import ggplot2
#' @import dplyr
#' @importFrom rlang quo_text
#' @examples
#' library(dplyr)
#' df <- create_test_data()
#' parent <- "PAC11"
#' top_names <- c("C001", parent)
#' ordered_levels <- c("Better",
#'                     "Similar",
#'                     "Worse",
#'                     "Not compared")
#' df_ca <- df %>%
#'         filter(IndicatorName == "Indicator 3",
#'                (AreaCode %in% top_names |
#'                         ParentAreaCode == parent))
#' p <- compare_areas(df_ca, AreaCode, Value,
#'                    fill = Significance,
#'                    lowerci = LCI,
#'                    upperci = UCI,
#'                    order = "desc",
#'                    top_areas = top_names,
#'                    title = "Compare the local areas")
#' p
#'
#' @export
compare_areas <- function(data, area, value,
                          lowerci, upperci,
                          fill, order = "desc", top_areas,
                          title = "", xlab = "", ylab = "",
                          legend.position = "bottom",
                          display.values = FALSE,
                          dps = 1) {
        area <- enquo(area)
        value <- enquo(value)
        if (order == "desc") {
                if (!missing(top_areas)) {
                        levels <- data %>%
                                filter(!((!!area) %in% top_areas)) %>%
                                droplevels() %>%
                                arrange(-(!!value)) %>%
                                select(!!area) %>%
                                pull() %>%
                                as.character()
                        levels <- rev(c(top_areas, levels))
                        data <- data %>%
                                mutate(!!quo_name(area) :=
                                               factor((!!area),
                                                      levels = levels))
                } else {
                        levels <- data %>%
                                droplevels() %>%
                                arrange(-(!!value)) %>%
                                select(!!area) %>%
                                pull() %>%
                                as.character() %>%
                                rev()
                        data <- data %>%
                                mutate(!!quo_name(area) :=
                                               factor((!!area),
                                                      levels = levels))

                }
        } else if (order == "asc") {
                if (!missing(top_areas)) {
                        levels <- data %>%
                                filter(!((!!area) %in% top_areas)) %>%
                                droplevels() %>%
                                arrange(!!value) %>%
                                select(!!area) %>%
                                pull() %>%
                                as.character() %>%
                                unique
                        levels <- rev(c(top_areas, levels))
                        data <- data %>%
                                mutate(!!quo_name(area) :=
                                               factor((!!area),
                                                      levels = levels))
                } else {
                        levels <- data %>%
                                droplevels() %>%
                                arrange(!!value) %>%
                                select(!!area) %>%
                                pull() %>%
                                as.character() %>%
                                rev()
                        data <- data %>%
                                mutate(!!quo_name(area) :=
                                               factor((!!area),
                                                      levels = levels))

                }

        }
        if (display.values) data <- data %>%
                mutate(label = round2(!!value, dps),
                       label = formatC(label, format = "f", digits = dps, big.mark = ","))


        compare_areas <- ggplot(data,
                                aes_string(x = quo_text(area),
                                           y = quo_text(value))) +
                coord_flip() +
                labs(title = title,
                     x = ylab,
                     y = xlab)

        if (!missing(fill)) {
                fill <- enquo(fill)
                compare_areas <- compare_areas +
                        geom_col(aes_string(fill = quo_text(fill))) +
                        scale_fill_phe(theme = "fingertips") +
                        labs(fill = "Area compared to Benchmark")

        } else {
                compare_areas <- compare_areas +
                        geom_col()
        }
        if (!missing(lowerci) & !missing(upperci)) {
                lowerci <- enquo(lowerci)
                upperci <- enquo(upperci)
                compare_areas <- compare_areas +
                        geom_errorbar(aes_string(ymin = quo_text(lowerci),
                                                 ymax = quo_text(upperci)),
                                      width=.2, show.legend = FALSE)
        }
        if (display.values) {
                if (!missing(upperci)) {
                        upperci <- enquo(upperci)
                        label_position <- data %>%
                                filter((!!upperci) == max((!!upperci), na.rm = TRUE)) %>%
                                pull(!!upperci)
                } else {
                        label_position <- data %>%
                                filter((!!value) == max((!!value), na.rm = TRUE)) %>%
                                pull(!!value)
                }
                adjust_factor <- 25
                label_position <- label_position / -adjust_factor
                scale_adjust <- 1.05 * (label_position * -adjust_factor) - (label_position * -adjust_factor)
                compare_areas <- compare_areas +
                        geom_text(aes(label = label),
                                  hjust = 1,
                                  y = label_position / 2) +
                        scale_y_continuous(limits = c(label_position - scale_adjust,
                                                      (label_position * -adjust_factor) + scale_adjust))
        }
        compare_areas <- compare_areas +
                theme_phe("fingertips") +
                theme(legend.position = legend.position,
                      panel.grid.major.y = element_blank())
        return(compare_areas)
}

#' Plot an overview (tartan rug) of multiple indicators
#'
#' @return a ggplot of the overview/tartan rug plot
#' @inheritParams compare_areas
#' @param area field containing area names (unquoted)
#' @param indicator field containing indicator names (unquoted)
#' @param value field containing variable to be plotted (unquoted)
#' @param timeperiod field containing the time period (unquoted)
#' @param top_areas character vector; the areas to fix at the left
#' @param wrap_length number; maximum number of characters in indicator before
#'   wrapping it
#' @param value_label_size number; amount to scale the size of the value label
#' @param legend_position the position of legends ("none", "left", "right",
#'   "bottom", "top", or two-element numeric vector)
#' @family quick charts
#' @import ggplot2
#' @import dplyr
#' @importFrom rlang quo_text
#' @importFrom stringr str_wrap
#' @examples
#' library(dplyr)
#' df <- create_test_data()
#'
#' parent <- "PAC14"
#' top_names <- c("C001", parent)
#' df_over <- df %>%
#'         filter((AreaCode %in% top_names |
#'                         ParentAreaCode == parent)) %>%
#'         mutate(Value = round(Value, 1))
#' p <- overview(df_over,
#'               area = AreaCode,
#'               indicator = IndicatorName,
#'               value = Value,
#'               timeperiod = Timeperiod,
#'               fill = Significance,
#'               top_areas = top_names,
#'               wrap_length = 40,
#'               value_label_size = 0.8)
#' p
#' @export
overview <- function(data, area, indicator, value,
                     fill, timeperiod, top_areas, wrap_length = 50,
                     value_label_size = 1, legend_position = "none") {


        if (!missing(top_areas)) {
                levels <- data %>%
                        filter(!(({{ area }}) %in% top_areas)) %>%
                        droplevels() %>%
                        arrange(({{ area }})) %>%
                        select({{ area }}) %>%
                        pull() %>%
                        as.character() %>%
                        unique()
                levels <- c("Period", top_areas, levels)
                data <- data %>%
                        mutate(!!quo_name(enquo(area)) :=
                                       factor(({{ area }}),
                                              levels = levels))
        } else {
                levels <- data %>%
                        droplevels() %>%
                        arrange({{ area }}) %>%
                        select({{ area }}) %>%
                        pull() %>%
                        as.character() %>%
                        unique()
                data <- data %>%
                        mutate(!!quo_name(enquo(area)) :=
                                       factor(({{ area }}),
                                              levels = c("Period", levels)))
        }
        tp <- data %>%
                filter(({{ area }}) == levels[2]) %>%
                mutate(!!quo_name(enquo(area)) := "Period",
                       !!quo_name(enquo(fill)) := NA,
                       !!quo_name(enquo(value)) :=
                               as.character(str_wrap(({{ timeperiod }}), 9)))


        data <- rbind(data, tp)
        levels <- data %>%
                droplevels() %>%
                arrange({{ indicator }}) %>%
                select({{ indicator }}) %>%
                pull() %>%
                as.character() %>%
                rev() %>%
                unique() %>%
                str_wrap(wrap_length)
        data <- data %>%
                mutate(!!quo_name(enquo(indicator)) :=
                               factor(str_wrap(({{ indicator }}), wrap_length),
                                      levels = levels)) %>%
                droplevels()

        overview <- ggplot(data, aes(x = {{ area }},
                                     y = {{ indicator }})) +
                geom_tile(aes(fill = {{ fill }}),
                          colour = "white") +
                geom_text(aes(label = {{ value }}),
                          size = value_label_size * 4) +
                scale_fill_phe("fingertips",
                               na.translate = FALSE,
                               guide = guide_legend(byrow = TRUE)) +
                scale_x_discrete(position = "top") +
                theme(legend.position = legend_position,
                      axis.text.x = element_text(angle = 90,
                                                 hjust = 0),
                      axis.text.y = element_text(size = rel(1)),
                      axis.title = element_blank(),
                      line = element_blank(),
                      rect = element_blank())
        return(overview)
}

#' Plot compare indicators plot
#'
#' @return a ggplot of compare indicators for 2 indicators
#' @inheritParams compare_areas
#' @param x field containing x variable (unquoted)
#' @param y field containing y variable (unquoted)
#' @param point_size number; size of point
#' @param highlight_area character vector; list of areas for highlighting
#' @param area field containing areas - should contain contents of
#'   highlight_area. Only required if highlight_area has a value (unquoted)
#' @param add_R2 boolean; should R2 be displayed?
#' @family quick charts
#' @import ggplot2
#' @import dplyr
#' @importFrom rlang quo_text
#' @importFrom stats lm as.formula
#' @examples
#' library(tidyr)
#' library(dplyr)
#' df <- create_test_data()
#'
#' df_ci <- df %>%
#'         filter(IndicatorName %in% c("Indicator 1", "Indicator 3")) %>%
#'         select(IndicatorName, AreaCode, Value) %>%
#'         pivot_wider(names_from = IndicatorName,
#'                     values_from = Value) %>%
#'         rename(Ind1 = `Indicator 1`,
#'                Ind3 = `Indicator 3`) %>%
#'         mutate(Ind2 = runif(nrow(.), min = Ind1 * 0.5, max = Ind1 * 1.5))
#' p <- compare_indicators(df_ci,
#'                         x = Ind1,
#'                         y = Ind3,
#'                         xlab = "Indicator 1 label",
#'                         ylab = "Indicator 3 label",
#'                         highlight_area = c("C001", "AC172"),
#'                         area = AreaCode,
#'                         add_R2 = TRUE)
#' p
#' @export
compare_indicators <- function(data, x, y,
                               xlab = "", ylab = "",
                               point_size = 4, highlight_area,
                               area, add_R2 = FALSE) {

        x <- enquo(x)
        y <- enquo(y)

        compare_indicators <- ggplot(data, aes_string(x = quo_text(x),
                                                      y = quo_text(y))) +
                labs(x = xlab,
                     y = ylab) +
                theme(rect = element_blank(),
                      line = element_blank(),
                      panel.grid.major.y = element_line(colour = "#E6E6E6"),
                      legend.position = "none")
        if (!missing(highlight_area)) {
                if (missing(area)){
                        stop("If highlight_area contains a value, so must area_field")
                }
                area <- enquo(area)
                data <- data %>%
                        mutate(highlight = ifelse((!!area) %in% highlight_area, T, F))
                compare_indicators <- compare_indicators +
                        geom_point(data = data,
                                   aes(shape = highlight,
                                       fill = highlight),
                                   size = point_size) +
                        scale_shape_manual(values = c(23, 21),
                                           limits = c(T, F)) +
                        scale_fill_manual(values = c("black", "#7CB5EC"),
                                           limits = c(T, F))
        } else {
                compare_indicators <- compare_indicators +
                        geom_point(shape = 21,
                                   fill = "#7CB5EC",
                                   size = point_size)
        }

        if (add_R2 == TRUE) {
                form <- as.formula(paste(as_label(y), " ~ ", as_label(x)))
                r2 <- summary(lm(form, data = data))
                r2frame <- data.frame(val = ifelse(r2$r.squared > 0.15,
                                                   paste("R^2:",round2(r2$r.squared, 2)),
                                              "R2 below 0.15;\nNot displayed"),
                                 x = -Inf,
                                 y = Inf)
                if (r2$r.squared > 0.15) {
                        compare_indicators <- compare_indicators +
                                geom_text(data = r2frame, aes(x = x,
                                                              y = y,
                                                              label = val),
                                          hjust = 0,
                                          vjust = 1,
                                          parse = TRUE) +
                                geom_abline(intercept = r2$coefficients[1, 1],
                                            slope = r2$coefficients[2, 1],
                                            colour = "#ED1F52")
                } else {
                        compare_indicators <- compare_indicators +
                                geom_text(data = r2frame, aes(x = x,
                                                              y = y,
                                                              label = val),
                                          hjust = 0,
                                          vjust = 1)
                }
        }
        return(compare_indicators)
}

#' Plot trend chart
#'
#' @return a ggplot of trends for an indicator alongside a comparator
#' @inheritParams compare_areas
#' @inheritParams overview
#' @inheritParams compare_indicators
#' @param comparator string; name of comparator area (this should exist in the
#'   field described by the area parameter)
#' @param area_name string; name of the local area (this should exist in the
#'   field described by the area parameter)
#' @param subtitle string; text to use as subtitle to graph
#' @family quick charts
#' @import ggplot2
#' @import dplyr
#' @examples
#' library(dplyr)
#' df <- create_test_data()
#'
#' df_trend <- df %>%
#'         arrange(IndicatorName) %>%
#'         mutate(Timeperiod = rep(c("2011", "2012", "2013", "2014", "2015", "2016"),
#'                                 each = 111))
#' p <- trends(df_trend,
#'             timeperiod = Timeperiod,
#'             value = Value,
#'             area = AreaCode,
#'             comparator = "C001",
#'             area_name = "AC142",
#'             fill = Significance,
#'             lowerci = LCI,
#'             upperci = UCI,
#'             title = "Trend compared to country",
#'             subtitle = "For area AC142",
#'             xlab = "Year",
#'             ylab = "Value (%)")
#' p
#' @export
trends <- function(data, timeperiod, value,
                   area, comparator, area_name, fill,
                   lowerci, upperci,
                   title = "", subtitle = "",
                   xlab = "", ylab = "", point_size = 4) {
        timeperiod <- enquo(timeperiod)
        value <- enquo(value)
        area <- enquo(area)

        data <- data %>%
                filter((!!area) %in% c(area_name, comparator))
        line_colours <- c("black", "#7CB5EC")
        names(line_colours) <- c(comparator, area_name)
        trends <- ggplot(data,
                         aes(x = !!timeperiod,
                             y = !!value,
                             group = !!area)) +
                geom_line(aes(linetype = !!area,
                              colour = !!area)) +
                geom_point(data = filter(data, (!!area) == comparator),
                           fill = "black",
                           aes(shape = !!area),
                           size = point_size) +
                scale_linetype_manual(name = "",
                                      values = rep("solid", 2),
                                      labels = comparator) +
                scale_shape_manual(name = "",
                                   values = 21,
                                   labels = comparator) +
                scale_colour_manual(name = "",
                                    values = line_colours) +
                labs(title = title,
                     subtitle = subtitle,
                     x = xlab,
                     y= ylab) +
                theme_phe("fingertips") +
                theme(legend.position = "bottom")
        if (!missing(fill)) {
                fill <- enquo(fill)
                trends <- trends +
                        geom_point(data = filter(data, (!!area) == area_name),
                                   aes(fill = !!fill),
                                   shape = 21,
                                   size = point_size, show.legend = F) +
                        scale_fill_phe("fingertips")
        } else {
                trends <- trends +
                        geom_point(data = filter(data, (!!area) == area_name),
                                   fill = "#C9C9C9",
                                   shape = 21,
                                   size = point_size, show.legend = F)
        }
        if (!missing(lowerci) & !missing(upperci)) {
                lowerci <- enquo(lowerci)
                upperci <- enquo(upperci)
                trends <- trends +
                        geom_errorbar(data = filter(data, (!!area) == area_name),
                                      aes(ymin= !!lowerci,
                                          ymax = !!upperci),
                                      width=.2)

        }
        trends <- trends +
                guides(shape = FALSE,
                       linetype = FALSE)
        return(trends)
}

#' Plot population pyramid
#'
#' @return a ggplot of a population pyramid against 2 optional comparators
#' @inheritParams compare_areas
#' @inheritParams compare_indicators
#' @inheritParams trends
#' @param sex field containing sex variable (unquoted)
#' @param age field containing age variable (unquoted)
#' @param comparator_1 string; name of comparator area (this should exist in the
#'   field described by the area parameter)
#' @param comparator_2 string; name of comparator area (this should exist in the
#'   field described by the area parameter)
#' @family quick charts
#' @import ggplot2
#' @import dplyr
#' @importFrom rlang quo_text
#' @importFrom scales breaks_pretty
#' @examples
#' library(dplyr)
#' agelevels <- c("0-4", "5-9","10-14","15-19",
#'                "20-24","25-29","30-34",
#'                "35-39","40-44","45-49",
#'                "50-54","55-59","60-64",
#'                "65-69","70-74","75-79",
#'                "80-84","85-89","90+")
#' areas <- c("Area 1", "Area 2", "Area 3")
#' pops <- data.frame(Age = factor(rep(agelevels, length(areas) * 2),
#'                                 levels = agelevels),
#'                    Value = rep(sample(1000:3000, length(agelevels), replace = TRUE),
#'                                length(areas) * 2),
#'                    Sex = rep(rep(c("Male", "Female"),
#'                                  each = length(agelevels)), length(areas)),
#'                    AreaName = rep(areas, each = length(agelevels) * 2))
#'
#' p <- population(pops,
#'                 value = Value,
#'                 sex = Sex,
#'                 age = Age,
#'                 area = AreaName,
#'                 area_name = "Area 1",
#'                 comparator_1 = "Area 3",
#'                 comparator_2 = "Area 2",
#'                 title = "Age Profile",
#'                 subtitle = "2015/16",
#'                 xlab = "% of total population")
#' p
#' @export
population <- function(data, value, sex, age,
                       area, area_name, comparator_1, comparator_2,
                       title, subtitle, xlab) {
        value <- enquo(value)
        sex <- enquo(sex)
        age <- enquo(age)
        area <- enquo(area)

        if(!missing(area_name) &
           !missing(comparator_1) &
           !missing(comparator_2)) {
               areas <- c(area_name, comparator_1, comparator_2)
        } else if (!missing(area_name) &
                   !missing(comparator_1) &
                   missing(comparator_2)) {
                areas <- c(area_name, comparator_1)
        } else if (!missing(area_name) &
                   missing(comparator_1) &
                   missing(comparator_2)) {
                areas <- area_name
        } else {
                stop("area_name must be complete for a population pyramid to be drawn")
        }



        data <- data %>%
                filter((!!area) %in% areas) %>%
                group_by(!!area) %>%
                mutate(!!quo_name(value) :=
                               100 * (!!value) / sum(!!value),
                       !!quo_name(value) :=
                               ifelse((!!sex) == "Male",
                                      -(!!value), (!!value)))
        extremex <- breaks_pretty(n = 3)(0:max(abs(pull(data, !!value)),
                                               na.rm = T))
        population <- ggplot(filter(data, (!!area) == area_name),
                             aes_string(y = quo_text(value),
                                        x = quo_text(age),
                                        fill = quo_text(sex))) +
                geom_col(col = "black", width = 0.7) +
                coord_flip() +
                scale_y_continuous(breaks = c(rev(-extremex), extremex[2:length(extremex)]),
                                   labels = abs(c(rev(extremex), extremex[2:length(extremex)]))) +
                scale_fill_manual(name = "",
                                  values = c("Male" = "#5555E6",
                                             "Female" = "#C2CCFF"),
                                  breaks = c("Male", "Female"),
                                  labels = c(paste(area_name, "(Male)"),
                                             paste(area_name, "(Female)"))) +
                labs(title = title,
                     subtitle = subtitle,
                     y = xlab) +
                theme(legend.position = "bottom",
                      legend.key = element_blank(),
                      axis.title.y = element_blank(),
                      line = element_blank(),
                      rect = element_blank(),
                      panel.grid.major.x = element_line(colour = "gray80"))
        if (!missing(comparator_1)) {
                compdata1 <- filter(data, (!!area) == comparator_1)
                population <- population +
                        geom_line(data = compdata1,
                                  aes_string(y = quo_text(value),
                                             x = quo_text(age),
                                             group = interaction(pull(compdata1, !!sex), pull(compdata1, !!area)),
                                             col = quo_text(area)),
                                  size = 1.5)
                if (!missing(comparator_2)) {
                        compdata2 <- filter(data, (!!area) == comparator_2)
                        population <- population +
                                geom_line(data = compdata2,
                                          aes_string(y = quo_text(value),
                                                     x = quo_text(age),
                                                     group = interaction(pull(compdata2, !!sex), pull(compdata2, !!area)),
                                                     col = quo_text(area)),
                                          size = 1.5) +
                                scale_colour_manual(name = "",
                                                    breaks = c(comparator_1, comparator_2),
                                                    limits = c(comparator_1, comparator_2),
                                                    values = c("black","#E563F9"))

                } else {
                        population <- population +
                                scale_colour_manual(name = "",
                                                    breaks = c(comparator_1),
                                                    limits = c(comparator_1),
                                                    values = c("black"))
                }
        }
        return(population)

}

#' Plot a series of boxplots
#'
#' @return a ggplot of boxplots for many areas over time
#' @inheritParams compare_indicators
#' @inheritParams compare_areas
#' @inheritParams overview
#' @inheritParams trends
#' @family quick charts
#' @import ggplot2
#' @import dplyr
#' @importFrom rlang quo_text
#' @importFrom stats median quantile
#' @examples
#' library(dplyr)
#' df <- create_test_data()
#'
#' df_box <- df %>%
#'         filter(AreaType == "Local") %>%
#'         arrange(IndicatorName) %>%
#'         mutate(Timeperiod = rep(c("2011", "2012", "2013", "2014", "2015", "2016"),
#'                                 each = 100))
#' p <- box_plots(df_box,
#'                timeperiod = Timeperiod,
#'                value = Value,
#'                title = "Title of chart",
#'                subtitle = "Boxplot over time",
#'                ylab = "Proportion (%)")
#' @export
box_plots <- function(data, timeperiod, value,
                      title = "", subtitle = "",
                      xlab = "", ylab = "") {
        timeperiod <- enquo(timeperiod)
        value <- enquo(value)
        data <- data %>%
                group_by(!!timeperiod) %>%
                summarise(y5 = quantile((!!value), 0.05, na.rm = TRUE),
                          y25 = quantile((!!value), 0.25, na.rm = TRUE),
                          y50 = median((!!value), na.rm = TRUE),
                          y75 = quantile((!!value), 0.75, na.rm = TRUE),
                          y95 = quantile((!!value), 0.95, na.rm = TRUE))
        boxplots <- ggplot(data, aes_string(x = quo_text(timeperiod))) +
                geom_boxplot(aes(ymin = y5, lower = y25,
                                 middle = y50, upper = y75,
                                 ymax = y95),
                             fill = "#CCCCCC",
                             stat = "identity") +
                labs(title = title,
                     subtitle = subtitle,
                     x = xlab,
                     y = ylab) +
                theme_phe("fingertips")
        dat <- ggplot_build(boxplots)$data[[1]]

        boxplots <- boxplots +
                geom_segment(data = dat,
                             aes(x = xmin + ((xmax - xmin) * 0.25),
                                 xend = xmin + ((xmax - xmin) * 0.75),
                                 y = ymax,
                                 yend = ymax)) +
                geom_segment(data=dat,
                             aes(x = xmin + ((xmax - xmin) * 0.25),
                                 xend = xmin + ((xmax - xmin) * 0.75),
                                 y = ymin,
                                 yend = ymin)) +
                geom_segment(data=dat,
                             aes(x = xmin,
                                 xend = xmax,
                                 y = middle,
                                 yend = middle),
                             colour="red", size = 1)
        return(boxplots)

}

#' Plot a choropleth map for an indicator
#'
#' @return a either a static or interactive ggplot choropleth map
#' @inheritParams compare_areas
#' @inheritParams trends
#' @param area_code field containing area codes to join to shape file imported
#'   from ONS API
#' @param type string; the output map required. Can be "static" or "interactive"
#' @param ons_api string; GeoJSON address provided from the ONS geography portal
#' @param copyright_size number; fix the size of the copyright text
#' @param copyright_year number (length 4 characters) or Date class; the copyright year
#'   displayed at bottom of the map. Applies to static maps only
#' @param name_for_label if interactive map, name of field containing area names
#'   to be used for label (unquoted) - optional
#' @param fill field to be used to determine the colouring of the areas
#'   (unquoted)
#' @family quick charts
#' @import ggplot2
#' @import dplyr
#' @importFrom rlang quo_text quo sym
#' @importFrom geojsonio geojson_read
#' @importFrom leaflet colorFactor leaflet addTiles addPolygons addLegend
#' @importFrom stats setNames
#' @importFrom sf st_as_sf
#' @examples
#' \dontrun{
#' ons_api <- "https://opendata.arcgis.com/datasets/687f346f5023410ba86615655ff33ca9_4.geojson"
#'
#' p <- map(mapdata,
#'          ons_api = ons_api,
#'          area_code = AreaCode,
#'          fill = Significance,
#'          title = "Map example",
#'          subtitle = "An indicator for Upper Tier Local Authorities England",
#'          copyright_year = 2019)
#'
#' p
#'
#' ## For an interactive (leaflet) map
#' p <- map(mapdata,
#'          ons_api = ons_api,
#'          area_code = AreaCode,
#'          fill = Significance,
#'          type = "interactive",
#'          value = Value,
#'          name_for_label = AreaName,
#'          title = "An indicator for Upper Tier<br>Local Authorities England")
#' p}
#' @export
map <- function(data, ons_api, area_code, fill, type = "static", value, name_for_label,
                title = "", subtitle = "", copyright_size = 4, copyright_year = Sys.Date()) {
        area_code <- enquo(area_code)
        fill <- enquo(fill)
        if (missing(ons_api)) stop("ons_api must contain a string to a geojson url on the ONS geography portal")
        if (ensure_ons_api_available(ons_api)) {
                shp <- geojson_read(ons_api, what = "sp") %>%
                        st_as_sf()
                all_area_codes <- data %>%
                        pull(!!area_code) %>%
                        unique()
                join_field <- vapply(shp, function(x) sum(x %in% all_area_codes),
                                     numeric(1))
                join_field <- names(join_field[join_field == max(join_field)])
                if (length(join_field) != 1) stop("There is no clear field in the shape file that contains the area codes in the field you have identified")
                shp <- shp %>%
                        filter(grepl("^E", !! quo(!! sym(join_field))))
                if (type == "static") {
                        data <- data %>%
                                mutate(!!quo_name(area_code) :=
                                               as.character(!!area_code))
                        shp <- shp %>%
                                mutate(AreaCode = as.character(!! quo(!! sym(join_field)))) %>%
                                merge(data,
                                      by.x = "AreaCode",
                                      by.y = quo_text(area_code),
                                      all.x = TRUE)
                        if (is.numeric(copyright_year) & nchar(copyright_year) == 4) {
                                copyright_year <- as.character(copyright_year)
                        } else if (inherits(copyright_year, 'Date')) {
                                copyright_year <- format(copyright_year, "%Y")
                        } else {
                                stop("copyright_year must be either a 4 digit numeric class or Date class")
                        }
                        copyright <- data.frame(val = paste0("Contains Ordnance Survey data\n",
                                                             paste0("\uA9 Crown copyright and database right ",
                                                                    copyright_year),
                                                             "\n",
                                                             "Contains National Statistics data\n",
                                                             paste0("\uA9 Crown copyright and database right ",
                                                                    copyright_year)),
                                                x = max(shp$long),
                                                y = min(shp$lat))
                        map <- ggplot(shp) +
                                geom_sf(aes_string(fill = quo_text(fill))) +
                                coord_sf(datum = NA) +
                                scale_fill_phe(theme = "fingertips") +
                                theme_void() +
                                geom_text(data = copyright,
                                          aes(x = x,
                                              y = y,
                                              label = val),
                                          colour = "black",
                                          hjust = 1,
                                          vjust = 0,
                                          size = copyright_size) +
                                labs(title = title,
                                     subtitle = subtitle,
                                     fill = "")

                } else if (type == "interactive") { # nocov start
                        ftipspal <- scale_fill_phe("fingertips")
                        ftipspal <- ftipspal$palette(1)
                        data <- data %>%
                                mutate(!!quo_name(fill) :=
                                               factor(!!fill,
                                                      levels = levels(!!fill)))
                        factpal <- colorFactor(ftipspal[levels(pull(data, !!fill))],
                                               domain = pull(data, !!fill),
                                               ordered = TRUE)
                        data <- data %>%
                                mutate(!!quo_name(area_code) :=
                                               as.character(!!area_code))
                        shp <- shp %>%
                                mutate(AreaCode = as.character(!! quo(!! sym(join_field)))) %>%
                                merge(data,
                                      by.x = "AreaCode",
                                      by.y = quo_text(area_code),
                                      all.x = TRUE)
                        value <- enquo(value)
                        if (!missing(name_for_label)) {
                                name_for_label <- enquo(name_for_label)
                                labels <- sprintf("<strong>%s</strong><br/>Value: %g",
                                                  pull(shp, !!name_for_label),
                                                  pull(shp, !!value))
                        } else {
                                labels <- sprintf("<strong>%s</strong><br/>Value: %g",
                                                  pull(shp, !!join_field),
                                                  pull(shp, !!value))
                        }

                        map <- leaflet(shp)  %>%
                                addTiles() %>%
                                addPolygons(fillColor =
                                                    ~factpal(pull(shp, !!fill)),
                                            weight = 2,
                                            opacity = 1,
                                            color = "white",
                                            dashArray = "3",
                                            fillOpacity = 0.7,
                                            popup = labels) %>%
                                addLegend("topright",
                                          pal = factpal,
                                          values = fill,
                                          title = title,
                                          opacity = 1)
                } # nocov end
                return(map)
        }


}

#' Plot spine chart
#'
#' Returns ggplot of spine chart
#' @return a ggplot object containing a spine chart
#' @details the function draws a bar chart (which is the spine) and then plots
#'   the data table (if datatable = TRUE) using geom_text. The bar chart is
#'   always plotted between 0 and 1 on the x scale. The columns in the data
#'   table are controlled by the header_positions argument. To adjust the length
#'   of the bars in the visualisation, amend the header_positions argument. The
#'   more negative the first value of the vector that goes into
#'   header_positions, the more condensed the bar part of the visualisation will
#'   be.
#' @param data a data frame to create the spine chart from. the data frame
#'   should contain data for all area types included in the chart (eg, if
#'   plotting for County & UA with a comparator of region and a median line for
#'   national, the data frame should contain all of these data)
#' @param value unquoted field name containing the values to be plotted
#' @param count unquoted field name where the count (numerator) is stored
#' @param area_code unquoted field name where area codes are stored
#'   (local_area_code, median_line_area_code and comparator_area_code, if using,
#'   should all exist in this field)
#' @param local_area_code string; the code of the area that the spine chart is
#'   being drawn for
#' @param indicator unquoted field name of the field containing the indicator
#'   labels. Take care as errors will occur where indicator labels are the same
#'   but data exist for multiple sub-categories (for example, sex or age)
#' @param timeperiod unquoted field name of the time period field
#' @param trend unquoted field name of the trend field; if the user doesn't want
#'   to display trend information then leave this incomplete and amend the
#'   header_labels argument to remove the Trend header. Text within this field
#'   should contain one of the following words to control the arrows that are
#'   displayed; "decreasing", "increasing", "no significant change", "could not
#'   be calculated". The text within this field should contain one of the
#'   following words to control the colour; "better", "worse", "no significant
#'   change". If none of these words appear in the string, the words
#'   "increasing" or "decreasing" will be used to colour the arrows in different
#'   shades of blue"
#' @param polarity unquoted field name containing the polarity information
#'   (currently only handles polarity returned by fingertipsR package)
#' @param significance unquoted field name describing the statistical
#'   significance for that indicator (eg, Better, Worse, Similar etc)
#' @param area_type unquoted field name containing area type information. This
#'   ensures the vertabra are only plotted for the same area types as the
#'   local_area area type (eg, when plotting a spine chart for County & UA
#'   areas, regions and national area types will be removed)
#' @param cols named character vector for the cols that will be applied to the
#'   significance field. The names should contain all of the levels in the
#'   significance field of the data frame. Defaults to the Fingertips colours
#'   based on the outputs from the API
#' @param median_line_area_code string; area code for the median line. Defaults
#'   to "E92000001" (England)
#' @param comparator_area_code string; area code for the comparator point.
#'   Defaults to NA
#' @param bar_width numeric value; the distance between bars (0 to 1)
#' @param local_point_shape numeric value; shape type for local area point
#'   (defaults to 21, circle). See ggplot2 shape types for different values
#' @param local_point_outline string; control colour of the outline of the local
#'   point in the spine chart
#' @param comparator_point_shape numeric value; shape type for regional area
#'   point (defaults to 23, diamond). See ggplot2 shape types for different
#'   values
#' @param comparator_point_outline string; control colour of the outline of the
#'   regional point in the spine chart
#' @param comparator_point_fill string; control the fill colour of the regional
#'   point in the spine chart
#' @param relative_text_size numeric value; control the size of the text in the
#'   accompanying table
#' @param relative_point_size numeric value; control the size of the points on
#'   the spine chart
#' @param header_positions numeric vector; used to adjust columns of data table
#'   if they are overlapping. The final value shouldn't be less than 1. Must
#'   have a length of 7. Defaults to c(-1.43, -.53, -.35, -.25, -.15, -0.05,
#'   1.05)
#' @param header_labels character vector; labels used for the titles of the
#'   columns for a data table. Must have a length of 7. Defaults to
#'   c("Indicator", "Time period", "Local count","Local value", "England value",
#'   "Worst/Lowest","Best/Highest")
#' @param domain unquoted field name describing the grouping of the domains if
#'   wishing to split the spine chart into domains
#' @param relative_domain_text_size numeric; control the text size for the
#'   domain labels (if include.domains = TRUE) relative to 1
#' @param datatable logical; default = TRUE, display data table alongside spine
#'   chart
#' @param indicator_label_nudgex number; nudge the placement of the indicator
#'   label in the x direction. Negative values nudge to the left
#' @param show_dividers string; whether to display horizontal lines between
#'   indicators. Values can be "all" or "outer". Any other value will not
#'   generate lines
#' @param dps number; number of decimal places to be displayed in the data
#'   table. The default is 1. Set to NA if this should be the same as the input
#'   data
#' @param datatable_line_height number; height of wrapped lines in the data
#'   table
#' @param percent_display number between 0 and 1; the percentage of values that
#'   needs to exist for a spine to display. Default is 0.25
#' @param arrow_length number to control the length of the trend arrow
#' @param arrow_thickness number to control the thickness of the trend arrow
#' @param arrow_head_length number to control the length of the arrow head
#' @param arrow_head_angle number to control the angle of the arrow head
#' @param horizontal_arrow_multiplier number to scale horizontal trend arrows. A
#'   value below 1 will shorten the arrows
#' @details This function filters for the area type that is the same as your
#'   local area type and then calculates the "vertebra" from those data.
#'   Therefore, if you are comparing outputs with those seen on the Fingertips
#'   website, ensure you perform the same preprocessing. For example, some
#'   profiles display spine charts where small areas, such as Isles of Scilly,
#'   are removed before the spine is produced.
#' @import ggplot2
#' @import dplyr
#' @importFrom grDevices rgb
#' @importFrom rlang quo_text .data
#' @importFrom utils tail
#' @importFrom stats reformulate
#' @importFrom stringr str_trim
#' @examples
#' ## An example with differing decimal places for individual indicators
#'
#' library(dplyr)
#' df <- create_test_data() %>%
#' mutate(Value = case_when(
#'         grepl("2$|4$|6$", IndicatorName) ~ round(Value,1),
#'         TRUE ~ round(Value, 0)))
#' full_p <- area_profiles(df,
#'                         value = Value,
#'                         count = Count,
#'                         area_code = AreaCode,
#'                         local_area_code = "AC122",
#'                         indicator = IndicatorName,
#'                         timeperiod = Timeperiod,
#'                         trend = Trend,
#'                         polarity = Polarity,
#'                         significance = Significance,
#'                         area_type = AreaType,
#'                         median_line_area_code = "C001",
#'                         comparator_area_code = "PAC12",
#'                         datatable = TRUE,
#'                         relative_domain_text_size = 0.75,
#'                         relative_text_size = 1.2,
#'                         bar_width = 0.68,
#'                         indicator_label_nudgex = -0.1,
#'                         show_dividers = "outer",
#'                         header_positions = c(-1, -0.7, -0.44, -0.35, -0.25,
#'                                              -0.15, -0.05, 1.08),
#'                         dps = NA)
#' full_p
#'
#' ## An example with domains and non-default indicator ordering
#'
#' df <- create_test_data()
#' label_order <- c(1, 2, 4, 3, 6, 5)
#' df <- df %>%
#'         mutate(IndicatorName = factor(IndicatorName,
#'                                       levels = paste("Indicator", label_order)))
#'
#' p <- area_profiles(df,
#'                    value = Value,
#'                    count = Count,
#'                    area_code = AreaCode,
#'                    local_area_code = "AC122",
#'                    indicator = IndicatorName,
#'                    timeperiod = Timeperiod,
#'                    trend = Trend,
#'                    polarity = Polarity,
#'                    significance = Significance,
#'                    area_type = AreaType,
#'                    median_line_area_code = "C001",
#'                    comparator_area_code = "PAC12",
#'                    datatable = TRUE,
#'                    relative_domain_text_size = 0.75,
#'                    relative_text_size = 1.2,
#'                    bar_width = 0.68,
#'                    indicator_label_nudgex = -0.1,
#'                    show_dividers = "outer",
#'                    header_positions = c(-1, -0.7, -0.53, -0.35, -0.25,
#'                                         -0.15, -0.05, 1.05),
#'                    domain = Domain
#' )
#' p
#'
#' @export
area_profiles <- function(data,
                          value,
                          count,
                          area_code,
                          local_area_code,
                          indicator,
                          timeperiod,
                          trend = NA,
                          polarity,
                          significance,
                          area_type,
                          cols = "fingertips",
                          median_line_area_code = "E92000001",
                          comparator_area_code = NA,
                          bar_width = 0.75,
                          local_point_shape = 21,
                          local_point_outline = "black",
                          comparator_point_shape = 23,
                          comparator_point_outline = "gray30",
                          comparator_point_fill = "gray30",
                          relative_point_size = 1,
                          relative_text_size = 1,
                          header_positions  = c(-1.83, -1.13, -.53, -.35, -.25, -.15, -0.05, 1.05),
                          header_labels = c("Indicator", "Trend",
                                            "Time\nperiod",
                                            "Local\ncount","Local\nvalue",
                                            "England\nvalue",
                                            "Worst/\nLowest","Best/\nHighest"),
                          indicator_label_nudgex = -0.075,
                          domain = no_domains,
                          relative_domain_text_size = 1,
                          show_dividers = "none",
                          datatable = TRUE,
                          datatable_line_height = 0.6,
                          dps = 1,
                          percent_display = 0.25,
                          arrow_length = 1,
                          arrow_thickness = 2,
                          arrow_head_length = arrow_length / 3,
                          arrow_head_angle = 25,
                          horizontal_arrow_multiplier = 1) {

        test_area_code <- enquo(area_code)
        dummy_polarity <- enquo(polarity)

        if (sum(median_line_area_code %in% pull(data, !!test_area_code)) < 1)
                stop(paste0(median_line_area_code, " not in area_code field provided"))
        if (sum(local_area_code %in% pull(data, !!test_area_code)) < 1)
                stop(paste0(local_area_code, " not in area_code field provided"))
        if (!is.na(comparator_area_code) &
            sum(comparator_area_code %in% pull(data, !!test_area_code)) < 1)
                stop(paste0(comparator_area_code, " not in area_code field provided"))
        if (length(header_labels) != 8)
                stop("header_labels argument must have a length of 8")
        if (length(header_positions) != 8)
                stop("header_positions argument must have a length of 8")

        data <- data %>%
                mutate(!!quo_name(dummy_polarity) :=
                               stringr::str_trim(!!dummy_polarity))

        area_code <- enquo(area_code)
        indicator <- enquo(indicator)

        # check for multiple values for an area per indicator
        check_message <- spine_data_check(data, indicator, area_code)
        if (!is.na(check_message)) stop(check_message)

        # create data table
        value <- enquo(value)
        count <- enquo(count)
        timeperiod <- enquo(timeperiod)
        if (is.factor(pull(data, !!indicator))) {
                ind_order <- levels(pull(data, !!indicator))
        } else {
                data <- data %>%
                        mutate(!!quo_name(indicator) :=
                                       factor(!!indicator))
                ind_order <- levels(pull(data, !!indicator))
        }

        if (datatable == TRUE) {
                if (!is.na(dps) & !is.integer(dps) & !is.numeric(dps)) stop("The dps argument must be a number or NA")
                trend <- enquo(trend)
                dftable <- create_datatable(data,
                                            indicator,
                                            area_code,
                                            timeperiod,
                                            trend,
                                            count, value,
                                            local_area_code,
                                            median_line_area_code,
                                            comparator_area_code,
                                            dps = dps,
                                            header_width = diff(range(header_positions)),
                                            horizontal_arrow_multiplier = horizontal_arrow_multiplier)
                dftable <- dftable %>%
                        mutate(!!quo_name(indicator) :=
                                                  factor(!!indicator,
                                                         levels = ind_order))
        } else {
                dftable <- NA
        }

        # rescale data for charting
        significance <- enquo(significance)
        polarity <- enquo(polarity)
        area_type <- enquo(area_type)
        dfrescaled <- spine_rescaler(data,
                                     area_code,
                                     indicator,
                                     significance,
                                     polarity,
                                     area_type,
                                     value,
                                     timeperiod,
                                     local_area_code,
                                     median_line_area_code,
                                     comparator_area_code,
                                     percent_display,
                                     dps = dps)
        domain <- enquo(domain)
        if (quo_text(domain) == "no_domains") {
                domain_field <- NA
        } else {
                domain_field <- domain
                domain_lu <- data %>%
                        select(!!indicator, !!domain) %>%
                        mutate(!!quo_name(domain) := factor(!!domain)) %>%
                        unique
                dfrescaled$bars <- dfrescaled$bars %>%
                        merge(domain_lu,
                              by = rlang::quo_text(indicator),
                              all.x =TRUE)
                dfrescaled$points <- dfrescaled$points %>%
                        merge(domain_lu,
                              by = rlang::quo_text(indicator),
                              all.x =TRUE)
                if (is.data.frame(dftable))
                        dftable <- dftable %>%
                        merge(domain_lu,
                              by = rlang::quo_text(indicator),
                              all.x =TRUE)
        }

        fingertips_cols <- c('Better' = '#92D050', 'Same' = '#FFC000',
                             'Worse' = '#C00000', 'Not compared' = '#C9C9C9',
                             'None' = '#A6A6A6', 'Higher' = '#BED2FF',
                             'Similar' = '#FFC000', 'Lower'='#5555E6',
                             'Worst' = '#FFFFFF','Q25' = '#C9C9C9',
                             'Q75' = '#8B8B8B','Best' = '#C9C9C9')
        if (length(cols) == 1) {
                if (cols == "fingertips") {
                        cols <- fingertips_cols
                }
        }

        missing_cols <- setdiff(names(fingertips_cols),
                                names(cols))
        if (length(missing_cols) > 0) cols <- c(cols, fingertips_cols[missing_cols])

        vline_length <- dfrescaled$bars %>%
                pull(!!indicator) %>%
                unique %>%
                length

        dfrescaled$bars <- dfrescaled$bars %>%
                mutate(y = case_when(
                        y == 1.05 ~ header_positions[length(header_positions)],
                        y == -0.05 ~ header_positions[length(header_positions) - 1]
                        ),
                       !!quo_name(indicator) :=
                               factor(!!indicator,
                                      levels = ind_order))
        dfrescaled$points <- dfrescaled$points  %>%
                mutate(!!quo_name(indicator) :=
                               factor(!!indicator,
                                      levels = ind_order))
        p <- ggplot(dfrescaled$bars,
                    aes_string(x = quo_text(indicator),
                               y = "quantiles")) +
                geom_bar(stat = "identity", width = bar_width,
                         aes_string(fill = "GraphPoint"))


        if (!is.na(comparator_area_code)) {
                rescaled_comparator_field <- "region"
                p <- p +
                        geom_point(data = dfrescaled$points,
                                   aes_string(x = quo_text(indicator),
                                              y = rescaled_comparator_field),
                                   shape = comparator_point_shape,
                                   colour = comparator_point_outline,
                                   fill = comparator_point_fill,
                                   size = 2.5 * relative_point_size)
        }
        p <- p +
                geom_point(data = dfrescaled$points,
                           aes_string(x = quo_text(indicator),
                                      y = "area",
                                      fill = quo_text(significance)),
                           shape = local_point_shape,
                           colour = local_point_outline,
                           size = 2.5 * relative_point_size) +
                geom_hline(yintercept = 0.5, col = "darkred") +
                coord_flip() +
                scale_fill_manual(values = cols) +
                scale_colour_manual(values = cols) +
                theme_minimal() +
                theme(panel.grid.major = element_blank(),
                      axis.text = element_text(colour = "black")) +
                labs(x = "", y = "")

        if (is.data.frame(dftable)) {
                dt_indicator <- indicator
                dt_area_field <- "Area_value"
                dt_comparator_field <- "Comparator_value"
                dt_median_field <- "Median_value"
                dt_area_count <- count
                dt_timeperiod <- timeperiod
                dftable <- dftable %>%
                        rename(ind = !!dt_indicator,
                               count = !!dt_area_count,
                               tp = !!dt_timeperiod)
                lims <- range(header_positions)
                lims[1] <- lims[1] + indicator_label_nudgex
                lims <- lims * 1.06
                p <- p +
                        scale_y_continuous(position = "right",
                                           breaks = header_positions,
                                           limits = lims,
                                           labels = header_labels,
                                           expand = c(0, 0)) +
                        geom_text(data = dfrescaled$bars[!dfrescaled$bars$GraphPoint %in%
                                                                 c("Q75", "Q25"), ],
                                  aes(label = label, y = y),
                                  col = "black",
                                  size = 2.5 * relative_text_size,
                                  lineheight = datatable_line_height,
                                  hjust = 1
                        ) +
                        geom_text(data = dftable,
                                  aes_string(label = dt_median_field,
                                             x = "ind"),
                                  y = header_positions[6],
                                  col = "black",
                                  size = 2.5 * relative_text_size,
                                  parse = TRUE,
                                  lineheight = datatable_line_height,
                                  hjust = 1
                        ) +
                        geom_text(data = dftable,
                                  aes_string(label = dt_area_field,
                                             x = "ind"),
                                  y = header_positions[5],
                                  col = "black",
                                  size = 2.5 * relative_text_size,
                                  parse = TRUE,
                                  lineheight = datatable_line_height,
                                  hjust = 1
                        ) +
                        geom_text(data = dftable,
                                  aes(label = count, x = ind),
                                  y = header_positions[4],
                                  col = "black",
                                  size = 2.5 * relative_text_size,
                                  parse = TRUE,
                                  lineheight = datatable_line_height,
                                  hjust = 1
                        ) +
                        geom_text(data = dftable,
                                  aes(label = tp, x = ind),
                                  y = header_positions[3],
                                  col = "black",
                                  size = 2.5 * relative_text_size,
                                  lineheight = datatable_line_height,
                                  hjust = 1
                        ) +
                        geom_spoke(data = dftable,
                                   aes(x = ind,
                                       y = header_positions[2],
                                       angle = .data$direction,
                                       colour = .data$trend_sig,
                                       radius = .data$radius * arrow_length),
                                   size = arrow_thickness,
                                   arrow = arrow(length = unit(arrow_head_length, "cm"),
                                           type = "open",
                                           angle = arrow_head_angle)
                        ) +
                        geom_spoke(data = dftable,
                                   aes(x = ind,
                                       y = header_positions[2],
                                       angle = .data$direction + pi,
                                       colour = .data$trend_sig,
                                       radius = .data$radius * arrow_length),
                                   size = arrow_thickness
                        ) +
                        geom_text(data = dftable,
                                  aes(label = ind,
                                      y = header_positions[1],
                                      x = ind),
                                  hjust = 0,
                                  nudge_y = indicator_label_nudgex,
                                  col = "black",
                                  size = 2.5 * relative_text_size,
                                  lineheight = datatable_line_height
                        ) +
                        theme(axis.text.x = element_text(size = 0.9 * rel(relative_text_size)),
                              axis.text.y = element_blank(),
                              panel.grid.minor = element_blank(),
                              legend.position = "none")
        } else {
                p <- p +
                        theme(axis.text.x = element_blank(),
                              panel.grid.minor = element_blank(),
                              legend.position = "none")
        }
        if (quo_text(domain) != "no_domains") {
                p <- p +
                        facet_grid(rows = quo_text(domain),
                                   space = "free_y",
                                   scales = "free_y",
                                   switch = "y") +
                        theme(panel.spacing = unit(0, "lines"),
                              strip.placement = "outside",
                              strip.background = element_blank(),
                              strip.text = element_text(size = rel(relative_domain_text_size))
                        )

        }
        if (show_dividers == "all") {
                p <- p +
                        geom_vline(xintercept = seq(-0.5, vline_length + 0.5),
                                   colour = "black",
                                   size = 0.2)
        } else if (show_dividers == "outer") {
                p <- p +
                        annotate("segment", x=-Inf, xend=-Inf, y=-Inf, yend=Inf) +
                        theme(axis.line.x = element_line())
        }
        if (header_positions[length(header_positions)] < 1) {
                warning("Some bars may not display if the final value of the header_positions argument is less than 1")
        }
        return(p)

}

Try the fingertipscharts package in your browser

Any scripts or data that you put into this service are public.

fingertipscharts documentation built on July 2, 2020, 2:59 a.m.