rCharts tooltip download plot

library(plyr)
library(dplyr)
library(shiny)
library(rCharts)
library(magrittr)
load("buublechart.RData")

ui <- shinyUI(fluidPage(
 tags$head(tags$script(src = "https://code.highcharts.com/highcharts.js"),
            tags$script(src = "https://code.highcharts.com/highcharts-more.js"),
            tags$script(src = "https://code.highcharts.com/modules/exporting.js"),
            tags$script(src = "https://code.highcharts.com/modules/heatmap.js")
            ),
  headerPanel('Bubble Charts Download'),
  sidebarPanel(
     selectInput('lob', label = 'Product Line', choices = c('Notebook','Windows Tablet', 'Android Tablet', 'Desktop'), selected=FALSE),
     selectInput('cate', label = 'Category', choices = c('HDD','LCD','ADP','BAT','SPS'), selected=F),
     textInput('kcpn', label ='KC Part Number', value = "", width = NULL),
     actionButton("submit", label = "Submit Query"),
     p("Click the button to query the bubble chart.")
  ),
   mainPanel(
     showOutput("bubbleplot", "highcharts"),
     tableOutput('table')
   )
))

server <- function(input, output){
   vals = reactiveValues()
   vals$draw.DT = data.fr %>% filter(rep(FALSE, nrow(.)))
   #browser()
   observeEvent(input$submit, {
     vals$draw.DT = data.fr
     unique_kcpn = unique(data.fr[,"KC_PRODUCT_NUMBER"])
     if ((nchar(input$kcpn) == 0) || !(input$kcpn %in% unique_kcpn))
       vals$draw.DT %<>% filter(rep(FALSE, nrow(.)))
     else
       vals$draw.DT %<>% filter(KC_PRODUCT_NUMBER %in% input$kcpn)
     vals$draw.DT %<>% filter(LOB_NAME==input$lob, STANDARD_CATEGORY==input$cate)
   })

   output$bubbleplot = renderChart2({
      title_name = vals$draw.DT %>% head(1) %>%
        select(LOB_NAME, STANDARD_CATEGORY, KC_SUPPLIER_NAME, KC_PRODUCT_NUMBER) %>%
        paste0(collapse=" ") %>% paste("FUB","PAFR","Bubble Chart", sep=" ")
      if (nrow(vals$draw.DT) == 0)
         title_name = "The intersection of selected attributes is empty."
      vals$draw.DT %<>% mutate(x = seq(-1, by = 1, length.out = nrow(.)),
        size = TOTAL_KC_FUB_QTY / max(TOTAL_KC_FUB_QTY), z = sqrt(size/pi),
        y = round(100*PAFR,2), group = PROJECT_FAMILY) %>% arrange(z)
      h <- Highcharts$new()
      h$chart(type = "bubble", height = 800, width = 1200)
      h$title(text = title_name)
      groups <- sort(unique(vals$draw.DT$PROJECT_FAMILY))
      DT_output = vals$draw.DT %>% select(x, y, z, group, TOTAL_KC_FUB_QTY)
      d_ply(DT_output, .(group), function(dt_sub) {
          h$series(data = toJSONArray2(dt_sub, json = F),
            name = unique(dt_sub$group), type = "bubble",
            minSize = "8", maxSize = "50")
      })
      h$xAxis(list(title=(list(text=""))), labels = list(enabled = FALSE),
        tickLength = 0, minorTickLength = 0)
      h$yAxis(list(title=(list(text="PAFR(%)"))))
      h$tooltip(useHTML = T, formatter = "#! function() {
       return 'PAFR:' + this.point.y + '<br/>' +
          'Project: ' + this.point.group + '<br/>' +
          'Total FUB Qty: ' + this.point.TOTAL_KC_FUB_QTY; } !#")
      h$legend(enabled = TRUE)
      h$exporting(enabled = TRUE)
      h$addParams(dom = 'bubbleplot')
      h$addAssets(js =
        c("https://ajax.googleapis.com/ajax/libs/jquery/1.11.1/jquery.min.js",
        "https://code.highcharts.com/highcharts.js",
        "https://code.highcharts.com/highcharts-more.js",
        "https://code.highcharts.com/modules/exporting.js",
        "https://code.highcharts.com/modules/heatmap.js"
        )
      )
      h
   })

   output$table = renderTable({
     if (nrow(vals$draw.DT) > 0)
       vals$draw.DT %>% mutate(PAFR = round(PAFR*100,2)) %>%
         select(LOB_NAME, PROJECT_FAMILY, KC_SUPPLIER_NAME,
           KC_PRODUCT_NUMBER, PAFR, TOTAL_KC_FUB_QTY) %>%
           set_names(c('Product Line', 'Project', 'Supplier','Product Number', 'PAFR(%)', 'Total FUB Qty'))
   })
}

shinyApp(ui, server)