Feature/samybrand

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),

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)
 }
-
-
-

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)

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)

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

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

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;
+}

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