Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Suggestion: Add icon_class to icon_asign() and possibly other functions #46

Open
eastclintw00d opened this issue Nov 15, 2022 · 0 comments

Comments

@eastclintw00d
Copy link

Add icon_class as additional argument as suggested in the answer of this post:

icon_assign <- function (data, icon = "circle", fill_color = "#67a9cf", empty_color = "lightgrey",
                             fill_opacity = 1, empty_opacity = 1, align_icons = "left",
                             icon_size = 16, buckets = NULL, number_fmt = NULL, seq_by = 1,
                             show_values = "none", animation = "1s ease", icon_class = NULL)
{
  "%notin%" <- Negate("%in%")
  if (show_values %notin% c("left", "right", "above", "below",
                            "none") == TRUE) {
    stop("show_values must be either 'left', 'right', 'above', 'below', or 'none'")
  }
  if (align_icons %notin% c("left", "right", "center") == TRUE) {
    stop("align_icons must be either 'left', 'right', or 'center'")
  }
  if (!is.numeric(fill_opacity)) {
    stop("`fill_opacity` must be numeric")
  }
  if (fill_opacity < 0 | fill_opacity > 1) {
    stop("`fill_opacity` must be a value between 0 and 1")
  }
  if (!is.numeric(empty_opacity)) {
    stop("`empty_opacity` must be numeric")
  }
  if (empty_opacity < 0 | empty_opacity > 1) {
    stop("`empty_opacity` must be a value between 0 and 1")
  }
  fill_color <- grDevices::adjustcolor(fill_color, alpha.f = fill_opacity)
  empty_color <- grDevices::adjustcolor(empty_color, alpha.f = empty_opacity)
  icons <- function(empty = FALSE) {
    htmltools::tagAppendAttributes(shiny::icon(icon, class = icon_class), style = paste0("font-size:",
                                                                     icon_size, "px", "; color:", if (empty)
                                                                       empty_color
                                                                     else fill_color, sprintf("; transition: %s", animation)),
                                   `aria-hidden` = "true")
  }
  cell <- function(value, index, name) {
    if (!is.numeric(value))
      return(value)
    if (is.null(value) || is.na(value) || value == "NA" ||
        value == "na" || stringr::str_detect(value, " "))
      return("")
    if (!is.null(buckets) & !is.numeric(buckets)) {
      stop("must provide a number for buckets")
    }
    if (!is.null(buckets) & is.numeric(buckets)) {
      bucketed_data <- dplyr::ntile(data[[name]], n = buckets)
      bucket_value <- bucketed_data[index]
      value_rounded <- floor(bucket_value + 0.5)
      icon_seq <- lapply(seq_len(buckets), function(i) {
        if (i <= value_rounded)
          icons()
        else icons(empty = TRUE)
      })
      label <- sprintf("%s out of %s", bucket_value, buckets)
    }
    else {
      max_value <- max(floor(data[[name]] + 0.5), na.rm = TRUE)
      value_rounded <- floor(value + 0.5)
      if (max_value != 0) {
        icon_seq <- lapply(seq(1, max_value, by = seq_by),
                           function(i) {
                             if (i <= value_rounded)
                               icons()
                             else icons(empty = TRUE)
                           })
      }
      else {
        icon_seq <- lapply(seq(0, max_value, by = seq_by),
                           function(i) {
                             if (i < value_rounded)
                               icons()
                             else icons(empty = TRUE)
                           })
      }
      label <- sprintf("%s out of %s", value, max_value)
    }
    if (show_values == "right" & is.null(number_fmt)) {
      htmltools::div(title = label, `aria-label` = label,
                     role = "img", icon_seq, align = align_icons,
                     paste0("  ", value))
    }
    else if (show_values == "right" & !is.null(number_fmt)) {
      label <- number_fmt(value)
      htmltools::div(title = label, `aria-label` = label,
                     role = "img", icon_seq, align = align_icons,
                     paste0("  ", label))
    }
    else if (show_values == "left" & is.null(number_fmt)) {
      max_digits <- max(nchar(data[[name]])) + 1
      label <- stringr::str_pad(value, max_digits)
      htmltools::div(paste0(label, "  "), title = label,
                     `aria-label` = label, role = "img", icon_seq,
                     align = align_icons)
    }
    else if (show_values == "above" & is.null(number_fmt)) {
      max_digits <- max(nchar(data[[name]])) + 1
      label <- stringr::str_pad(value, max_digits)
      htmltools::tagList(htmltools::div(label, align = align_icons),
                         htmltools::div(title = label, `aria-label` = label,
                                        role = "img", icon_seq, align = align_icons))
    }
    else if (show_values == "above" & !is.null(number_fmt)) {
      label <- number_fmt(value)
      max_digits <- max(nchar(data[[name]])) + 1
      label <- stringr::str_pad(value, max_digits)
      htmltools::tagList(htmltools::div(title = label,
                                        `aria-label` = label, role = "img", icon_seq,
                                        align = align_icons), htmltools::div(label, align = align_icons))
    }
    else if (show_values == "below" & is.null(number_fmt)) {
      max_digits <- max(nchar(data[[name]])) + 1
      label <- stringr::str_pad(value, max_digits)
      htmltools::tagList(htmltools::div(title = label,
                                        `aria-label` = label, role = "img", icon_seq,
                                        align = align_icons), htmltools::div(label, align = align_icons))
    }
    else if (show_values == "below" & !is.null(number_fmt)) {
      label <- number_fmt(value)
      max_digits <- max(nchar(data[[name]])) + 1
      label <- stringr::str_pad(value, max_digits)
      htmltools::tagList(htmltools::div(label, align = align_icons),
                         htmltools::div(title = label, `aria-label` = label,
                                        role = "img", icon_seq, align = align_icons))
    }
    else if (show_values == "left" & !is.null(number_fmt)) {
      label <- number_fmt(value)
      max_digits <- max(nchar(data[[name]])) + 1
      label <- stringr::str_pad(label, max_digits)
      htmltools::div(paste0(label, "  "), title = label,
                     `aria-label` = label, role = "img", icon_seq,
                     align = align_icons)
    }
    else htmltools::div(title = label, `aria-label` = label,
                        role = "img", icon_seq, align = align_icons)
  }
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant