Merge branch 'main' into colour_color

R/class-workbook-utils.R

@@ -125,7 +125,7 @@ wb_check_overwrite_tables <- function(
 
 
 validate_cf_params <- function(params) {
- bad <- names(params) %out% c("showValue", "gradient", "border", "percent", "rank")
+ bad <- names(params) %out% c("border", "gradient", "iconSet", "percent", "rank", "reverse", "showValue")
  if (any(bad)) {
  stop("Invalid parameters: ", toString(names(params)[bad]))
  }

R/class-workbook-wrappers.R

@@ -2618,7 +2618,7 @@ wb_remove_comment <- function(
 #' `[params$gradient]`\cr If `FALSE` colour gradient is removed. Default `TRUE`\cr\cr
 #' `[params$border]`\cr If `FALSE` the border around the database is hidden. Default `TRUE`
 #' }
-#' \item{duplicated}{
+#' \item{duplicatedValues/uniqueValues/containsErrors}{
 #' `[style]`\cr A `Style` object
 #' }
 #' \item{contains}{
@@ -2639,6 +2639,15 @@ wb_remove_comment <- function(
 #' `[params$rank]`\cr A `numeric` vector of length `1` indicating number of lowest values. Default `5L`\cr\cr
 #' `[params$percent]`\cr If `TRUE` uses percentage
 #' }
+#' \item{iconSet}{
+#' `[params$showValue]`\cr If `FALSE` the cell value is hidden. Default `TRUE`\cr\cr
+#' `[params$reverse]`\cr If `TRUE` the order is reversed. Default `FALSE`\cr\cr
+#' `[params$percent]`\cr If `TRUE` uses percentage\cr\cr
+#' `[params$iconSet]`\cr Uses one of the implemented icon sets. Values must match the length of the icons
+#' in the set 3Arrows, 3ArrowsGray, 3Flags, 3Signs, 3Symbols, 3Symbols2, 3TrafficLights1, 3TrafficLights2,
+#' 4Arrows, 4ArrowsGray, 4Rating, 4RedToBlack, 4TrafficLights, 5Arrows, 5ArrowsGray, 5Quarters, 5Rating. The
+#' default is 3TrafficLights1.
+#' }
 #' }
 #'
 #' @examples
@@ -2654,8 +2663,13 @@ wb_add_conditional_formatting <- function(
  rows,
  rule = NULL,
  style = NULL,
- type = c("expression", "colorScale", "dataBar", "duplicatedValues",
- "containsText", "notContainsText", "beginsWith", "endsWith",
+ type = c("expression", "colorScale",
+ "dataBar", "iconSet",
+ "duplicatedValues", "uniqueValues",
+ "containsErrors", "notContainsErrors",
+ "containsBlanks", "notContainsBlanks",
+ "containsText", "notContainsText",
+ "beginsWith", "endsWith",
  "between", "topN", "bottomN"),
  params = list(
  showValue = TRUE,

R/class-workbook.R

@@ -3220,8 +3220,13 @@ wbWorkbook <- R6::R6Class(
  rule = NULL,
  style = NULL,
  # TODO add vector of possible values
- type = c("expression", "colorScale", "dataBar", "duplicatedValues",
- "containsText", "notContainsText", "beginsWith", "endsWith",
+ type = c("expression", "colorScale",
+ "dataBar", "iconSet",
+ "duplicatedValues", "uniqueValues",
+ "containsErrors", "notContainsErrors",
+ "containsBlanks", "notContainsBlanks",
+ "containsText", "notContainsText",
+ "beginsWith", "endsWith",
  "between", "topN", "bottomN"),
  params = list(
  showValue = TRUE,
@@ -3251,7 +3256,9 @@ wbWorkbook <- R6::R6Class(
  params <- validate_cf_params(params)
  values <- NULL
 
- sel <- c("expression", "duplicatedValues", "containsText", "notContainsText", "beginsWith", "endsWith", "between", "topN", "bottomN")
+ sel <- c("expression", "duplicatedValues", "containsText", "notContainsText", "beginsWith",
+ "endsWith", "between", "topN", "bottomN", "uniqueValues", "iconSet",
+ "containsErrors", "notContainsErrors", "containsBlanks", "notContainsBlanks")
  if (is.null(style) && type %in% sel) {
  smp <- random_string()
  style <- create_dxfs_style(font_color = wb_colour(hex = "FF9C0006"), bgFill = wb_colour(hex = "FFFFC7CE"))
@@ -3347,6 +3354,12 @@ wbWorkbook <- R6::R6Class(
  rule <- style
  },
 
+ iconSet = {
+ # - rule is the iconSet values
+ msg <- "When type == 'iconSet', "
+ values <- rule
+ },
+
  duplicatedValues = {
  # type == "duplicatedValues"
  # - style is a Style object
@@ -3355,6 +3368,46 @@ wbWorkbook <- R6::R6Class(
  rule <- style
  },
 
+ uniqueValues = {
+ # type == "uniqueValues"
+ # - style is a Style object
+ # - rule is ignored
+
+ rule <- style
+ },
+
+ containsBlanks = {
+ # - style is Style object
+ # - rule is cell to check for errors
+ msg <- "When type == 'containsBlanks', "
+
+ rule <- style
+ },
+
+ notContainsBlanks = {
+ # - style is Style object
+ # - rule is cell to check for errors
+ msg <- "When type == 'notContainsBlanks', "
+
+ rule <- style
+ },
+
+ containsErrors = {
+ # - style is Style object
+ # - rule is cell to check for errors
+ msg <- "When type == 'containsErrors', "
+
+ rule <- style
+ },
+
+ notContainsErrors = {
+ # - style is Style object
+ # - rule is cell to check for errors
+ msg <- "When type == 'notContainsErrors', "
+
+ rule <- style
+ },
+
  containsText = {
  # - style is Style object
  # - rule is text to look for
@@ -6357,6 +6410,24 @@ wbWorkbook <- R6::R6Class(
  ## bottomN ----
  bottomN = cf_bottom_n(dxfId, values),
 
+ ## uniqueValues ---
+ uniqueValues = cf_unique_values(dxfId),
+
+ ## iconSet ----
+ iconSet = cf_icon_set(values, params),
+
+ ## containsErrors ----
+ containsErrors = cf_iserror(dxfId, sqref),
+
+ ## notContainsErrors ----
+ notContainsErrors = cf_isnoerror(dxfId, sqref),
+
+ ## containsBlanks ----
+ containsBlanks = cf_isblank(dxfId, sqref),
+
+ ## notContainsBlanks ----
+ notContainsBlanks = cf_isnoblank(dxfId, sqref),
+
  # do we have a match.arg() anywhere or will it just be showned in this switch()?
  stop("type `", type, "` is not a valid formatting rule")
  )

R/conditional_formatting.R

@@ -356,3 +356,148 @@ cf_bottom_n <- function(dxfId, values) {
 
  cf_rule
 }
+
+#' @rdname cf_rules
+#' @keywords internal
+#' @noRd
+cf_icon_set <- function(
+ values,
+ params
+ ) {
+
+ type <- ifelse(params$percent, "percent", "num")
+ priority <- "1"
+ showValue <- NULL
+ reverse <- NULL
+ iconSet <- NULL
+
+ if (!is.null(params$iconSet))
+ iconSet <- params$iconSet
+
+ # only if non default
+ if (!is.null(params$showValue))
+ if (!params$showValue) showValue <- "0"
+
+ if (!is.null(params$reverse))
+ if (params$reverse) reverse <- "1"
+
+ # create cfRule with iconset and cfvo
+
+ cf_rule <- xml_node_create(
+ "cfRule",
+ xml_attributes = c(
+ type = "iconSet",
+ priority = priority
+ )
+ )
+
+ iconset <- xml_node_create(
+ "iconSet",
+ xml_attributes = c(
+ iconSet = iconSet,
+ showValue = showValue,
+ reverse = reverse
+ )
+ )
+
+ for (i in seq_along(values)) {
+ iconset <- xml_add_child(
+ iconset,
+ xml_child = c(
+ xml_node_create(
+ "cfvo",
+ xml_attributes = c(
+ type = type,
+ val = values[i]
+ )
+ )
+ )
+ )
+ }
+
+ # return
+ xml_add_child(
+ cf_rule,
+ xml_child = iconset
+ )
+}
+
+#' @rdname cf_rules
+#' @keywords internal
+#' @noRd
+cf_unique_values <- function(dxfId) {
+ cf_rule <- sprintf(
+ '<cfRule type="uniqueValues" dxfId="%s" priority="1"/>',
+ dxfId
+ )
+
+ cf_rule
+}
+
+#' @rdname cf_rules
+#' @keywords internal
+#' @noRd
+cf_iserror <- function(dxfId, sqref) {
+ cf_rule <- sprintf(
+ '<cfRule type="containsErrors" dxfId="%s" priority="1">
+ <formula>ISERROR(%s)</formula>
+ </cfRule>',
+ # cfRule
+ dxfId,
+ # formula
+ sqref
+ )
+
+ cf_rule
+}
+
+#' @rdname cf_rules
+#' @keywords internal
+#' @noRd
+cf_isnoerror <- function(dxfId, sqref) {
+ cf_rule <- sprintf(
+ '<cfRule type="notContainsErrors" dxfId="%s" priority="1">
+ <formula>NOT(ISERROR(%s))</formula>
+ </cfRule>',
+ # cfRule
+ dxfId,
+ # formula
+ sqref
+ )
+
+ cf_rule
+}
+
+#' @rdname cf_rules
+#' @keywords internal
+#' @noRd
+cf_isblank <- function(dxfId, sqref) {
+ cf_rule <- sprintf(
+ '<cfRule type="containsBlanks" dxfId="%s" priority="1">
+ <formula>LEN(TRIM(%s))=0</formula>
+ </cfRule>',
+ # cfRule
+ dxfId,
+ # formula
+ sqref
+ )
+
+ cf_rule
+}
+
+#' @rdname cf_rules
+#' @keywords internal
+#' @noRd
+cf_isnoblank <- function(dxfId, sqref) {
+ cf_rule <- sprintf(
+ '<cfRule type="notContainsBlanks" dxfId="%s" priority="1">
+ <formula>LEN(TRIM(%s))>0</formula>
+ </cfRule>',
+ # cfRule
+ dxfId,
+ # formula
+ sqref
+ )
+
+ cf_rule
+}