remove scale_mode argument from hl()

DESCRIPTION

@@ -1,10 +1,10 @@
 Package: emphatic
 Type: Package
-Title: Exploration of Data.Frames, Matrices using ANSI Colouring
-Version: 0.1.6.9003
+Title: Highlight R Output using Colouring
+Version: 0.1.6.9004
 Author: mikefc
 Maintainer: mikefc <[email protected]>
-Description: Colour data.frame, matrix and vector output in the console.
+Description: User-defined colouring of data.frames and other R output. 
 URL: https://coolbutuseless.github.io/package/emphatic/, https://github.com/coolbutuseless/emphatic
 BugReports: https://github.com/coolbutuseless/emphatic/issues
 License: MIT + file LICENSE

NEWS.md

@@ -1,5 +1,5 @@
 
-# emphatic 0.1.6.9003  2024-04-28
+# emphatic 0.1.6.9004  2024-04-30
 
 * Removed `hl_mat()` and associated vignettes.
     * function is not exported for now as the selection process is too 
@@ -9,6 +9,7 @@
 * Refactored arguments to `hl()` for more clarity
 * Added latex output so Quarto/Rmd will show emphatic objects when 
   rendered to PDF
+* Remove `scale_mode` argument to `hl()`
 
 # emphatic 0.1.6  2024-04-27
 

R/hl-dataframe.R

