R/amBarChart.R

Defines functions amBarChart

Documented in amBarChart

#' HTML widget displaying a bar chart
#' @description Create a HTML widget displaying a bar chart.
#'
#' @param data a dataframe
#' @param data2 \code{NULL} or a dataframe used to update the data with the
#'   button; its column names must include the column names of \code{data}
#'   given in \code{values}, it must have the same number of rows as
#'   \code{data} and its rows must be in the same order as those of \code{data}
#' @param category name of the column of \code{data} to be used on the
#'   category axis
#' @param values name(s) of the column(s) of \code{data} to be used on the
#'   value axis
#' @param valueNames names of the values variables, to appear in the legend;
#'   \code{NULL} to use \code{values} as names, otherwise a named list of the
#'   form \code{list(value1 = "ValueName1", value2 = "ValueName2", ...)} where
#'   \code{value1}, \code{value2}, ... are the column names given in
#'   \code{values} and \code{"ValueName1"}, \code{"ValueName2"}, ... are the
#'   desired names to appear in the legend; these names can also appear in
#'   the tooltips: they are substituted to the string \code{{name}} in
#'   the formatting string passed on to the tooltip (see the second example)
#' @param showValues logical, whether to display the values on the chart
#' @param hline an optional horizontal line to add to the chart; it must be a
#'   named list of the form \code{list(value = h, line = settings)} where
#'   \code{h} is the "intercept" and \code{settings} is a list of settings
#'   created with \code{\link{amLine}}
#' @param yLimits range of the y-axis, a vector of two values specifying
#'   the lower and the upper limits of the y-axis; \code{NULL} for default
#'   values
#' @param expandY if \code{yLimits = NULL}, a percentage of the range of the
#'   y-axis used to expand this range
#' @param valueFormatter a
#'   \href{https://www.amcharts.com/docs/v4/concepts/formatters/formatting-numbers/}{number formatting string};
#'   it is used to format the values displayed on the chart if
#'   \code{showValues = TRUE}, the values displayed in the cursor tooltips if
#'   \code{cursor = TRUE}, the labels of the y-axis unless you specify
#'   your own formatter in the \code{labels} field of the list passed on to
#'   the \code{yAxis} option, and the values displayed in the tooltips unless
#'   you specify your own tooltip text (see the first example for the way to set
#'   a number formatter in the tooltip text)
#' @param chartTitle chart title, it can be \code{NULL} or \code{FALSE} for no
#'   title, a character string,
#'   a list of settings created with \code{\link{amText}}, or a list with two
#'   fields: \code{text}, a list of settings created with \code{\link{amText}},
#'   and \code{align}, can be \code{"left"}, \code{"right"} or \code{"center"}
#' @template themeTemplate
#' @param draggable \code{TRUE}/\code{FALSE} to enable/disable dragging of
#'   all bars, otherwise a named list of the form
#'   \code{list(value1 = TRUE, value2 = FALSE, ...)} to enable/disable the
#'   dragging for each bar corresponding to a column given in \code{values}
#' @param tooltip settings of the tooltips; \code{NULL} for default,
#'   \code{FALSE} for no tooltip, otherwise a named list of the form
#'   \code{list(value1 = settings1, value2 = settings2, ...)} where
#'   \code{settings1}, \code{settings2}, ... are lists created with
#'   \code{\link{amTooltip}}; this can also be a
#'   single list of settings that will be applied to each series,
#'   or a just a string for the text to display in the tooltip
#' @param columnStyle settings of the columns (the bars); \code{NULL} for
#'   default, otherwise a named list of the form
#'   \code{list(value1 = settings1, value2 = settings2, ...)} where
#'   \code{settings1}, \code{settings2}, ... are lists created with
#'   \code{\link{amColumn}}; this can also be a
#'   single list of settings that will be applied to each column
#' @param threeD logical, whether to render the columns in 3D
#' @param bullets settings of the bullets; \code{NULL} for default,
#'   otherwise a named list of the form
#'   \code{list(value1 = settings1, value2 = settings2, ...)} where
#'   \code{settings1}, \code{settings2}, ... are lists created with
#'   \code{\link{amCircle}}, \code{\link{amTriangle}} or
#'   \code{\link{amRectangle}}; this can also be a
#'   single list of settings that will be applied to each series
#' @param alwaysShowBullets logical, whether to always show the bullets;
#'   if \code{FALSE}, the bullets are shown only on hovering a column
#' @param backgroundColor a color for the chart background; a color can be
#'   given by the name of a R color, the name of a CSS color, e.g.
#'   \code{"rebeccapurple"} or \code{"fuchsia"}, an HEX code like
#'   \code{"#ff009a"}, a RGB code like \code{"rgb(255,100,39)"}, or a HSL code
#'   like \code{"hsl(360,11,255)"}
#' @param cellWidth cell width in percent; for a simple bar chart, this is the
#'   width of the columns; for a grouped bar chart, this is the width of the
#'   clusters of columns; \code{NULL} for the default value
#' @param columnWidth column width, a percentage of the cell width; set to 100
#'   for a simple bar chart and use \code{cellWidth} to control the width of the
#'   columns; for a grouped bar chart, this controls the spacing between the
#'   columns within a cluster of columns; \code{NULL} for the default value
#' @param xAxis settings of the category axis given as a list, or just a string
#'   for the axis title; the list of settings has three possible fields:
#'   a field \code{title}, a list of settings for the axis title created
#'   with \code{\link{amText}},
#'   a field \code{labels}, a list of settings for the axis labels created
#'   with \code{\link{amAxisLabels}},
#'   and a field \code{adjust}, a number defining the vertical adjustment of
#'   the axis (in pixels)
#' @param yAxis settings of the value axis given as a list, or just a string
#'   for the axis title; the list of settings has five possible fields:
#'   a field \code{title}, a list of settings for the axis title created
#'   with \code{\link{amText}},
#'   a field \code{labels}, a list of settings for the axis labels created
#'   with \code{\link{amAxisLabels}},
#'   a field \code{adjust}, a number defining the horizontal adjustment of
#'   the axis (in pixels), a field \code{gridLines}, a list of settings for
#'   the grid lines created with \code{\link{amLine}} and a field
#'   \code{breaks} to control the axis breaks, an R object created with
#'   \code{\link{amAxisBreaks}}
#' @param scrollbarX logical, whether to add a scrollbar for the category axis
#' @param scrollbarY logical, whether to add a scrollbar for the value axis
#' @param legend either a logical value, whether to display the legend, or
#'   a list of settings for the legend created with \code{\link{amLegend}}
#' @param caption \code{NULL} or \code{FALSE} for no caption, a formatted
#'   text created with \code{\link{amText}}, or a list with two fields:
#'   \code{text}, a list created with \code{\link{amText}}, and \code{align},
#'   can be \code{"left"}, \code{"right"} or \code{"center"}
#' @param image option to include an image at a corner of the chart;
#'   \code{NULL} or \code{FALSE} for no image, otherwise a named list with four
#'   possible fields: the field \code{image} (required) is a list created with
#'   \code{\link{amImage}},
#'   the field \code{position} can be \code{"topleft"}, \code{"topright"},
#'   \code{"bottomleft"} or \code{"bottomright"}, the field \code{hjust}
#'   defines the horizontal adjustment, and the field \code{vjust} defines
#'   the vertical adjustment
#' @template buttonTemplate
#' @param cursor option to add a cursor on the chart; \code{FALSE} for no
#'   cursor, \code{TRUE} for a cursor with default settings for the tooltips,
#'   or a list of settings created with \code{\link{amTooltip}} to
#'   set the style of the tooltips, or a list with three possible fields:
#'   a field \code{tooltip}, a list of tooltip settings created with
#'   \code{\link{amTooltip}}, a field
#'   \code{extraTooltipPrecision}, an integer, the number of additional
#'   decimals to display in the tooltips, and a field \code{modifier},
#'   which defines a modifier for the
#'   values displayed in the tooltips; a modifier is some JavaScript code
#'   given as a string, which performs a modification of a string named
#'   \code{text}, e.g. \code{modifier = "text = '>>>' + text;"}
#' @param width the width of the chart, e.g. \code{"600px"} or \code{"80\%"};
#'   ignored if the chart is displayed in Shiny, in which case the width is
#'   given in \code{\link{amChart4Output}}
#' @param height the height of the chart, e.g. \code{"400px"};
#'   ignored if the chart is displayed in Shiny, in which case the height is
#'   given in \code{\link{amChart4Output}}
#' @param export logical, whether to enable the export menu
#' @param chartId a HTML id for the chart
#' @param elementId a HTML id for the container of the chart; ignored if the
#'   chart is displayed in Shiny, in which case the id is given by the Shiny id
#'
#' @import htmlwidgets
#' @importFrom shiny validateCssUnit
#' @importFrom reactR component reactMarkup
#' @export
#'
#' @examples # a simple bar chart ####
#'
#' dat <- data.frame(
#'   country = c("USA", "China", "Japan", "Germany", "UK", "France"),
#'   visits = c(3025, 1882, 1809, 1322, 1122, 1114)
#' )
#'
#' amBarChart(
#'   data = dat, data2 = dat,
#'   width = "600px",
#'   category = "country", values = "visits",
#'   draggable = TRUE,
#'   tooltip =
#'     "[bold font-style:italic #ffff00]{valueY.value.formatNumber('#,###.')}[/]",
#'   chartTitle =
#'     amText(text = "Visits per country", fontSize = 22, color = "orangered"),
#'   xAxis = list(title = amText(text = "Country", color = "maroon")),
#'   yAxis = list(
#'     title = amText(text = "Visits", color = "maroon"),
#'     gridLines = amLine(color = "orange", width = 1, opacity = 0.4)
#'   ),
#'   yLimits = c(0, 4000),
#'   valueFormatter = "#,###.",
#'   caption = amText(text = "Year 2018", color = "red"),
#'   theme = "material")
#'
#'
#' # bar chart with individual images in the bullets ####
#'
#' dat <- data.frame(
#'   language = c("Python", "Julia", "Java"),
#'   users = c(10000, 2000, 5000),
#'   href = c(
#'     tinyIcon("python", "transparent"),
#'     tinyIcon("julia", "transparent"),
#'     tinyIcon("java", "transparent")
#'   )
#' )
#'
#' amBarChart(
#'   data = dat,
#'   width = "700px",
#'   category = "language",
#'   values = "users",
#'   valueNames = list(users = "#users"),
#'   showValues = FALSE,
#'   tooltip = amTooltip(
#'     text = "{name}: [bold]valueY[/]",
#'     textColor = "white",
#'     backgroundColor = "#101010",
#'     borderColor = "silver"
#'   ),
#'   draggable = FALSE,
#'   backgroundColor = "seashell",
#'   bullets = amCircle(
#'     radius = 30,
#'     color = "white",
#'     strokeWidth = 4,
#'     image = amImage(
#'       href = "inData:href",
#'       width = 50, height = 50
#'     )
#'   ),
#'   alwaysShowBullets = TRUE,
#'   xAxis = list(title = amText(text = "Programming language")),
#'   yAxis = list(
#'     title = amText(text = "# users"),
#'     gridLines = amLine(color = "orange", width = 1, opacity = 0.4)
#'   ),
#'   yLimits = c(0, 12000),
#'   valueFormatter = "#.",
#'   theme = "material")
#'
#'
#' # a grouped bar chart ####
#'
#' set.seed(666)
#' dat <- data.frame(
#'   country = c("USA", "China", "Japan", "Germany", "UK", "France"),
#'   visits = c(3025, 1882, 1809, 1322, 1122, 1114),
#'   income = rpois(6, 25),
#'   expenses = rpois(6, 20)
#' )
#'
#' amBarChart(
#'   data = dat,
#'   width = "700px",
#'   category = "country",
#'   values = c("income", "expenses"),
#'   valueNames = list(income = "Income", expenses = "Expenses"),
#'   tooltip = amTooltip(
#'     textColor = "white",
#'     backgroundColor = "#101010",
#'     borderColor = "silver"
#'   ),
#'   draggable = list(income = TRUE, expenses = FALSE),
#'   backgroundColor = "#30303d",
#'   columnStyle = list(
#'     income = amColumn(
#'       color = "darkmagenta",
#'       strokeColor = "#cccccc",
#'       strokeWidth = 2
#'     ),
#'     expenses = amColumn(
#'       color = "darkred",
#'       strokeColor = "#cccccc",
#'       strokeWidth = 2
#'     )
#'   ),
#'   chartTitle = amText(text = "Income and expenses per country"),
#'   xAxis = list(title = amText(text = "Country")),
#'   yAxis = list(
#'     title = amText(text = "Income and expenses"),
#'     gridLines = amLine(color = "whitesmoke", width = 1, opacity = 0.4),
#'     breaks = amAxisBreaks(values = seq(0, 45, by = 5))
#'   ),
#'   yLimits = c(0, 45),
#'   valueFormatter = "#.#",
#'   caption = amText(text = "Year 2018"),
#'   theme = "dark")
amBarChart <- function(
  data,
  data2 = NULL,
  category,
  values,
  valueNames = NULL, # default
  showValues = TRUE,
  hline = NULL,
  yLimits = NULL,
  expandY = 5,
  valueFormatter = "#.",
  chartTitle = NULL,
  theme = NULL,
  animated = TRUE,
  draggable = FALSE,
  tooltip = NULL, # default
  columnStyle = NULL, # default
  threeD = FALSE,
  bullets = NULL, #default
  alwaysShowBullets = FALSE,
  backgroundColor = NULL,
  cellWidth = NULL, # default
  columnWidth = NULL, # default
  xAxis = NULL, # default
  yAxis = NULL, # default
  scrollbarX = FALSE,
  scrollbarY = FALSE,
  legend = NULL, # default
  caption = NULL,
  image = NULL,
  button = NULL, # default
  cursor = FALSE,
  width = NULL,
  height = NULL,
  export = FALSE,
  chartId = NULL,
  elementId = NULL
) {

  if(!all(values %in% names(data))){
    stop("Invalid `values` argument.", call. = TRUE)
  }

  if(is.null(valueNames)){
    valueNames <- setNames(as.list(values), values)
  }else if(is.list(valueNames) || is.character(valueNames)){
    if(is.null(names(valueNames)) && length(valueNames) == length(values)){
      warning(sprintf(
        "The `valueNames` %s you provided is unnamed - setting automatic names",
        ifelse(is.list(valueNames), "list", "vector")
      ))
      valueNames <- setNames(as.list(valueNames), values)
    }else if(!all(values %in% names(valueNames))){
      stop(
        paste0(
          "Invalid `valueNames` argument. ",
          "It must be a named list associating a name to every column ",
          "given in the `values` argument."
        ),
        call. = TRUE
      )
    }
  }else{
    stop(
      paste0(
        "Invalid `valueNames` argument. ",
        "It must be a named list giving a name for every column ",
        "given in the `values` argument."
      ),
      call. = TRUE
    )
  }

  if(!is.null(data2) &&
     (!is.data.frame(data2) ||
      nrow(data2) != nrow(data) ||
      !all(values %in% names(data2)))){
    stop("Invalid `data2` argument.", call. = TRUE)
  }

  if(is.null(yLimits)){
    yLimits <- range(pretty(do.call(c, data[values])))
    pad <- diff(yLimits) * expandY/100
    yLimits <- yLimits + c(-pad, pad)
  }

  if(is.character(chartTitle)){
    chartTitle <- list(
      text = amText(
        text = chartTitle, color = NULL, fontSize = 22,
        fontWeight = "bold", fontFamily = "Tahoma"
      ),
      align = "left"
    )
  }else if("text" %in% class(chartTitle)){
    chartTitle <- list(text = chartTitle, align = "left")
  }

  if(is.character(caption)){
    caption <- list(text = amText(caption), align = "right")
  }else if("text" %in% class(caption)){
    caption <- list(text = caption, align = "right")
  }

  if(is.atomic(draggable)){
    if(length(draggable) != 1L || !is.logical(draggable)){
      stop(
        paste0(
          "Invalid `draggable` argument. ",
          "It must be a named list defining `TRUE` or `FALSE` ",
          "for every column given in the `values` argument, ",
          "or just `TRUE` or `FALSE`."
        ),
        call. = TRUE
      )
    }
    draggable <- setNames(rep(list(draggable), length(values)), values)
  }else if(is.list(draggable)){
    if(!all(values %in% names(draggable)) ||
       !all(draggable %in% c(FALSE,TRUE))){
      stop(
        paste0(
          "Invalid `draggable` list. ",
          "It must be a named list defining `TRUE` or `FALSE` ",
          "for every column given in the `values` argument, ",
          "or just `TRUE` or `FALSE`."
        ),
        call. = TRUE
      )
    }
  }else{
    stop(
      paste0(
        "Invalid `draggable` argument. ",
        "It must be a named list defining `TRUE` or `FALSE` ",
        "for every column given in the `values` argument, ",
        "or just `TRUE` or `FALSE`."
      ),
      call. = TRUE
    )
  }

  # if(!isFALSE(tooltip)){
  #   if(is.list(tooltip)){
  #     tooltip$labelColor <- validateColor(tooltip$labelColor)
  #     tooltip$backgroundColor <- validateColor(tooltip$backgroundColor)
  #   }else if(is.null(tooltip)){
  #     tooltip <- list(
  #       text = "[bold]{name}:\n{valueY}[/]",
  #       labelColor = "#ffffff",
  #       backgroundColor = "#101010",
  #       backgroundOpacity = 1,
  #       scale = 1
  #     )
  #   }else if(is.character(tooltip)){
  #     tooltip <- list(text = tooltip)
  #   }
  # }

  if(!isFALSE(tooltip)){
    tooltipText <- sprintf(
      "[bold]{name}:\n{valueY.value.formatNumber('%s')}[/]",
      valueFormatter
    )
    if(is.null(tooltip)){
      tooltip <-
        setNames(
          rep(list(
            amTooltip(
              #              text = "[bold]{name}:\n{valueY}[/]",
              text = tooltipText,
              auto = FALSE
            )
          ), length(values)),
          values
        )
    }else if("tooltip" %in% class(tooltip)){
      if(tooltip[["text"]] == "_missing")
        tooltip[["text"]] <- tooltipText
      tooltip <- setNames(rep(list(tooltip), length(values)), values)
    }else if(is.list(tooltip)){
      if(any(!values %in% names(tooltip))){
        stop("Invalid `tooltip` list.", call. = TRUE)
      }
      tooltip <- lapply(tooltip, function(settings){
        if(settings[["text"]] == "_missing")
          settings[["text"]] <- tooltipText
        return(settings)
      })
    }else if(is.character(tooltip)){
      tooltip <-
        setNames(
          rep(list(amTooltip(text = tooltip, auto = FALSE)), length(values)),
          values
        )
    }else{
      stop("Invalid `tooltip` argument.", call. = TRUE)
    }
  }

  # if(!is.null(columnStyle[["stroke"]])){
  #   columnStyle[["stroke"]] <- validateColor(columnStyle[["stroke"]])
  # }
  # if(is.null(columnStyle)){
  #   columnStyle <- list(
  #     fill = setNames(rep(list(NULL), length(values)), values),
  #     stroke = NULL,
  #     cornerRadius = NULL
  #   )
  # }else if(is.character(columnStyle[["fill"]])){
  #   columnStyle[["fill"]] <-
  #     setNames(
  #       rep(list(validateColor(columnStyle[["fill"]])), length(values)),
  #       values
  #     )
  # }else if(is.list(columnStyle[["fill"]])){
  #   if(!all(values %in% names(columnStyle[["fill"]]))){
  #     stop(
  #       paste0(
  #         "Invalid `fill` field of `columnStyle`. ",
  #         "It must be a named list defining a color for every column ",
  #         "given in the `values` argument, or just a color that will be ",
  #         "applied to each column."
  #       ),
  #       call. = TRUE
  #     )
  #   }
  #   columnStyle[["fill"]] <-
  #     sapply(columnStyle[["fill"]], validateColor, simplify = FALSE, USE.NAMES = TRUE)
  # }

  if(is.null(columnStyle)){
    columnStyle <- setNames(rep(list(amColumn()), length(values)), values)
  }else if("column" %in% class(columnStyle)){
    columnStyle <- setNames(rep(list(columnStyle), length(values)), values)
  }else if(is.list(columnStyle)){
    if(any(!values %in% names(columnStyle))){
      stop("Invalid `columnStyle` list.", call. = TRUE)
    }
  }else{
    stop("Invalid `columnStyle` argument.", call. = TRUE)
  }

  if(is.null(bullets)){
    bullets <- setNames(rep(list(amCircle()), length(values)), values)
  }else if("bullet" %in% class(bullets)){
    bullets <- setNames(rep(list(bullets), length(values)), values)
  }else if(is.list(bullets)){
    if(any(!values %in% names(bullets))){
      stop("Invalid `bullets` list.", call. = TRUE)
    }
  }else{
    stop("Invalid `bullets` argument.", call. = TRUE)
  }

  if(is.null(cellWidth)){
    cellWidth <- 90
  }else{
    cellWidth <- max(50, min(cellWidth, 100))
  }

  if(is.null(columnWidth)){
    columnWidth <- ifelse(length(values) == 1L, 100, 90)
  }else{
    columnWidth <- max(10, min(columnWidth, 100))
  }

  if(is.null(xAxis)){
    xAxis <- list(
      title = amText(
        text = category,
        fontSize = 20,
        color = NULL,
        fontWeight = "bold"
      ),
      labels = amAxisLabels(
        color = NULL,
        fontSize = 18,
        rotation = 0
      )
    )
  }else if(is.character(xAxis)){
    xAxis <- list(
      title = amText(
        text = xAxis,
        fontSize = 20,
        color = NULL,
        fontWeight = "bold"
      ),
      labels = amAxisLabels(
        color = NULL,
        fontSize = 18,
        rotation = 0
      )
    )
  }
  if(is.character(xAxis[["title"]])){
    xAxis[["title"]] <- amText(
      text = xAxis[["title"]],
      fontSize = 20,
      color = NULL,
      fontWeight = "bold"
    )
  }
  if(is.null(xAxis[["labels"]])){
    xAxis[["labels"]] <- amAxisLabels(
      color = NULL,
      fontSize = 18,
      rotation = 0
    )
  }

  if(is.null(yAxis)){
    yAxis <- list(
      title = if(length(values) == 1L) {
        amText(
          text = values,
          fontSize = 20,
          color = NULL,
          fontWeight = "bold"
        )
      },
      labels = amAxisLabels(
        color = NULL,
        fontSize = 18,
        rotation = 0,
        formatter = valueFormatter
      ),
      gridLines = amLine(opacity = 0.2, width = 1)
    )
  }else if(is.character(yAxis)){
    yAxis <- list(
      title = amText(
        text = yAxis,
        fontSize = 20,
        color = NULL,
        fontWeight = "bold"
      ),
      labels = amAxisLabels(
        color = NULL,
        fontSize = 18,
        rotation = 0,
        formatter = valueFormatter
      ),
      gridLines = amLine(opacity = 0.2, width = 1)
    )
  }
  if(is.character(yAxis[["title"]])){
    yAxis[["title"]] <- amText(
      text = yAxis[["title"]],
      fontSize = 20,
      color = NULL,
      fontWeight = "bold"
    )
  }
  if(is.null(yAxis[["labels"]])){
    yAxis[["labels"]] <- amAxisLabels(
      color = NULL,
      fontSize = 18,
      rotation = 0,
      formatter = valueFormatter
    )
  }

  # if(is.null(gridLines)){
  #   gridLines <- list(
  #     color = NULL,
  #     opacity = NULL,
  #     width = NULL
  #   )
  # }else{
  #   gridLines[["color"]] <- validateColor(gridLines[["color"]])
  # }

  if(is.null(legend)){
    legend <- length(values) > 1L
  }
  if(isTRUE(legend)){
    legend <- amLegend(
      position = "bottom",
      itemsWidth = 20,
      itemsHeight = 20
    )
  }

  if(!(is.null(image) || isFALSE(image))){
    if(!is.list(image)){
      if(!"image" %in% class(image)){
        stop("Invalid `image` argument.", call. = TRUE)
      }else{
        image <- list(image = image)
      }
    }else{
      if(!"image" %in% names(image) || !"image" %in% class(image[["image"]])){
        stop("Invalid `image` argument.", call. = TRUE)
      }
    }
  }

  if(is.null(button)){
    button <- if(!is.null(data2))
      amButton(
        label = "Reset"
      )
  }else if(is.character(button)){
    button <- amButton(
      label = button
    )
  }

  if("tooltip" %in% class(cursor)){
    cursor <- list(tooltip = cursor)
  }else if(is.list(cursor)){
    if("modifier" %in% names(cursor)){
      cursor[["renderer"]] <- list(y = htmlwidgets::JS(
        "function(text){",
        cursor[["modifier"]],
        "return text;",
        "}"
      ))
      cursor[["modifier"]] <- NULL
    }
    if("extraTooltipPrecision" %in% names(cursor)){
      cursor[["extraTooltipPrecision"]] <-
        list(y = cursor[["extraTooltipPrecision"]])
    }
  }

  if(is.null(width)){
    width <- "100%"
  }else{
    width <- shiny::validateCssUnit(width)
  }

  height <- shiny::validateCssUnit(height)
  if(is.null(height)){
    if(grepl("^\\d", width) && !grepl("%$", width)){
      height <- sprintf("calc(%s * 9 / 16)", width)
    }else{
      height <- "400px"
    }
  }

  if(is.null(chartId)){
    chartId <- paste0("barchart-", randomString(15))
  }

  if(!is.null(hline)){
    if(any(!is.element(c("value", "line"), names(hline)))){
      stop(
        "Invalid `hline` argument."
      )
    }
  }

  # describe a React component to send to the browser for rendering.
  component <- reactR::component(
    "AmBarChart",
    list(
      data = data,
      data2 = data2,
      category = category,
      values = as.list(values),
      valueNames = as.list(valueNames),
      showValues = showValues,
      minValue = yLimits[1L],
      maxValue = yLimits[2L],
      hline = hline,
      valueFormatter = valueFormatter,
      chartTitle = chartTitle,
      theme = theme,
      animated = animated,
      draggable = draggable,
      tooltip = tooltip,
      columnStyle = columnStyle,
      threeD = threeD,
      bullets = bullets,
      alwaysShowBullets = alwaysShowBullets,
      backgroundColor = validateColor(backgroundColor),
      cellWidth = cellWidth,
      columnWidth = columnWidth,
      xAxis = xAxis,
      yAxis = yAxis,
      scrollbarX = scrollbarX,
      scrollbarY = scrollbarY,
      legend = legend,
      caption = caption,
      image = image,
      button = button,
      cursor = cursor,
      width = width,
      height = height,
      export = export,
      chartId = chartId,
      shinyId = elementId
    )
  )
  # create widget
  htmlwidgets::createWidget(
    name = 'amChart4',
    reactR::reactMarkup(component),
    width = "auto",
    height = "auto",
    package = 'rAmCharts4',
    elementId = elementId
  )
}

Try the rAmCharts4 package in your browser

Any scripts or data that you put into this service are public.

rAmCharts4 documentation built on Sept. 22, 2022, 5:05 p.m.