diff --git a/DESCRIPTION b/DESCRIPTION index aec91f0..2a4d3a0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -10,7 +10,7 @@ BugReports: https://github.com/coolbutuseless/emphatic/issues License: MIT + file LICENSE Encoding: UTF-8 LazyData: true -RoxygenNote: 7.1.1 +RoxygenNote: 7.1.1.9000 Depends: R (>= 2.10) Suggests: diff --git a/NAMESPACE b/NAMESPACE index 669e313..93fb79b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,5 +15,6 @@ export(is_emphatic) export(knit_print.emphatic) importFrom(grDevices,col2rgb) importFrom(grDevices,convertColor) +importFrom(grDevices,rainbow) importFrom(grDevices,rgb) importFrom(utils,modifyList) diff --git a/R/data.frame.R b/R/data.frame.R index 5092359..91df0a7 100644 --- a/R/data.frame.R +++ b/R/data.frame.R @@ -1,5 +1,17 @@ +#' Check if a data frame is grouped +#' +#' Internal replication of dplyr::is.grouped_df() +#' +#' @param x An object +#' +#' @return Logical: TRUE if dataframe is grouped; false if not. +#' +#' @noRd +is_grouped <- function(x) { + inherits(x, "grouped_df") +} #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #' Highlight elements by location within an \code{emphatic} data.frame or matrix. @@ -74,6 +86,10 @@ hl_loc <- function(.data, colour, row_ids, col_ids, elem = 'fill', major = 'row' } } + + + + #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # Assign colour #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -85,10 +101,6 @@ hl_loc <- function(.data, colour, row_ids, col_ids, elem = 'fill', major = 'row' .data } - - - - #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ #' Private inner function for highlighting #' @@ -203,6 +215,10 @@ hl_inner <- function(.data, colour, row_ids, column, dest_col_ids, elem, show_le #' in \code{dplyr::filter()}. E.g. \code{cyl == 6 & mpg > 20}} #' } #' +#' Grouped data frames are also supported. Colours are not required for grouped +#' dataframes, but can be supplied. Additional highlighting customization can be +#' specified with the the `cols` and `elem` arguments. Other arguments are not +#' supported for grouped data frames. #' #' @param .data \code{emphatic} data.frame #' @param colour colour to use for highlighting. This may be an R colour, @@ -234,6 +250,7 @@ hl_inner <- function(.data, colour, row_ids, column, dest_col_ids, elem, show_le #' then a colourbar legend will be added to the bottom of the output. #' Default: FALSE #' +#' @importFrom grDevices rainbow #' @examples #' \dontrun{ #' hl(mtcars, ggplot2::scale_colour_viridis_c(), rows = cyl == 6, cols = mpg, dest_cols = c(mpg, cyl)) @@ -245,6 +262,38 @@ hl_inner <- function(.data, colour, row_ids, column, dest_col_ids, elem, show_le hl <- function(.data, colour, rows = NULL, cols = NULL, dest_cols, calc_scale = 'first', elem = 'fill', show_legend = FALSE) { + if (is_grouped(.data)) { + + # Grouped data frames can only be created with dplyr, so this is a bit + # redundant. Just being careful. + if (requireNamespace("dplyr", quietly = TRUE)) { + rows <- dplyr::group_rows(.data) + colours <- grDevices::rainbow(length(rows)) + + # Check if user supplied colours. If they supplied for each group, use + # those. Otherwise use default rainbow. + if (!missing(colour)) { + if (length(colour) == length(rows)) { + colours <- colour + } + else { + warning("Number of colours supplied does not match number of groups. Defaulting to rainbow colours.") + } + } + + .data <- dplyr::ungroup(.data) + + col <- loc_expr_to_ids(.data, expr = substitute(cols), axis = 'column') + + for (i in 1:length(rows)) { + .data <- hl_loc(.data, colour = colours[i], row_ids = rows[[i]], col_ids = col, elem = elem) + } + return(.data) + } else { + stop("dplyr package is required for highlighting grouped data frames. Please load and retry.") + } + } + stopifnot(is.data.frame(.data)) stopifnot(elem %in% c('text', 'fill')) stopifnot(calc_scale %in% c('first', 'each')) diff --git a/man/hl.Rd b/man/hl.Rd index 598f179..31e80c8 100644 --- a/man/hl.Rd +++ b/man/hl.Rd @@ -90,6 +90,11 @@ as \code{filter()} and \code{select()} the highlighting should apply to. These will look like statements used in \code{dplyr::filter()}. E.g. \code{cyl == 6 & mpg > 20}} } + +Grouped data frames are also supported. Colours are not required for grouped +dataframes, but can be supplied. Additional highlighting customization can be +specified with the the `cols` and `elem` arguments. Other arguments are not +supported for grouped data frames. } \examples{ diff --git a/vignettes/specify-rows.Rmd b/vignettes/specify-rows.Rmd index f4141cf..097c153 100644 --- a/vignettes/specify-rows.Rmd +++ b/vignettes/specify-rows.Rmd @@ -29,10 +29,7 @@ hl_opt_global(dark_mode = FALSE) test_df <- head(mtcars, 10) ``` - - -Select all rows ------------------------------------------------------------------------------- +## Select all rows ```{r} test_df %>% @@ -49,50 +46,42 @@ test_df %>% hl('skyblue', rows = .all) ``` - -Select rows by index ------------------------------------------------------------------------------- +## Select rows by index ```{r} test_df %>% hl('skyblue', rows = 2:5) ``` -Select rows by name ------------------------------------------------------------------------------- +## Select rows by name ```{r} test_df %>% hl('skyblue', rows = c('Mazda RX4', 'Datsun 710')) ``` -Select rows by rowname symbol ------------------------------------------------------------------------------- +## Select rows by rowname symbol ```{r} test_df %>% hl('skyblue', rows = Valiant) ``` - -Select rows by expression ------------------------------------------------------------------------------- +## Select rows by expression ```{r} test_df %>% hl('skyblue', rows = mpg > 22) ``` -Select rows using `n()` and `row_number()` ------------------------------------------------------------------------------- +## Select rows using `n()` and `row_number()` ```{r} test_df %>% hl('skyblue', rows = row_number() > n()/2) ``` -Select rows using selectors like `tidyselect` ------------------------------------------------------------------------------- +## Select rows using selectors like `tidyselect` ```{r} test_df %>% @@ -104,9 +93,19 @@ test_df %>% hl('skyblue', rows = starts_with('m')) ``` - ```{r} test_df %>% hl('skyblue', rows = any_of(c('Valiant', 'Herbie', 'Datsun 710'))) ``` +Select rows using grouped data frames + +------------------------------------------------------------------------ + +> Note: For grouped data frames, colours may be supplied for each group but will be chosen automatically if not. Additional customization can be done with the `cols` and `elem` arguments. Other arguments are not supported for grouped data frames. + +```{r} +test_df %>% + group_by(cyl) %>% + hl() +```