shiny + rchart + interactive selection

################################################################################
## gloabal.R
library(rCharts)
library(plyr)
library(dplyr)
library(magrittr)
library(data.table)
library(shiny)
load("sample.RData")

afr_fr = afr.fr %>% tbl_df()
fobqty_fr = fobqty.fr %>% tbl_df()
afr_fr %<>% mutate(REPAIRED_MONTH = as.character(REPAIRED_MONTH))
fobqty_fr %<>% mutate(REPAIRED_MONTH = as.character(REPAIRED_MONTH))
default_choices = afr_fr %>% filter(LOB_NAME=="Desktop")
default_options = default_choices %>% arrange(REPAIRED_MONTH) %>% head(1)

## ui.R
ui <- pageWithSidebar(
  headerPanel('Acer QSBU Quality Analysis Tool'),
  sidebarPanel(
    selectInput('lob', 'Product Line', choices = sort(unique(afr_fr$LOB_NAME)),
      multiple = FALSE),
    selectInput('projects', 'Projects',
      choices = sort(unique(default_choices$PROJECT_FAMILY)),
      multiple = TRUE),
    selectInput('month', 'Month',
      choices = c("", sort(unique(default_choices$REPAIRED_MONTH))),
      multiple = FALSE, selected = ""),
    actionButton("submit", label = "Submit Query"),
    actionButton("reset", label = "Reset Query"),
    p("Click the button to submit the analysis criteria.")
  ),
  mainPanel(
    showOutput("trendchart", "highcharts"),
    tableOutput('table')
   )
)


## server.R
server <- function(input, output, session){
  vals = reactiveValues()
  vals$show = FALSE
  vals$reset = FALSE
  vals$lob = "Desktop"
  vals$projects = "empty"
  vals$month = "empty"
  df_initialize = function(){
    vals$AFR_DT = afr_fr %>% tbl_dt()
    vals$FOB_DT = fobqty_fr %>% tbl_dt()
    vals$AFR_DT %<>% filter(LOB_NAME == vals$lob)
    vals$FOB_DT %<>% filter(LOB_NAME == vals$lob)
  }
  isolate({df_initialize()})

  test_notnull_f = function(x){
    out = length(x) > 0 && !is.null(x)
    if (is.character(x))
    {
      out = out && nchar(x) > 0
      out = out && x != "empty"
    }
    return(out)
  }
  df_update = function(){
    print(input$projects)
    print(vals$projects)
    print(input$month)
    print(vals$month)
    if (vals$show)
      vals$show = FALSE
    if (!vals$reset)
    {
      if (input$month != vals$month || !all(input$projects %in% vals$projects))
        df_initialize()
      if (test_notnull_f(input$projects))
      {
        vals$AFR_DT %<>% filter(PROJECT_FAMILY %in% input$projects)
        vals$FOB_DT %<>% filter(PROJECT_FAMILY %in% input$projects)
      }
      if (test_notnull_f(input$month))
      {
        vals$AFR_DT %<>% filter(REPAIRED_MONTH == input$month)
        vals$FOB_DT %<>% filter(REPAIRED_MONTH == input$month)
      }
    }
    vals$reset = FALSE
  }

  updateInput_f = function(penal_name){
    df_update()
    if (penal_name == "lob")
    {
      updateSelectInput(session, "projects",
        choice = sort(unique(vals$AFR_DT$PROJECT_FAMILY)))
      updateSelectInput(session, "month",
        choice = c("", sort(unique(vals$AFR_DT$REPAIRED_MONTH))), selected = "")
    }
    else if  (penal_name == "month")
    {
      updateSelectInput(session, "projects",
        choice = sort(unique(c(vals$AFR_DT$PROJECT_FAMILY, input$projects))),
        selected = input$projects)
    }
    else if (penal_name == "projects")
    {
      updateSelectInput(session, "month",
        choice = c("", sort(unique(c(vals$AFR_DT$REPAIRED_MONTH, input$month)))),
        selected = input$month)
    }
  }

  lob = observe({
    input$lob
    isolate({
      if (input$lob != vals$lob)
      {
        vals$lob = input$lob
        df_initialize()
        df_update()
        updateInput_f("lob")
      }
    })
  })

  projects = observe({
    if (is.null(input$projects)) return()
    isolate({
      updateInput_f("projects")
      vals$projects = input$projects
    })
  })

  month = observe({
    if (is.null(input$month)) return()
    isolate({
      updateInput_f("month")
      vals$month = input$month
    })
  })

  goShowing = observe({
    if (input$submit == 0) return()
    isolate({
      df_update()
      if (test_notnull_f(vals$projects) && test_notnull_f(vals$month))
      {
        vals$show = TRUE
        vals$DRAW_DT = full_join(x=vals$AFR_DT, y=vals$FOB_DT)
        vals$DRAW_DT %<>% mutate(AFR = 100*12*AFR_ROLLING_12M/MM_ROLLING_12M,
          PAFR = 100*12*PAFR_QTY_6M/FOB_ROLLING_M3_M8)
      }
    })
  })

  reset = observe({
    input$reset
    isolate({
      vals$show = FALSE
      vals$reset = TRUE
      vals$projects = "empty"
      vals$month = "empty"
      df_initialize()
      updateInput_f("lob")
    })
  })

  output$trendchart = renderChart({
    if (vals$show)
    {
      title_name = vals$DRAW_DT %>% head(1) %>% select(LOB_NAME) %>%
        paste0(collapse=" ") %>% paste("AFR Trend", sep=" ")
      title_name = "112"
      trendchart = Highcharts$new()
      trendchart$chart(type = "line")
      trendchart$title(text = title_name)
      draw_df2 = vals$DRAW_DT %>%
        mutate(x = REPAIRED_MONTH, y = AFR, group = PROJECT_FAMILY) %>%
        select(x, y, group)
      d_ply(draw_df2, .(group), function(dt_sub) {
        trendchart$series(data = toJSONArray2(dt_sub, json = F),
            name = unique(dt_sub$group), type = "line")
      })
      trendchart$addParams(height = 1000, width = 800, dom = 'trendchart')
      trendchart$xAxis(title = list(text = ""))
      trendchart$yAxis(title = list(text = ""))
      trendchart$exporting(enabled = T)
      return(trendchart)
    }
    else
    {
      title_name = ""
      trendchart = Highcharts$new()
      trendchart$chart(type = "line")
      trendchart$title(text = title_name)
      trendchart$series(data = list(list(x = NULL, y = NULL)), name = "no_data", type = "line")
      trendchart$addParams(height = 10, width = 10, dom = 'trendchart')
      trendchart$legend(enabled = FALSE)
      trendchart$xAxis(title = list(text = ""), lineWidth = 0)
      trendchart$yAxis(title = list(text = ""))
      return(trendchart)
    }
  })

  output$table = renderTable({
    if (vals$show)
      vals$DRAW_DT %>% select(LOB_NAME, SUPPLIER_NAME, PROJECT_FAMILY, AFR, PAFR,
        AFR_ROLLING_12M,MM_ROLLING_12M,PAFR_QTY_6M,FOB_ROLLING_M3_M8,REPAIRED_MONTH)
    else
      data.frame(NULL)
  })
}

shinyApp(ui, server)