@@ -102,7 +102,6 @@ hl_inner <- function(.data, palette, row_ids, column, dest_col_ids, elem, show_l
   # This inner function only accpt a single source column.
   # but results can be applied to multiple 'scale_apply' columns
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  stopifnot(length(column) == 1)
   stopifnot(is.numeric(column))
   stopifnot(is.numeric(row_ids))
 
@@ -117,7 +116,7 @@ hl_inner <- function(.data, palette, row_ids, column, dest_col_ids, elem, show_l
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   if (inherits(palette, 'ScaleContinuous')) {
     stopifnot(all(palette$aesthetics %in% c('colour', 'color', 'fill')))
-    vals         <- .data[[column]][row_ids]
+    vals <- unlist(.data[row_ids, column])
     palette$train(vals)
     final_colour <- palette$map(vals)
 
@@ -133,7 +132,7 @@ hl_inner <- function(.data, palette, row_ids, column, dest_col_ids, elem, show_l
 
   } else if (inherits(palette, 'ScaleDiscrete')) {
     stopifnot(all(palette$aesthetics %in% c('colour', 'color', 'fill')))
-    vals <- .data[[column]][row_ids]
+    vals <- unlist(.data[row_ids, column])
     palette$train(vals)
     final_colour <- palette$map(vals)
 
@@ -202,25 +201,14 @@ hl_inner <- function(.data, palette, row_ids, column, dest_col_ids, elem, show_l
 #'        a vector of R colours, or
 #'        a \code{ggplot2} style "Scale" object e.g. \code{scale_colour_continuous()}.
 #' @param rows,cols specification for rows and columns to target.  Default is NULL
-#'        for both rows and columns,
-#'        which will target all columns/rows. See documentation for \code{hl()}
-#'        for the valid types of row/column specifcations.
-#' @param scale_apply specification of destination columns to colour. If
-#'        missing (the default), this function
-#'        will only colour the columns specified in the \code{cols} argument.
-#'        Use NULL to colour all columns.  See documentation for \code{hl()}
-#'        for the valid types of column specifcations.
-#' @param scale_mode If \code{palette} is a \code{ggplot2} "Scale" object, this
-#'        option defines how the scale should be applied.
-#'        \describe{
-#'          \item{first}{(default)the colours to use are calculated using the scale applied
-#'          to the first specified column in \code{cols}.  The colours calculated
-#'          on this first column are then copied to the other columns specified
-#'          in \code{scale_apply}}.
-#'          \item{each}{the colour scale is applied individually to each column
-#'          in turn. \code{scale_mode = 'each'} can only be applied if
-#'          \code{scale_apply} is identical to \code{cols}}.
-#'        }
+#'        for both rows and columns, which will target all columns/rows.
+#'        When \code{palette} argument is a \code{scale} object, then \code{cols}
+#'        indicates the columns which will be used to calculate the extents of
+#'        the scale.
+#' @param scale_apply Only valid when palette is a \code{scale} object, specify
+#'        the target columns to colour. If missing (the default), this function
+#'        will only colour the column specified in the \code{cols} argument.
+#'        Use NULL to colour all columns.
 #' @param elem Apply the highlighting to the 'fill' (the background) or the 'text'.
 #'        Default: 'fill'
 #' @param show_legend if a scale object is used for colour, and \code{show_legend = TRUE},
@@ -229,25 +217,21 @@ hl_inner <- function(.data, palette, row_ids, column, dest_col_ids, elem, show_l
 #' @inheritParams hl_grep
 #'
 #' @examples
-#' \dontrun{
 #' hl(mtcars, ggplot2::scale_colour_viridis_c(), rows = cyl == 6, cols = mpg,
 #'    scale_apply = c(mpg, cyl))
-#' }
 #'
 #'
 #' @export
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 hl <- function(.data, palette,
                rows = NULL, cols = NULL,
                scale_apply,
-               scale_mode = 'first',
                elem = 'fill',
                show_legend = FALSE,
                opts = hl_opts()) {
 
   stopifnot(is.data.frame(.data))
   stopifnot(elem %in% c('text', 'fill'))
-  stopifnot(scale_mode %in% c('first', 'each'))
 
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   # Promote to 'emphatic' object if necessary
@@ -293,31 +277,21 @@ hl <- function(.data, palette,
       col_ids  = col_ids,
       elem     = elem
     )
-  } else if (inherits(palette, "Scale") && scale_mode == 'first') {
+  } else if (inherits(palette, "Scale")) {
+    if (length(col_ids) > 1) {
+      if (!identical(dest_col_ids, col_ids)) {
+        stop("Can't specify 'scale_apply' when 'palette' is a scale applied to more than 1 column")
+      }
+    }
     .data <- hl_inner(
       .data,
       palette      = palette,
       row_ids      = row_ids,
-      column       = col_ids[1],
+      column       = col_ids,
       dest_col_ids = dest_col_ids,
       elem         = elem,
       show_legend  = show_legend
     )
-  } else if (inherits(palette, "Scale") && scale_mode == 'each') {
-    if (!identical(col_ids, dest_col_ids)) {
-      stop("scale_mode = 'each' can only be used if 'scale_apply' is identical to 'columns'")
-    }
-    for (col_id in col_ids) {
-      .data <- hl_inner(
-        .data,
-        palette      = palette,
-        row_ids      = row_ids,
-        column       = col_id,
-        dest_col_ids = col_id,
-        elem         = elem,
-        show_legend  = show_legend
-      )
-    }
   } else {
     stop("'palette' not understood: ", deparse1(palette))
   }

R/legend.R

@@ -58,8 +58,12 @@ create_legend_string <- function(
   # Insert label at front if provided
   #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   if (!is.null(label)) {
-    stopifnot(length(label) == 1)
-    label <- sprintf("%s: ", label)
+    # stopifnot(length(label) == 1)
+    if (length(label) > 1) {
+      label <- "   "
+    } else {
+      label <- sprintf("%s: ", label)
+    }
     key_vals <- c(label, key_vals)
     text <- c(NA, text)
     fill <- c(NA, key_cols)

README.Rmd

@@ -58,6 +58,7 @@ image_read("man/figures/logo.png")
 
 <!-- badges: start -->
 ![](https://img.shields.io/badge/cool-useless-green.svg)
+![](https://img.shields.io/badge/developing-rapidly-orange.svg)
 [![R-CMD-check](https://github.com/coolbutuseless/emphatic/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/coolbutuseless/emphatic/actions/workflows/R-CMD-check.yaml)
 <!-- badges: end -->
 

README.md

@@ -6,6 +6,7 @@
 <!-- badges: start -->
 
 ![](https://img.shields.io/badge/cool-useless-green.svg)
+![](https://img.shields.io/badge/developing-rapidly-orange.svg)
 [![R-CMD-check](https://github.com/coolbutuseless/emphatic/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/coolbutuseless/emphatic/actions/workflows/R-CMD-check.yaml)
 <!-- badges: end -->
 

vignettes/specify-colours.Rmd

@@ -66,7 +66,8 @@ Specify a colour scale to apply to multiple variables independently
 
 ```{r}
 test_df |>
-  hl(ggplot2::scale_colour_viridis_c(), cols = mpg:disp, scale_mode = 'each')
+  hl(ggplot2::scale_colour_viridis_c(), cols = mpg, show_legend = TRUE) |>
+  hl(ggplot2::scale_colour_viridis_c(), cols = disp, show_legend = TRUE)
 ```