customize tooltip

#### global.R
library(rCharts)
options(RCHART_WIDTH = 600)
library(shiny)
library(data.table)
library(plyr)
library(dplyr)
library(magrittr)
DT = fread("sample.csv")
unique_kcpn = unique(DT$KC_PRODUCT_NUMBER)
bubbleplot_f = function(DT)
{
  title_name = DT %>% '['(1,) %>%
    select(LOB_NAME, STANDARD_CATEGORY, KC_SUPPLIER_NAME, KC_PRODUCT_NUMBER) %>%
    paste0(collapse=" ") %>% paste("FUB","PAFR","Bubble Chart", sep=" ")
  if (nrow(DT) == 0)
    title_name = "The intersection of selected attributes is empty."
  DT %<>% mutate(x = seq(-1, by = 1, length.out = nrow(.)),
    size = TOTAL_KC_FUB_QTY / max(TOTAL_KC_FUB_QTY), radius = sqrt(size/pi),
    y = PAFR, group = PROJECT_FAMILY) %>% arrange(radius)
  h <- Highcharts$new()
  h$chart(type = "bubble")
  h$title(text = title_name)
  groups <- sort(unique(DT$PROJECT_FAMILY))
  DT_output = DT %>% select(x, y, radius, 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",
        marker = list(radius = dt_sub$radius))
  })
  h$xAxis(list(title=(list(text=""))))
  h$yAxis(list(title=(list(text="PAFR"))))
  h$tooltip(useHTML = T, formatter = "#! function() { return 'PAFR:' +
  this.point.y + '\t' + 'PROJECT_FAMILY: ' + this.point.group + '\t' +
  'TOTAL_KC_FUB_QTY: ' + this.point.TOTAL_KC_FUB_QTY; } !#")
  h$exporting(enabled = T)
  h$addParams(height = 700, dom = 'bubbleplot')
  h
}

#### ui.R
ui <- pageWithSidebar(
headerPanel('Bubble Charts Download'),
sidebarPanel(
selectInput('lob', label = 'Product Line', choices = c('Notebook','Windows Tablet', 'Android Tablet', 'Desktop')),
selectInput('cate', label = 'Category', choices = c('HDD','LCD','ADP','BAT','SPS')),
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.R
server <- function(input, output){
vals = reactiveValues()
vals$draw.DT = DT %>% filter(rep(FALSE, nrow(.)))
observeEvent(input$submit, {
  vals$draw.DT = DT
  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)
  print(vals$draw.DT)
})
output$bubbleplot = renderChart({
  bubbleplot_f(vals$draw.DT)
})
output$table = renderTable({
  if (nrow(vals$draw.DT) > 0)
    vals$draw.DT %>% select(LOB_NAME, PROJECT_FAMILY, KC_PRODUCT_NUMBER, PAFR, TOTAL_KC_FUB_QTY)
  })
}

# KH.01KB8.024
shinyApp(ui, server)