R/bar_chart.R

In XD-DENG/ECharts2Shiny: Embedding Interactive Charts Generated with ECharts Library into Shiny Applications

###########################################################################
# Bar Chart ---------------------------------------------------------------
###########################################################################


renderBarChart <- function(div_id,
                           data, theme = "default",
                           stack_plot = FALSE,
                           direction = "horizontal",
                           grid_left = "3%", grid_right = "4%", grid_top = "16%", grid_bottom = "3%",
                           show.legend = TRUE, show.tools = TRUE,
                           font.size.legend = 12,
                           font.size.axis.x = 12, font.size.axis.y = 12,
                           axis.x.name = NULL, axis.y.name = NULL,
                           rotate.axis.x = 0, rotate.axis.y = 0,
                           bar.max.width = NULL,
                           animation = TRUE,
                           hyperlinks = NULL,
                           running_in_shiny = TRUE){

  data <- isolate(data)

  data <- .process_NA(data)

  # Check the value for theme
  theme_placeholder <- .theme_placeholder(theme)

  # Check logical variables (whether they're logical)
  .check_logical(c('stack_plot', 'show.tools', 'show.legend', 'animation', 'running_in_shiny'))

  # Check if the "direction" value is valid
  if(direction == "horizontal"){
    direction_vector = c("xAxis", "yAxis")
  }else{
    if(direction == "vertical"){
      direction_vector = c("yAxis", "xAxis")
    }else{
      stop("The 'direction' argument can be either 'horizontal' or 'vertical'")
    }
  }


  # Check if the length of "hyperlink" is the same as the length of the x-axis names
  if((length(hyperlinks) != dim(data)[1]) & (is.null(hyperlinks) == FALSE)){
    stop("The length of 'hyperlinks' should be the same as the number of observations (the number of rows of the data).")
  }

  xaxis_name <- paste(sapply(row.names(data), function(x){paste0("'", x, "'")}), collapse=", ")
  xaxis_name <- paste0("[", xaxis_name, "]")
  legend_name <- paste(sapply(names(data), function(x){paste0("'", x, "'")}), collapse=", ")
  legend_name <- paste0("[", legend_name, "]")

  # Convert raw data into JSON format (Prepare the data in "series" part)
  series_data <- rep("", dim(data)[2])
  for(i in 1:length(series_data)){
    temp <- paste0("{name:'", names(data)[i], "', type:'bar', ",

                  ifelse(stack_plot,
                         " stack:' ', ",
                         " "),

                  ifelse(is.null(bar.max.width),
                         "barMaxWidth: null,",
                         paste0("barMaxWidth:'", bar.max.width, "',")),

                  "data:[",
                  paste(data[, i], collapse = ", "),
                  "]}"
    )
    series_data[i] <- temp
  }
  series_data <- paste(series_data, collapse = ", ")
  series_data <- paste0("[", series_data, "]")

  js_statement <- paste0("var " ,
                        div_id,
                        " = echarts.init(document.getElementById('",
                        div_id,
                        "')",
                        theme_placeholder,
                        ");",

                        "option_", div_id,
                        " = {tooltip : {trigger:'axis', axisPointer:{type:'shadow'}",
                        ifelse(is.null(hyperlinks),
                               "",
                               ", textStyle:{fontStyle:'italic', color:'skyblue'}"),
                        "}, ",

                        ifelse(show.tools,
                               "toolbox:{feature:{magicType:{type: ['stack', 'tiled']}, saveAsImage:{}}}, ",
                               ""),

                        ifelse(animation,
                               "animation:true,",
                               "animation:false,"),

                        ifelse(show.legend,
                               paste0("legend:{data:",
                                     legend_name,
                                     ", textStyle:{fontSize:", font.size.legend, "}",
                                     "},"),
                               ""),
                        "grid: {left:'", grid_left, "', right:'", grid_right, "', top:'", grid_top, "', bottom:'", grid_bottom, "', containLabel: true},",
                        direction_vector[1],
                        ":[{type:'value', name:", ifelse(is.null(axis.y.name), 'null', paste0("'", axis.y.name, "'")), ", axisLabel:{rotate:", rotate.axis.y, ",textStyle:{fontSize:", font.size.axis.y, "}}}], ",
                        direction_vector[2],
                        ":[{type:'category', name:", ifelse(is.null(axis.x.name), 'null', paste0("'", axis.x.name, "'")), ", axisTick:{show:false}, axisLabel:{rotate:", rotate.axis.x, ",textStyle:{fontSize:", font.size.axis.x, "}}, data:",
                        xaxis_name,
                        "}],series :",
                        series_data,
                        "};",

                        div_id,
                        ".setOption(option_",
                        div_id,
                        ");",

                        "window.addEventListener('resize', function(){",
                        div_id, ".resize()",
                        "});",

                        ifelse(is.null(hyperlinks),
                               "",
                               paste0(div_id,
                                    ".on('click', function (param){
                                    var name=param.name;",

                                     paste(sapply(1:length(hyperlinks),
                                                  function(i){
                                                    paste0("if(name=='", row.names(data)[i], "'){",
                                                          "window.location.href='", hyperlinks[i], "';}")
                                                  }),
                                           collapse = ""),

                                "});",
                                div_id, ".on('click');")
                               ))

  to_eval <- paste0("output$", div_id ," <- renderUI({tags$script(\"",
                   js_statement,
                   "\")})")

  if(running_in_shiny == TRUE){
    eval(parse(text = to_eval), envir = parent.frame())
  } else {
    cat(to_eval)
  }
}