diff --git a/DESCRIPTION b/DESCRIPTION index f3f5e77..19c4c17 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,10 +13,10 @@ Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 URL: https://jpcompartir.github.io/DisplayR/ Imports: + cli, dplyr (>= 1.1.0), flextable (>= 0.9.0), - ggdist, - gghalves, + ggdist (>= 3.3.3), ggplot2 (>= 3.4.2), gt (>= 0.9.0), lubridate (>= 1.8.0), diff --git a/R/brands.R b/R/brands.R index 8a6b7e5..c34812c 100644 --- a/R/brands.R +++ b/R/brands.R @@ -2,30 +2,36 @@ #' #' @description Check which brands a _brand.yml and an optional 'logo.png' have been uploaded to DisplayR for. #' +#' @param quiet whether to print the name of detected brands or not. #' @returns A list of folder names relating to brands/ #' @export #' #' @examples #' brands <- dr_list_brands() -dr_list_brands <- function(){ - brands_path <- system.file("brands", package = "DisplayR") +dr_list_brands <- function(quiet = FALSE){ + brands_path <- system.file("brands", package = "DisplayR") - brands <- list.dirs(brands_path, full.names = FALSE, recursive = FALSE) + brands <- list.dirs(brands_path, full.names = FALSE, recursive = FALSE) |> + purrr::keep(~ file.exists(file.path(brands_path, .x, "_brand.yml"))) + if (quiet) return(invisible(brands)) - # Chepck for _brand.yml - has_brand_yml <- sapply(brands, function(brand) { - file.exists(file.path(brands_path, brand, "_brand.yml")) - }) + if (length(brands) == 0) { + cli::cli_alert_info("No brands available") + } else { + cli::cli_alert_success("{length(brands)} brand{?s} available") + cli::cli_ul(brands) + } - return(brands[has_brand_yml]) + return(invisible(brands)) } #' Add brand styling to your project #' -#' @description Add a _brand.yml and a logo.png to your project from DisplayR's inst/brands folder. If you need a new brand to be added, contact the Data Science Team +#' @description Add brand files to your project from DisplayR's inst/brands folder. If you need a new brand to be added, contact the Data Science Team #' @param brand Name of the brand you wish to load, as it appears in `dr_list_brands()` #' @param directory The directory you want the brand information to be added to, as a default it uses the current working directory +#' @param overwrite Whether to overwrite any existing files #' #' @returns Invisible #' @export @@ -35,42 +41,45 @@ dr_list_brands <- function(){ #' brands <- dr_list_brands() #' dr_add_brand("shareds") #' -dr_add_brand <- function(brand, directory = getwd()) { +dr_add_brand <- function(brand, directory = getwd(), overwrite = NULL) { + # just mkae sure the brand does in fact exist + if (!brand %in% dr_list_brands(quiet = TRUE)) { + cli::cli_abort("Brand '{brand}' not found. Use {.fn dr_list_brands} to see available brands.") + } - brands_path <- system.file("brands", package = "DisplayR") - brands <- list.dirs(brands_path, full.names = FALSE, recursive = FALSE) + brand_path <- file.path(system.file("brands", package = "DisplayR"), brand) + brand_files <- list.files(brand_path, full.names = TRUE) + destination_files <- file.path(directory, basename(brand_files)) + existing_files <- basename(brand_files)[file.exists(destination_files)] - if(!brand %in% brands) { - stop(sprintf("Brand: '%s' not found in listed brands", brand)) + # if files already exist, ask the user whether to overwrite or not + if(interactive()){ + if (is.null(overwrite) && length(existing_files) > 0) { + cli::cli_ul(existing_files) + choice <- utils::menu(c("Yes", "No"), title = "Overwrite existing files?") + overwrite <- choice == 1 + } } - brand_path <- file.path(brands_path, brand) + # default to TRUE if still NULL (no existing files or not specified) + overwrite <- overwrite %||% TRUE - if(!file.exists(file.path(brand_path, "_brand.yml"))){ - stop("No _brand.yml found in brands folder") - } else { - brand_yml <- file.path(brand_path, "_brand.yml") + # if user didn't want to overwrite let them know what happened + if (!overwrite && length(existing_files) > 0) { + cli::cli_alert_danger("Files already exist and were not overwritten:") + cli::cli_ul(existing_files) + cli::cli_alert_danger("Repeat: the above files were {.strong not} overwritten.") + return(invisible(character(0))) } - file.copy( - from = brand_yml, - to = directory, - overwrite = TRUE - ) + copied <- file.copy(brand_files, directory, overwrite = overwrite) + copied_files <- basename(brand_files)[copied] - has_logo <- file.exists(file.path(brand_path, "logo.png")) - if(has_logo){ - file.copy( - from = file.path(brand_path, "logo.png"), - to = directory, - overwrite = TRUE - ) - } else { - message(sprintf("No 'logo.png' found in '%s' ", brand_path)) + # let the user know what happened when we do overwrite + if (length(copied_files) > 0) { + cli::cli_alert_success("Added {.strong {brand}} brand files:") + cli::cli_ul(copied_files) } - invisible(TRUE) + invisible(copied_files) } - - - diff --git a/R/plots_distribution.R b/R/plots_distribution.R index 3a62f46..34d6883 100644 --- a/R/plots_distribution.R +++ b/R/plots_distribution.R @@ -67,11 +67,16 @@ dr_plot_raincloud <- function(data, color = NA, ## remove slab interval position = ggplot2::position_nudge(x = 0.15) ) + - gghalves::geom_half_point( - side = "l", - range_scale = 0.3, + ggplot2::geom_jitter( + width = 0.05, + height = 0, alpha = 0.5 ) + + # gghalves::geom_half_point( + # side = "l", + # range_scale = 0.3, + # alpha = 0.5, + # ) + theme_boilerplate() return(plot_raincloud) diff --git a/R/themes.R b/R/themes.R index 7ed290c..9308d29 100644 --- a/R/themes.R +++ b/R/themes.R @@ -91,7 +91,7 @@ dr_theme_microsoft <- function(scale_type = c("discrete", "continuous"), } -#' theme_microsoft_continous +#' theme_microsoft_continuous #' #' Adds Microsoft colours and font to continous plot. #' @param index Choose palettes colours by index by setting index equal to a character vector e.g. c(1,2,3) or c(1:3) diff --git a/inst/brands/samyds/_brand.yml b/inst/brands/samyds/_brand.yml new file mode 100644 index 0000000..73176a1 --- /dev/null +++ b/inst/brands/samyds/_brand.yml @@ -0,0 +1,43 @@ +color: + palette: + samy-nero-black: "#232323" + samy-inferno: "#FF5D17" + samy-peach: "#F7AB81" + samy-turquoise: "#1C7E76" + samy-crimson: "#B80F0A" + samy-blue: "#191970" + samy-bg: "#F7F7F7" + samy-green: "#028A0F" + primary: samy-peach + background: samy-bg + foreground: samy-nero-black + secondary: samy-nero-black + danger: samy-crimson + +typography: + fonts: + - family: Helvetica + source: system + base: + family: Helvetica + weight: 300 + headings: + family: Helvetica + weight: 400 + color: samy-nero-black + link: + color: samy-nero-black + decoration: underline + + monospace: + background-color: white + monospace-inline: + color: samy-inferno + background-color: white + monospace-block: + background-color: white + +logo: + small: samy_isotype.png + medium: samy_logotype.png + large: samy_logotype.png diff --git a/inst/brands/samyds/_quarto.yml b/inst/brands/samyds/_quarto.yml new file mode 100644 index 0000000..258a101 --- /dev/null +++ b/inst/brands/samyds/_quarto.yml @@ -0,0 +1,53 @@ +project: + execute-dir: project + output-dir: quarto_files + +code-annotations: select +theme: [default, samy-theme.scss] + +format: + html: + author: "SAMY Data Science" + code-copy: true + code-block-bg: "#FFFFFF" + code-tools: true + code-fold: true + code-overflow: wrap + embed-resources: true + fig-align: center + highlight-style: tango + link-external-icon: true + link-external-newwindow: true + number-sections: true + toc: true + toc-depth: 3 + toc-expand: true + toc-location: left + revealjs: + cap-location: bottom + footer: "SAMY UK" + logo: small + number-sections: false + preview-links: true + self-contained: true + scrollable: true + smaller: true + slide-number: c/t + slide-zoom: true + toc: false + +knitr: + opts_chunk: + out.width: "600px" + out.height: "400px" + fig.align: "center" + +execute: + warning: false + message: false + eval: true + echo: true + include: true + +brand: + _brand.yml diff --git a/inst/brands/samyds/samy-theme.scss b/inst/brands/samyds/samy-theme.scss new file mode 100644 index 0000000..7233cfa --- /dev/null +++ b/inst/brands/samyds/samy-theme.scss @@ -0,0 +1,75 @@ +/*-- scss:defaults --*/ +/*Brand Palette */ +$samy-nero-black: #232323; +$samy-inferno: #FF5D17; +$samy-peach: #F7AB81; +$samy-turquoise: #1C7E76; +$samy-crimson: #B80F0A; +$samy-blue: #191970; +$samy-bg: #F7F7F7; +$samy-green: #028A0F; +$samy-pink: #FDA4BA; + +/* Callout colours */ +$callout-color-note: $samy-blue; +$callout-color-tip: $samy-green; +$callout-color-caution: $samy-peach; +$callout-color-warning: $samy-crimson; +$callout-color-important: $samy-pink; + +/*-- scss:rules */ +/* Add single border to the outermost container */ +.cell-code { + border-left: 4px solid $samy-peach !important; +} + +blockquote, + .blockquote { + background-color: white; + padding: 1.5rem; + border-left: 4px solid $samy-inferno; + color: #232323; + font-size: 1.1rem; + font-weight: 500; + border-radius: 0.375rem; + margin: 1.5rem 0; + box-shadow: 0 2px 4px rgba(0,0,0,0.1); +} + +.reveal blockquote { + background-color: white !important; + border-left: 4px solid $samy-inferno !important; + box-shadow: 0 2px 4px rgba(0,0,0,0.1) !important; + font-style: normal !important; /* Reveal.js often italicises blockquotes */ + width: 95% !important; + margin: 1rem auto !important; + padding: 1.5rem !important; +} + +.reveal pre { + max-height: 500px; + overflow-y: auto; +} + +.reveal pre code { + max-height: inherit; + padding: 0.5em; + /* Remove any min-height that might be set */ + min-height: auto !important; + /* Ensure no extra padding at bottom */ + padding: 1.5rem !important; +} + +/* Remove empty lines at the end of code blocks */ +.reveal pre code:after { + content: none !important; +} + +.quarto-title-block .quarto-title-banner { + background-image: url(samy_logotype.png); + background-size: 300px; + background-position: left; + background-repeat: no-repeat; + padding-left: 10px; + background-origin: content-box; +} diff --git a/inst/brands/samyds/samy_isotype.png b/inst/brands/samyds/samy_isotype.png new file mode 100644 index 0000000..4f8a3ba Binary files /dev/null and b/inst/brands/samyds/samy_isotype.png differ diff --git a/inst/brands/samyds/samy_logotype.png b/inst/brands/samyds/samy_logotype.png new file mode 100644 index 0000000..4f8a3ba Binary files /dev/null and b/inst/brands/samyds/samy_logotype.png differ diff --git a/man/dr_add_brand.Rd b/man/dr_add_brand.Rd index c9d47f4..1722ff8 100644 --- a/man/dr_add_brand.Rd +++ b/man/dr_add_brand.Rd @@ -4,18 +4,20 @@ \alias{dr_add_brand} \title{Add brand styling to your project} \usage{ -dr_add_brand(brand, directory = getwd()) +dr_add_brand(brand, directory = getwd(), overwrite = NULL) } \arguments{ \item{brand}{Name of the brand you wish to load, as it appears in \code{dr_list_brands()}} \item{directory}{The directory you want the brand information to be added to, as a default it uses the current working directory} + +\item{overwrite}{Whether to overwrite any existing files} } \value{ Invisible } \description{ -Add a _brand.yml and a logo.png to your project from DisplayR's inst/brands folder. If you need a new brand to be added, contact the Data Science Team +Add brand files to your project from DisplayR's inst/brands folder. If you need a new brand to be added, contact the Data Science Team } \examples{ diff --git a/man/dr_list_brands.Rd b/man/dr_list_brands.Rd index 5be12ad..c2a4317 100644 --- a/man/dr_list_brands.Rd +++ b/man/dr_list_brands.Rd @@ -4,7 +4,10 @@ \alias{dr_list_brands} \title{View which brands have styling options available for them} \usage{ -dr_list_brands() +dr_list_brands(quiet = FALSE) +} +\arguments{ +\item{quiet}{whether to print the name of detected brands or not.} } \value{ A list of folder names relating to brands/ diff --git a/man/theme_microsoft_continuous.Rd b/man/theme_microsoft_continuous.Rd index 5ec0e53..99154dc 100644 --- a/man/theme_microsoft_continuous.Rd +++ b/man/theme_microsoft_continuous.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/themes.R \name{theme_microsoft_continuous} \alias{theme_microsoft_continuous} -\title{theme_microsoft_continous} +\title{theme_microsoft_continuous} \usage{ theme_microsoft_continuous( index = NULL, diff --git a/tests/testthat/test-plots_sentiment.R b/tests/testthat/test-plots_sentiment.R index 6aa8a65..7d51ac1 100644 --- a/tests/testthat/test-plots_sentiment.R +++ b/tests/testthat/test-plots_sentiment.R @@ -1,6 +1,4 @@ test_that("dr_plot_sent is rendering a ggplot when it should and failing when it should", { - - expect_error(dr_plot_sent_vot(df, sentiment_var = sentiment, date_var = date)) df <- DisplayR::disp_example plot <- dr_plot_sent(df, sentiment, "percent") @@ -26,11 +24,6 @@ test_that("dr_plot_sent is rendering a ggplot when it should and failing when it test_that("grouped sentiment plot is functioning as expeced", { - #test plot raises an error when data frame doesn't exist - expect_error(dr_plot_sent_group(df, group_var = topic, - sentiment_var = sentiment, - plot_type = "percent", - bar_labels = "volume")) df <- DisplayR::disp_example #test plot renders a ggplot object and the first value of n == 57 diff --git a/tests/testthat/test-table_gt.R b/tests/testthat/test-table_gt.R index dc11d73..e0e28fd 100644 --- a/tests/testthat/test-table_gt.R +++ b/tests/testthat/test-table_gt.R @@ -68,10 +68,10 @@ test_that("disp_gt_sent_time is functioning as expected", { plot_build <- ggplot2::ggplot_build(plot) # Colours are as expected - expect_equal(unique(plot_build$data[[1]][[1]]), c("#c00000", "black", "#1b7837")) + expect_equal(unique(plot_build$data[[1]][["colour"]]), c("#c00000", "black", "#1b7837")) # Data is as expected - expect_equal(plot_build$data[[1]][[4]][[1]], 119) + expect_equal(plot_build$data[[1]][["y"]][[1]], 119) # time_unit is functioning plot_weekly <- disp_gt_sent_time(df, sentiment, time_unit = "week") diff --git a/tests/testthat/test-themes.R b/tests/testthat/test-themes.R index 986f9a5..390b72b 100644 --- a/tests/testthat/test-themes.R +++ b/tests/testthat/test-themes.R @@ -36,7 +36,7 @@ test_that("theme_boilerplate() returns ggplot object when theme applied", { plot_boilerplate <- plot + theme_boilerplate() - expect_true(ggplot2::is.ggplot(plot_boilerplate)) + expect_true(ggplot2::is_ggplot(plot_boilerplate)) }) @@ -139,7 +139,7 @@ test_that("theme_boilerplate() has desired behaviour towards axis aesthetics", theme_boilerplate() # axis ticks - expect_type(plot_boilerplate$theme$axis.ticks, "list") + expect_s3_class(plot_boilerplate$theme$axis.ticks, "element_line") # axis ticks colour expect_true(plot_boilerplate$theme$axis.ticks$colour == "grey20") # axis line colour @@ -159,7 +159,7 @@ test_that("theme_boilerplate() has desired behaviour towards legend aesthetics", theme_boilerplate() # legend key - expect_type(plot_boilerplate$theme$legend.key, "list") + expect_s3_class(plot_boilerplate$theme$legend.key, "element_rect") # legend key colour expect_true(is.na(plot_boilerplate$theme$legend.key$colour)) # legend key fill