From b682e2aec6310ccdb2d0b1739d5c16aa9139f9f4 Mon Sep 17 00:00:00 2001 From: Ryo-N7 Date: Tue, 22 Oct 2019 21:31:35 +0900 Subject: [PATCH] bc as regular scale, fix tests, fix vignettes for bc(), references #31 --- R/bulletchart.R | 423 +++++++++++----------------- R/bulletchart222.R | 193 ------------- R/globals.R | 4 +- R/internal.R | 2 +- R/{internal2.R => internal_bc.R} | 2 +- man/bullet_chart.Rd | 56 ++-- man/extra_field_calculator.Rd | 2 +- man/field_calculator.Rd | 4 +- tests/testthat/test_bullet_chart.r | 99 ++++--- vignettes/intro-functions.Rmd | 2 +- vignettes/intro-inputs.Rmd | 2 +- vignettes/intro-to-bulletcharts.Rmd | 9 +- 12 files changed, 272 insertions(+), 526 deletions(-) delete mode 100644 R/bulletchart222.R rename R/{internal2.R => internal_bc.R} (98%) diff --git a/R/bulletchart.R b/R/bulletchart.R index 453e667..7e1bfa5 100644 --- a/R/bulletchart.R +++ b/R/bulletchart.R @@ -1,57 +1,51 @@ # bullet plot Version 1: actual Stephen FEW ------------------------------------------------- -#' @title bullet_chart -#' @description create a Stephen Few bullet chart +#' @title 'Stephen Few'-style Bullet Chart +#' @description Creates a bullet chart using an indicator's values for the axis scales. #' @param file_name path of Excel file -#' @param sheet_name Specify which sheet in Excel file, Default: "Sheet1" -#' @param dataframe Specify R dataframe input -#' @param indicator_name Specify the name of the column that has your indicator/KPI names -#' @param actual Specify the name of the column that has the current value of your indicators/KPIs -#' @param actual_lastweek Specify the name of the column that has the indicator/KPI value from the previous week -#' @param actual_lastyear Specify the name of the column that has the indicator/KPI value from the previous year -#' @param target Specify the name of the column that has the target value for the indicator/KPI -#' @param for_year Specify the year in which the report is being made, Default: year(Sys.Date()) -#' @param cal_type Define what calendar you are using. Options are "fis" for fiscal year starting -#' October 1st, "cal" for calendar year starting January 1st, or enter your own custom date in the -#' format "YYYY/MM/DD", Default: fis -#' @param chart_type Specify a static or interactive (ggiraph) version -#' @param small Specify whether you want the small version of the plot (TRUE or FALSE), Default: FALSE -#' @param legend Specify whether you want to show the legend, Default: TRUE -#' @param remove_no_targets Remove indicators with Targets == NA or 0, Default: FALSE -#' @param show_text Show 'Last Week' & 'Last Year' text, when `small = TRUE` or -#' `chart_type = "interactive"` then no text will be shown by default. -#' @details This version of the bullet chart most closely resembles Stephen Few's design. The single black bar represents -#' the current value of the indicator while the different hue columns represent last week's value (darker hue) and last year's value (lighter hue). -#' @examples -#' load(read_example("df.rda")) -#' bullet_chart(dataframe = df) +#' @param sheet_name specify which sheet in Excel file, Default: "Sheet1" +#' @param dataframe specify R dataframe input +#' @param indicator_name specify the name of the column that has your indicator/KPI names, +#' Default: 'variable' +#' @param info PARAM_DESCRIPTION, Default: 'info' +#' @param current PARAM_DESCRIPTION, Default: 'current' +#' @param low PARAM_DESCRIPTION, Default: 'low' +#' @param medium PARAM_DESCRIPTION, Default: 'medium' +#' @param high PARAM_DESCRIPTION, Default: 'high' +#' @param target PARAM_DESCRIPTION, Default: 'target' +#' @param remove_no_targets PARAM_DESCRIPTION, Default: TRUE +#' @param legend PARAM_DESCRIPTION, Default: TRUE +#' @return bullet chart plot(s) +#' @details Stephen Few style bullet chart #' @rdname bullet_chart #' @export -#' @importFrom ggplot2 ggplot aes geom_col geom_hline coord_flip labs ggtitle theme_minimal -#' expand_limits scale_alpha_manual geom_text annotate theme element_text margin unit -#' @importFrom dplyr mutate %>% select -#' @importFrom ggiraph geom_bar_interactive ggiraph girafe +#' @importFrom ggplot2 ggplot geom_col aes geom_segment coord_flip +#' scale_x_continuous scale_y_continuous scale_fill_manual labs theme +#' element_text element_blank element_rect margin +#' @importFrom dplyr filter mutate %>% pull group_by +#' @importFrom purrr map map2 +#' @importFrom cowplot get_legend plot_grid +#' @importFrom ggplotify as.ggplot +#' @importFrom tidyr nest +#' @importFrom utils head bullet_chart <- function(file_name = NULL, sheet_name = "Sheet1", - dataframe = NULL, - indicator_name = "indicator_name", - actual = "actual", - actual_lastweek = "actual_lastweek", - actual_lastyear = "actual_lastyear", - target = "target", - for_year = year(Sys.Date()), - cal_type = "fis", - chart_type = "static", - small = FALSE, legend = TRUE, - remove_no_targets = FALSE, - show_text = FALSE) { - - ammended_data <- extra_field_calculator(file_name, sheet_name, - dataframe, - indicator_name, actual, - actual_lastweek, actual_lastyear, - target, for_year, cal_type, - remove_no_targets) + dataframe = NULL, + indicator_name = "variable", + info = "info", + current = "current", + low = "low", + medium = "medium", + high = "high", + target = "target", + remove_no_targets = TRUE, + legend = TRUE) { + ## Transform data bulletchartr:::field_calculator + ammended_data <- field_calculator(file_name, sheet_name, + dataframe, + indicator_name, info, + current, low, medium, high, + target, remove_no_targets) ## check for Target == 0 in all Targets if(all(ammended_data$target == 0)) { @@ -60,210 +54,135 @@ bullet_chart <- function(file_name = NULL, sheet_name = "Sheet1", ) } - ## base plot - g <- ggplot(ammended_data, aes(x = indicator_name)) + - geom_col(aes(y = 100), fill = "grey85", width = 0.4) + - geom_hline(yintercept = ammended_data$percent_time, alpha = 0.33) + - coord_flip() + - labs(y = "Percent of Yearly Target\n&\n Percent of Year", - x = " ") + - ggtitle(paste("Ongoing Indicator Accomplishment (", for_year, ")", sep = "")) + - theme_minimal() + - expand_limits(x = nrow(ammended_data) + 1.25, y = 102) - - # static vs. interactive ---- - - if (chart_type == "static") { - ### static ---- - if (small == FALSE) { - - g <- g + - ## Last Week - geom_col(aes(y = perc_week, alpha = "lastweek"), width = 0.4) + - ## Last Year - geom_col(aes(y = perc_year, alpha = "lastyear"), width = 0.4) + - ## Today - geom_col(aes(y = perc, alpha = "today"), - fill = "grey10", width = 0.1, color = "grey10") + - scale_alpha_manual(name = "", - values = c(0.3, 0.6, 0.9), - labels = c("lastweek" = "Last Week", - "lastyear" = "Last Year", - "today" = "Today")) + - geom_col(aes(y = perc), fill = "grey10", width = 0.1, color = "grey10", alpha = 0.9) + - annotate("text", x = 0, y = ammended_data$percent_time + 1.5, - hjust = 0, label = "Today", angle = 90, alpha = 0.5, size = 5) + - theme(axis.text.y = element_text(size = 15, face = "bold"), - axis.title.x = element_text(face = "bold", size = 10, - margin = margin(t = 25, r = 0, b = 20, l = 0)), - axis.text.x = element_text(face = "bold", size = 12), - title = element_text(face = "bold"), - plot.title = element_text(hjust = 0.5), - plot.subtitle = element_text(hjust = 0.5, size = 8)) - - if (show_text == TRUE) { - g <- g + - geom_text(y = 1, aes(label = tooltip), vjust = -2, hjust = 0, size = 4) - } - - if (legend == FALSE) { - - g <- g + theme(legend.position = "none") - - print(g) - - } else if (legend == TRUE) { - - print(g) - - } - - } else if (small == TRUE) { - - g <- g + - geom_col(aes(y = perc_week, alpha = "lastweek"), width = 0.4) + - geom_col(aes(y = perc_year, alpha = "lastyear"), width = 0.4) + - geom_col(aes(y = perc, alpha = "today"), - fill = "grey10", width = 0.1, color = "grey10") + - scale_alpha_manual(name = "", - values = c(0.3, 0.6, 0.9), - labels = c("lastweek" = "Last Week", - "lastyear" = "Last Year", - "today" = "Today")) + - annotate("text", x = 0, y = ammended_data$percent_time + 1.5, hjust = 0, label = "Today", - angle = 90, alpha = 0.5, size = 2.5) + - theme(axis.text.y = element_text(size = 8, face = "bold"), - axis.title.x = element_text(face = "bold", size = 7, - margin = margin(t = 25, r = 0, b = 20, l = 0)), - axis.text.x = element_text(face = "bold", size = 10), - title = element_text(face = "bold", size = 8), - plot.title = element_text(hjust = 0.5), - plot.subtitle = element_text(hjust = 0.5, size = 6), - legend.text = element_text(size = 8), - legend.key.size = unit(0.8, "lines")) - - if (show_text == TRUE) { - g - warning("When 'small' is set to TRUE, text will not show up by default! \n") - } - - if (legend == FALSE) { - - g <- g + theme(legend.position = "none") - - print(g) - - } else if (legend == TRUE){ - - print(g) - - } - } - } else if (chart_type == "interactive") { - ### interactive ---- - if (small == FALSE) { - - g <- g + - geom_col(aes(y = perc_week, alpha = "lastweek"), width = 0.4) + - geom_col(aes(y = perc_year, alpha = "lastyear"), width = 0.4) + - geom_col(aes(y = perc, alpha = "today"), - fill = "grey10", width = 0.1, color = "grey10") + - scale_alpha_manual(name = "", - values = c(0.3, 0.6, 0.9), - labels = c("lastweek" = "Last Week", - "lastyear" = "Last Year", - "today" = "Today")) + - geom_bar_interactive(aes(x = indicator_name, y = perc, - tooltip = tooltip2, - data_id = indicator_name), - stat = "identity", alpha = 0.9, - fill = "grey10", - width = 0.1, color = "grey10") + - annotate("text", x = 0, y = ammended_data$percent_time + 1.5, - hjust = 0, label = "Today", angle = 90, alpha = 0.5, size = 5) + - theme(axis.text.y = element_text(size = 15, face = "bold"), - axis.title.x = element_text(face = "bold", size = 10, - margin = margin(t = 25, r = 0, b = 20, l = 0)), - axis.text.x = element_text(face = "bold", size = 12), - title = element_text(face = "bold"), - plot.title = element_text(hjust = 0.5), - plot.subtitle = element_text(hjust = 0.5, size = 8)) - - if (show_text == TRUE) { - g - warning("When 'chart_type' is set to 'interactive', text will not show up by default! \n") - } - - if (legend == FALSE) { - - g <- g + theme(legend.position = "none") - - output <- girafe(code = {print(g)}, - width = 0.5) - output - - } else if (legend == TRUE) { - - g <- g + - guides(shape = guide_legend(nrow = 1)) + - theme(legend.position = "bottom") - output <- girafe(code = {print(g)}, - width = 0.5) - output - - } - - } else if (small == TRUE) { - - g <- g + - geom_col(aes(y = perc_week, alpha = "lastweek"), width = 0.4) + - geom_col(aes(y = perc_year, alpha = "lastyear"), width = 0.4) + - geom_col(aes(y = perc, alpha = "today"), - fill = "grey10", width = 0.1, color = "grey10") + - scale_alpha_manual(name = "", - values = c(0.3, 0.6, 0.9), - labels = c("lastweek" = "Last Week", - "lastyear" = "Last Year", - "today" = "Today")) + - geom_bar_interactive(aes(x = indicator_name, y = perc, - tooltip = tooltip2, - data_id = indicator_name), - stat = "identity", alpha = 0.9, - fill = "grey10", - width = 0.1, color = "grey10") + - annotate("text", x = 0, y = ammended_data$percent_time + 1.5, hjust = 0, label = "Today", - angle = 90, alpha = 0.5, size = 2.5) + - theme(axis.text.y = element_text(size = 8, face = "bold"), - axis.title.x = element_text(face = "bold", size = 7, - margin = margin(t = 25, r = 0, b = 20, l = 0)), - axis.text.x = element_text(face = "bold", size = 10), - title = element_text(face = "bold", size = 8), - plot.title = element_text(hjust = 0.5), - plot.subtitle = element_text(hjust = 0.5, size = 6), - legend.text = element_text(size = 8), - legend.key.size = unit(0.8, "lines")) - - if (show_text == TRUE) { - g - warning("When 'chart_type' is set to 'interactive', text will not show up by default! \n") - } - - if (legend == FALSE) { - - g <- g + theme(legend.position = "none") - - output <- girafe(code = {print(g)}, - width = 0.5) - output - - } else if (legend == TRUE){ - - g <- g + guides(shape = guide_legend(nrow = 1)) + theme(legend.position = "bottom") - output <- girafe(code = {print(g)}, - width = 0.5) - output - - } - } + ## fill colors + cols <- c(High = "#dcdcdc", Medium = "#c0c0c0", Low = "#696969", + Current = "black") + + ## grab the names of all the indicators + indicator_vector <- ammended_data$indicator_name %>% unique() + + ## bullet chart plotter function + bc_plotter <- function(data, indicator_name) { + + ## find mid + max + min.bg <- 0 + max.bg <- max(data %>% + filter(allvals == "High") %>% pull(vals)) + + ## min max for 5 labels + sequence1 <- seq(min.bg, max.bg, length.out = 5) %>% signif(2) %>% head(-1) + seqbreaks <- c(sequence1, max.bg) + + ## PLOT + g <- data %>% + ggplot() + + ## great + geom_col(data = data %>% filter(allvals == "High"), + aes(x = 1, y = vals, fill = allvals)) + + ## good + geom_col(data = data %>% filter(allvals == "Medium"), + aes(x = 1, y = vals, fill = allvals)) + + ## bad + geom_col(data = data %>% filter(allvals == "Low"), + aes(x = 1, y = vals, fill = allvals)) + + ## current + geom_col(data = data %>% filter(allvals == "Current"), + aes(x = 1, y = vals, fill = allvals), + width = 0.2) + + ## target + geom_segment(aes(x = 0.75, xend = 1.25, + y = target, yend = target), + color = "red", size = 2.5) + + coord_flip() + + scale_y_continuous(limits = c(0, NA), + expand = c(0, 0), + labels = seq(min.bg, max.bg, length.out = 5) %>% floor(), + breaks = seq(min.bg, max.bg, length.out = 5) %>% floor()) + + scale_x_continuous(expand = c(0, 0)) + + scale_fill_manual(values = cols, name = NULL, + breaks = c("Current", "High", "Medium", "Low")) + + ## var_info takes Indicator name AND any extra info provided in + ## the 'info' variable, all calculated in `field_calculator()` + labs(title = glue::glue("{data$var_info}")) + + theme(title = element_text(face = "bold"), + plot.title = element_text(hjust = 0.5), + plot.subtitle = element_text(hjust = 0.5, size = 8), + panel.grid = element_blank(), + axis.title.x = element_blank(), + axis.text.x = element_text(face = "bold", size = 12), + axis.title.y = element_blank(), + axis.text.y = element_blank(), + axis.ticks.y = element_blank(), + strip.text = element_text(face = "bold", size = 14), + strip.background = element_rect(fill = "white"), + plot.margin = margin(1, 1, 1, 1, "cm"), + legend.position = "bottom", + legend.direction = "horizontal") + + return(g) } + + ## map over each indicator + # nested_df <- ammended_data %>% + # group_by(indicator_name) %>% + # nest() + + plots_df <- ammended_data %>% + group_by(indicator_name) %>% + nest() %>% + mutate(plot = map2(data, indicator_name, + ~bc_plotter(data = .x, indicator_name = .y))) + # plots_df$plot[[1]] + # plots_df$plot[[2]] + # plots_df$plot[[3]] + # plots_df$plot[[4]] + + ## legend ONLY onto bottom-most plot... ---- + ## https://wilkelab.org/cowplot/articles/shared_legends.html + ## take legend from one of the plots + ## (always from the first plot as that should always exist...) + with_legend <- cowplot::get_legend( + plots_df$plot[[1]] + theme(legend.box.margin = margin(0, 0, 0, 10)) + ) + + ## turn into ggplot object + with_legend_gg <- ggplotify::as.ggplot(with_legend) + + ## remove legend on ALL plots + removeLegend <- function(plot) { + plot + theme(legend.position = "none") + } + + plot_noLegend <- plots_df %>% + mutate(plot = map(plot, ~ removeLegend(.x))) + + if (legend == FALSE) { + nolegendplots <- cowplot::plot_grid(plotlist = plot_noLegend$plot, + align = "hv", ncol = 1) + + print(nolegendplots) + } + + #plot_noLegend$plot[[1]] + + ## append legend "plot" to list of all plots without legends! + bulletList <- c(plot_noLegend$plot, list(with_legend_gg)) + + ## PRINT PLOTS!! + withlegendplots <- cowplot::plot_grid(plotlist = bulletList, + align = "hv", ncol = 1) + + print(withlegendplots) } + + + + + + + + + + + + diff --git a/R/bulletchart222.R b/R/bulletchart222.R deleted file mode 100644 index 9d6b001..0000000 --- a/R/bulletchart222.R +++ /dev/null @@ -1,193 +0,0 @@ -#' @title bulletchart -#' @description FUNCTION_DESCRIPTION -#' @param file_name PARAM_DESCRIPTION, Default: NULL -#' @param sheet_name PARAM_DESCRIPTION, Default: 'Sheet1' -#' @param dataframe PARAM_DESCRIPTION, Default: NULL -#' @param indicator_name PARAM_DESCRIPTION, Default: 'variable' -#' @param info PARAM_DESCRIPTION, Default: 'info' -#' @param current PARAM_DESCRIPTION, Default: 'current' -#' @param low PARAM_DESCRIPTION, Default: 'low' -#' @param medium PARAM_DESCRIPTION, Default: 'medium' -#' @param high PARAM_DESCRIPTION, Default: 'high' -#' @param target PARAM_DESCRIPTION, Default: 'target' -#' @param remove_no_targets PARAM_DESCRIPTION, Default: TRUE -#' @param legend PARAM_DESCRIPTION, Default: TRUE -#' @return OUTPUT_DESCRIPTION -#' @details Stephen Few style bullet chart -#' @rdname bulletchart -#' @export -#' @importFrom ggplot2 ggplot geom_col aes geom_segment coord_flip -#' scale_x_continuous scale_y_continuous scale_fill_manual labs theme -#' element_text element_blank element_rect margin -#' @importFrom dplyr filter mutate %>% pull group_by -#' @importFrom purrr map map2 -#' @importFrom cowplot get_legend plot_grid -#' @importFrom ggplotify as.ggplot -#' @importFrom tidyr nest - -bulletchart <- function(file_name = NULL, sheet_name = "Sheet1", - dataframe = NULL, - indicator_name = "variable", - info = "info", - current = "current", - low = "low", - medium = "medium", - high = "high", - target = "target", - remove_no_targets = TRUE, - legend = TRUE) { - ## Transform data bulletchartr:::field_calculator - ammended_data <- field_calculator(file_name, sheet_name, - dataframe, - indicator_name, info, - current, low, medium, high, - target, remove_no_targets) - - ## check for Target == 0 in all Targets - if(all(ammended_data$target == 0)) { - return( - "No Non-Zero Targets!" - ) - } - - ## fill colors - cols <- c(High = "#dcdcdc", Medium = "#c0c0c0", Low = "#696969", - Current = "black") - - ## custom breaks - # int_breaks <- function(x, n = 5) pretty(x, n)[pretty(x, n) %% 1 == 0] - # breaks_fun <- function(x) { - # br_x <- unique(pretty(seq(min(x), max(x)))) - # br_x <- c(br_x[-end(br_x)], max(x)) - # } - - ## grab the names of all the indicators - indicator_vector <- ammended_data$indicator_name %>% unique() - - ## bullet chart plotter function - bc_plotter <- function(data, indicator_name) { - - ## find mid + max - min.bg <- 0 - max.bg <- max(data %>% - filter(allvals == "High") %>% pull(vals)) - low.bg <- max(data %>% - filter(allvals == "Low") %>% pull(vals)) - med.bg <- max(data %>% - filter(allvals == "Medium") %>% pull(vals)) - - ## min max for 5 labels - sequence1 <- seq(min.bg, max.bg, length.out = 5) %>% signif(2) %>% head(-1) - seqbreaks <- c(sequence1, max.bg) - - ## PLOT - g <- data %>% - ggplot() + - ## great - geom_col(data = data %>% filter(allvals == "High"), - aes(x = 1, y = vals, fill = allvals)) + - ## good - geom_col(data = data %>% filter(allvals == "Medium"), - aes(x = 1, y = vals, fill = allvals)) + - ## bad - geom_col(data = data %>% filter(allvals == "Low"), - aes(x = 1, y = vals, fill = allvals)) + - ## current - geom_col(data = data %>% filter(allvals == "Current"), - aes(x = 1, y = vals, fill = allvals), - width = 0.2) + - ## target - geom_segment(aes(x = 0.75, xend = 1.25, - y = target, yend = target), - color = "red", size = 2.5) + - coord_flip() + - scale_y_continuous(limits = c(0, NA), - expand = c(0, 0), - labels = seq(min.bg, max.bg, length.out = 5) %>% floor(), - breaks = seq(min.bg, max.bg, length.out = 5) %>% floor()) + - scale_x_continuous(expand = c(0, 0)) + - scale_fill_manual(values = cols, name = NULL, - breaks = c("Current", "High", "Medium", "Low")) + - labs(title = glue::glue("{indicator_name}")) + - theme(title = element_text(face = "bold"), - plot.title = element_text(hjust = 0.5), - plot.subtitle = element_text(hjust = 0.5, size = 8), - panel.grid = element_blank(), - axis.title.x = element_blank(), - axis.text.x = element_text(face = "bold", size = 12), - axis.title.y = element_blank(), - axis.text.y = element_blank(), - axis.ticks.y = element_blank(), - strip.text = element_text(face = "bold", size = 14), - strip.background = element_rect(fill = "white"), - plot.margin = margin(1, 1, 1, 1, "cm"), - legend.position = "bottom", - legend.direction = "horizontal") - - return(g) - } - - ## map over each indicator - # nested_df <- ammended_data %>% - # group_by(indicator_name) %>% - # nest() - - plots_df <- ammended_data %>% - group_by(indicator_name) %>% - nest() %>% - mutate(plot = map2(data, indicator_name, - ~bc_plotter(data = .x, indicator_name = .y))) - # plots_df$plot[[1]] - # plots_df$plot[[2]] - # plots_df$plot[[3]] - # plots_df$plot[[4]] - - ## legend ONLY onto bottom-most plot... ---- - ## https://wilkelab.org/cowplot/articles/shared_legends.html - ## take legend from one of the plots - ## (always from the first plot as that should always exist...) - with_legend <- cowplot::get_legend( - plots_df$plot[[1]] + theme(legend.box.margin = margin(0, 0, 0, 10)) - ) - - ## turn into ggplot object - with_legend_gg <- ggplotify::as.ggplot(with_legend) - - ## remove legend on ALL plots - removeLegend <- function(plot) { - plot + theme(legend.position = "none") - } - - plot_noLegend <- plots_df %>% - mutate(plot = map(plot, ~ removeLegend(.x))) - - if (legend == FALSE) { - nolegendplots <- cowplot::plot_grid(plotlist = plot_noLegend$plot, - align = "hv", ncol = 1) - - print(nolegendplots) - } - - #plot_noLegend$plot[[1]] - - ## append legend "plot" to list of all plots without legends! - bulletList <- c(plot_noLegend$plot, list(with_legend_gg)) - - ## PRINT PLOTS!! - withlegendplots <- cowplot::plot_grid(plotlist = bulletList, - align = "hv", ncol = 1) - - print(withlegendplots) -} - - - - - - - - - - - - diff --git a/R/globals.R b/R/globals.R index 34c217f..df5ea7d 100644 --- a/R/globals.R +++ b/R/globals.R @@ -1,3 +1,5 @@ utils::globalVariables(c(".", "behind_by", "perc", "perc_week", "perc_year", "percent_time", "text", - "tooltip", "tooltip2")) + "tooltip", "tooltip2", + "allvals", "vals", "data", + "plot", "Current", "tarhigh")) diff --git a/R/internal.R b/R/internal.R index 3fab250..65b476b 100755 --- a/R/internal.R +++ b/R/internal.R @@ -1,6 +1,6 @@ # internal functions ------------------------------------------------------ -#' @title extra_field_calculator +#' @title Field calculator for time-constraint scale #' @description internal function for calculating the extra fields needed for bullet charts #' @param file_name path of Excel file #' @param sheet_name specify which sheet in Excel file diff --git a/R/internal2.R b/R/internal_bc.R similarity index 98% rename from R/internal2.R rename to R/internal_bc.R index fa92295..70bc75a 100644 --- a/R/internal2.R +++ b/R/internal_bc.R @@ -1,6 +1,6 @@ # internal functions ------------------------------------------------------ -#' @title extra_field_calculator +#' @title Field calculator for regular scale #' @description internal function for calculating the extra fields needed for bullet charts #' @param file_name path of Excel file #' @param sheet_name specify which sheet in Excel file diff --git a/man/bullet_chart.Rd b/man/bullet_chart.Rd index 1173fd6..41d48b4 100755 --- a/man/bullet_chart.Rd +++ b/man/bullet_chart.Rd @@ -2,58 +2,46 @@ % Please edit documentation in R/bulletchart.R \name{bullet_chart} \alias{bullet_chart} -\title{bullet_chart} +\title{'Stephen Few'-style Bullet Chart} \usage{ bullet_chart(file_name = NULL, sheet_name = "Sheet1", - dataframe = NULL, indicator_name = "indicator_name", - actual = "actual", actual_lastweek = "actual_lastweek", - actual_lastyear = "actual_lastyear", target = "target", - for_year = year(Sys.Date()), cal_type = "fis", - chart_type = "static", small = FALSE, legend = TRUE, - remove_no_targets = FALSE, show_text = FALSE) + dataframe = NULL, indicator_name = "variable", info = "info", + current = "current", low = "low", medium = "medium", + high = "high", target = "target", remove_no_targets = TRUE, + legend = TRUE) } \arguments{ \item{file_name}{path of Excel file} -\item{sheet_name}{Specify which sheet in Excel file, Default: "Sheet1"} +\item{sheet_name}{specify which sheet in Excel file, Default: "Sheet1"} -\item{dataframe}{Specify R dataframe input} +\item{dataframe}{specify R dataframe input} -\item{indicator_name}{Specify the name of the column that has your indicator/KPI names} +\item{indicator_name}{specify the name of the column that has your indicator/KPI names, +Default: 'variable'} -\item{actual}{Specify the name of the column that has the current value of your indicators/KPIs} +\item{info}{PARAM_DESCRIPTION, Default: 'info'} -\item{actual_lastweek}{Specify the name of the column that has the indicator/KPI value from the previous week} +\item{current}{PARAM_DESCRIPTION, Default: 'current'} -\item{actual_lastyear}{Specify the name of the column that has the indicator/KPI value from the previous year} +\item{low}{PARAM_DESCRIPTION, Default: 'low'} -\item{target}{Specify the name of the column that has the target value for the indicator/KPI} +\item{medium}{PARAM_DESCRIPTION, Default: 'medium'} -\item{for_year}{Specify the year in which the report is being made, Default: year(Sys.Date())} +\item{high}{PARAM_DESCRIPTION, Default: 'high'} -\item{cal_type}{Define what calendar you are using. Options are "fis" for fiscal year starting -October 1st, "cal" for calendar year starting January 1st, or enter your own custom date in the -format "YYYY/MM/DD", Default: fis} +\item{target}{PARAM_DESCRIPTION, Default: 'target'} -\item{chart_type}{Specify a static or interactive (ggiraph) version} +\item{remove_no_targets}{PARAM_DESCRIPTION, Default: TRUE} -\item{small}{Specify whether you want the small version of the plot (TRUE or FALSE), Default: FALSE} - -\item{legend}{Specify whether you want to show the legend, Default: TRUE} - -\item{remove_no_targets}{Remove indicators with Targets == NA or 0, Default: FALSE} - -\item{show_text}{Show 'Last Week' & 'Last Year' text, when `small = TRUE` or -`chart_type = "interactive"` then no text will be shown by default.} +\item{legend}{PARAM_DESCRIPTION, Default: TRUE} +} +\value{ +bullet chart plot(s) } \description{ -create a Stephen Few bullet chart +Creates a bullet chart using an indicator's values for the axis scales. } \details{ -This version of the bullet chart most closely resembles Stephen Few's design. The single black bar represents -the current value of the indicator while the different hue columns represent last week's value (darker hue) and last year's value (lighter hue). -} -\examples{ -load(read_example("df.rda")) -bullet_chart(dataframe = df) +Stephen Few style bullet chart } diff --git a/man/extra_field_calculator.Rd b/man/extra_field_calculator.Rd index 0c6116b..0e432f2 100755 --- a/man/extra_field_calculator.Rd +++ b/man/extra_field_calculator.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/internal.R \name{extra_field_calculator} \alias{extra_field_calculator} -\title{extra_field_calculator} +\title{Field calculator for time-constraint scale} \usage{ extra_field_calculator(file_name = NULL, sheet_name = "Sheet1", dataframe = NULL, indicator_name = "indicator_name", diff --git a/man/field_calculator.Rd b/man/field_calculator.Rd index 9811727..eb0423e 100644 --- a/man/field_calculator.Rd +++ b/man/field_calculator.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/internal2.R +% Please edit documentation in R/internal_bc.R \name{field_calculator} \alias{field_calculator} -\title{extra_field_calculator} +\title{Field calculator for regular scale} \usage{ field_calculator(file_name = NULL, sheet_name = "Sheet1", dataframe = NULL, indicator_name = "variable", info = "info", diff --git a/tests/testthat/test_bullet_chart.r b/tests/testthat/test_bullet_chart.r index ab39a55..7a197f6 100755 --- a/tests/testthat/test_bullet_chart.r +++ b/tests/testthat/test_bullet_chart.r @@ -22,17 +22,29 @@ zero_df <- tibble::tibble( target = c(0, 0, 0, 0, 0, 0) ) +## data for regular scale bulletchart +bcdatatest <- tibble::tibble( + variable = c("Revenue", "Order Size", + "New Customers", "Satisfaction"), + info = c("Count", "US $", "US $ (1000s)", "Likert Scale of 5"), + target = c(350, 500, 975, 4.5), + current = c(365, 310, 1050, 4), + low = c(220, 430, 600, 2.5), + medium = c(240, 480, 770, 3.25), + high = c(400, 505, 1100, 5) +) + ## test empty ---- testthat::test_that("error out for empty df", { - expect_error(bullet_chart(dataframe = empty_df)) + expect_error(bullet_chart_wide(dataframe = empty_df)) }) ## test all 0 targets ---- testthat::test_that("error out for zero targets df", { - expect_equal(bullet_chart(dataframe = zero_df), "No Non-Zero Targets!") + expect_equal(bullet_chart_wide(dataframe = zero_df), "No Non-Zero Targets!") }) ## Ensure both dataframe and file not provided @@ -40,7 +52,7 @@ testthat::test_that("Only one dataset inputted: dataframe OR file_name - not bot #expect_error(bullet_chart(dataframe = df, file_name = "inst/data/Indicators_Targets.xlsx")) - expect_error(bullet_chart(dataframe = test_df), NA) + expect_error(bullet_chart_wide(dataframe = test_df), NA) #expect_error(bullet_chart(file_name = "inst/data/Indicators_Targets.xlsx"), NA) @@ -66,26 +78,29 @@ testthat::test_that("correct arguments used", { checkmate::expect_character(chart_type) ## tests - expect_error(bullet_chart(dataframe = test_df, - small = small, legend = legend, + expect_error(bullet_chart(dataframe = bcdatatest, + legend = legend, remove_no_targets = remove_no_targets), NA) expect_error(bullet_chart_symbols(dataframe = test_df, + chart_type = chart_type, small = small, legend = legend, remove_no_targets = remove_no_targets), NA) expect_error(bullet_chart_vline(dataframe = test_df, + chart_type = chart_type, small = small, legend = legend, remove_no_targets = remove_no_targets), NA) expect_error(bullet_chart_wide(dataframe = test_df, + chart_type = chart_type, small = small, legend = legend, remove_no_targets = remove_no_targets), NA) ## tests interactive chart_type <- "interactive" checkmate::expect_character(chart_type) - expect_error(bullet_chart(dataframe = test_df, - small = small, legend = legend, - remove_no_targets = remove_no_targets, - chart_type = chart_type), NA) + # expect_error(bullet_chart(dataframe = bcdatatest, + # legend = legend, + # remove_no_targets = remove_no_targets, + # chart_type = chart_type), NA) expect_error(bullet_chart_symbols(dataframe = test_df, small = small, legend = legend, remove_no_targets = remove_no_targets, @@ -111,26 +126,29 @@ testthat::test_that("correct arguments used", { checkmate::expect_character(chart_type) ## tests static - expect_error(bullet_chart(dataframe = test_df, - small = small, legend = legend, + expect_error(bullet_chart(dataframe = bcdatatest, + legend = legend, remove_no_targets = remove_no_targets), NA) expect_error(bullet_chart_symbols(dataframe = test_df, + chart_type = chart_type, small = small, legend = legend, remove_no_targets = remove_no_targets), NA) expect_error(bullet_chart_vline(dataframe = test_df, + chart_type = chart_type, small = small, legend = legend, remove_no_targets = remove_no_targets), NA) expect_error(bullet_chart_wide(dataframe = test_df, + chart_type = chart_type, small = small, legend = legend, remove_no_targets = remove_no_targets), NA) ## tests interactive chart_type <- "interactive" checkmate::expect_character(chart_type) - expect_error(bullet_chart(dataframe = test_df, - small = small, legend = legend, - remove_no_targets = remove_no_targets, - chart_type = chart_type), NA) + # expect_error(bullet_chart(dataframe = bcdatatest, + # legend = legend, + # remove_no_targets = remove_no_targets, + # chart_type = chart_type), NA) expect_error(bullet_chart_symbols(dataframe = test_df, small = small, legend = legend, remove_no_targets = remove_no_targets, @@ -156,26 +174,29 @@ testthat::test_that("correct arguments used", { checkmate::expect_character(chart_type) ## tests static - expect_error(bullet_chart(dataframe = test_df, - small = small, legend = legend, + expect_error(bullet_chart(dataframe = bcdatatest, + legend = legend, remove_no_targets = remove_no_targets), NA) expect_error(bullet_chart_symbols(dataframe = test_df, + chart_type = chart_type, small = small, legend = legend, remove_no_targets = remove_no_targets), NA) expect_error(bullet_chart_vline(dataframe = test_df, + chart_type = chart_type, small = small, legend = legend, remove_no_targets = remove_no_targets), NA) expect_error(bullet_chart_wide(dataframe = test_df, + chart_type = chart_type, small = small, legend = legend, remove_no_targets = remove_no_targets), NA) ## tests interactive chart_type <- "interactive" checkmate::expect_character(chart_type) - expect_error(bullet_chart(dataframe = test_df, - small = small, legend = legend, - remove_no_targets = remove_no_targets, - chart_type = chart_type), NA) + # expect_error(bullet_chart(dataframe = bcdatatest, + # legend = legend, + # remove_no_targets = remove_no_targets, + # chart_type = chart_type), NA) expect_error(bullet_chart_symbols(dataframe = test_df, small = small, legend = legend, remove_no_targets = remove_no_targets, @@ -201,26 +222,29 @@ testthat::test_that("correct arguments used", { checkmate::expect_character(chart_type) ## tests static - expect_error(bullet_chart(dataframe = test_df, - small = small, legend = legend, + expect_error(bullet_chart(dataframe = bcdatatest, + legend = legend, remove_no_targets = remove_no_targets), NA) expect_error(bullet_chart_symbols(dataframe = test_df, + chart_type = chart_type, small = small, legend = legend, remove_no_targets = remove_no_targets), NA) expect_error(bullet_chart_vline(dataframe = test_df, + chart_type = chart_type, small = small, legend = legend, remove_no_targets = remove_no_targets), NA) expect_error(bullet_chart_wide(dataframe = test_df, + chart_type = chart_type, small = small, legend = legend, remove_no_targets = remove_no_targets), NA) ## tests interactive chart_type <- "interactive" checkmate::expect_character(chart_type) - expect_error(bullet_chart(dataframe = test_df, - small = small, legend = legend, - remove_no_targets = remove_no_targets, - chart_type = chart_type), NA) + # expect_error(bullet_chart(dataframe = bcdatatest, + # legend = legend, + # remove_no_targets = remove_no_targets, + # chart_type = chart_type), NA) expect_error(bullet_chart_symbols(dataframe = test_df, small = small, legend = legend, remove_no_targets = remove_no_targets, @@ -241,9 +265,8 @@ testthat::test_that("correct arguments used", { checkmate::expect_character(chart_type) ## static - expect_error(bullet_chart(dataframe = test_df, - cal_type = cal_type, - small = small, legend = legend, + expect_error(bullet_chart(dataframe = bcdatatest, + legend = legend, remove_no_targets = remove_no_targets), NA) expect_error(bullet_chart_symbols(dataframe = test_df, cal_type = cal_type, @@ -261,11 +284,11 @@ testthat::test_that("correct arguments used", { ## interactive chart_type <- "interactive" checkmate::expect_character(chart_type) - expect_error(bullet_chart(dataframe = test_df, - cal_type = cal_type, - small = small, legend = legend, - remove_no_targets = remove_no_targets, - chart_type = chart_type), NA) + # expect_error(bullet_chart(dataframe = bcdatatest, + # cal_type = cal_type, + # legend = legend, + # remove_no_targets = remove_no_targets, + # chart_type = chart_type), NA) expect_error(bullet_chart_symbols(dataframe = test_df, cal_type = cal_type, small = small, legend = legend, @@ -287,14 +310,14 @@ testthat::test_that("correct arguments used", { testthat::test_that("correct outputs", { ## static - expect_equal(class(bullet_chart(dataframe = test_df)), c("gg", "ggplot")) + # expect_equal(class(bullet_chart(dataframe = bcdatatest)), c("gg", "ggplot")) expect_equal(class(bullet_chart_symbols(dataframe = test_df)), c("gg", "ggplot")) expect_equal(class(bullet_chart_vline(dataframe = test_df)), c("gg", "ggplot")) expect_equal(class(bullet_chart_wide(dataframe = test_df)), c("gg", "ggplot")) ## interactive - expect_equal(class(bullet_chart(dataframe = test_df, - chart_type = "interactive")), c("girafe", "htmlwidget")) + # expect_equal(class(bullet_chart(dataframe = bcdatatest, + # chart_type = "interactive")), c("girafe", "htmlwidget")) expect_equal(class(bullet_chart_symbols(dataframe = test_df, chart_type = "interactive")), c("girafe", "htmlwidget")) expect_equal(class(bullet_chart_vline(dataframe = test_df, diff --git a/vignettes/intro-functions.Rmd b/vignettes/intro-functions.Rmd index 1296db8..c0e1095 100644 --- a/vignettes/intro-functions.Rmd +++ b/vignettes/intro-functions.Rmd @@ -27,7 +27,7 @@ This is the original chart created by Stephen Few. ```{r bulletchart, fig.width=6,fig.height=5, echo=TRUE} -bullet_chart(file_name = read_example("Indicators_Targets_ext.xlsx")) +#bullet_chart(file_name = read_example("Indicators_Targets_ext.xlsx")) ``` diff --git a/vignettes/intro-inputs.Rmd b/vignettes/intro-inputs.Rmd index c7fcccc..27462c0 100644 --- a/vignettes/intro-inputs.Rmd +++ b/vignettes/intro-inputs.Rmd @@ -50,7 +50,7 @@ With some tidy eval magic you can provide an input (Excel or dataframe) with dif As you can see we have some names like "WEEKS" or "YEArz". We can specify what each of these names correspond to inside the function call and we can still get a proper chart! ```{r weird-cols, fig.width=6,fig.height=5} -bullet_chart(file_name = read_example("test.xlsx"), +bullet_chart_wide(file_name = read_example("test.xlsx"), indicator_name = "Indicators", actual = "act", actual_lastweek = "WEEKS", diff --git a/vignettes/intro-to-bulletcharts.Rmd b/vignettes/intro-to-bulletcharts.Rmd index c8cd83a..fd1360f 100644 --- a/vignettes/intro-to-bulletcharts.Rmd +++ b/vignettes/intro-to-bulletcharts.Rmd @@ -24,11 +24,18 @@ The output of the `bullet_chart()` function most closely resembles Stephen Few's ```{r bulletchart, fig.width=6,fig.height=5, echo=TRUE} library(bulletchartr) -bullet_chart(file_name = read_example("Indicators_Targets_ext.xlsx")) +#bullet_chart(file_name = read_example("Indicators_Targets_ext.xlsx")) ``` The single black bar represents the current value of the indicator while the different hue columns represent last week's value (darker hue) and last year's value (lighter hue). The bar for each Indicator show the progression along the horizontal-axis presenting the percentage of the yearly target completed. This axis also shows the percent of the year gone by with the vertical line indicating what exact percentage "Today" is, along this percentage. + +## Time-constraint bullet chart + +```{r bulletchart-time, fig.width=6,fig.height=5, echo=TRUE} +bullet_chart_wide(file_name = read_example("Indicators_Targets_ext.xlsx")) +``` + As you can see, the bars show the progression along the horizontal-axis presenting the percentage of the yearly target completed. Also, along this axis is the percent of the year gone by with a vertical line indicating what exact percentage __"Today"__ is along this percentage. It is necessary to use percentages as we have multiple indicators of varying units/parameters for each project! The different grey colored bars represent the values of the indicator at "Last Week" and "Last Year". The grey scaled bars can represent any qualitative ranges such as "bad - good - excellent" or "disabled - repairing - fixed", etc. In the near future we will look to expand the capabilities of this package to allow users to specify these qualitative ranges to fit their needs.