renderUI для создания реактивных фильтров в базе данных mySQL - PullRequest
0 голосов
/ 01 июля 2019

Я хочу, чтобы Shiny dashboard запрашивал базу данных mySQL в соответствии с реактивными фильтрами.Это также мой первый раз при использовании пакета пула.

У меня проблемы с реактивностью этой панели.

##################################################################
# Loading required packages
##################################################################
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(tidyverse)

##################################################################
# Establishing connection with database
##################################################################
library(pool)

# Connect to database
pool <- dbPool(
  drv = RMySQL::MySQL(),
  dbname = XXX
  host = "localhost",
  user = "root",
  password = XXX
)


##################################################################
# Function to load data 
##################################################################
loadData <- function(fields,
                     table,
                     sortCol = '',
                     WhereCls = '') {
  # If there is NO WHERE clause
  if (WhereCls == '')
    query <- sprintf("SELECT DISTINCT %s FROM %s", fields, table)
  else
    query <-
      sprintf("SELECT DISTINCT %s FROM %s WHERE %s", fields, table, whereCls)

  # retrieve query result and store in dataDB
  dataDB <- dbGetQuery(pool, query) 

  # Arrange datatable by a column and return datatable
  if (sortCol != "")
    dataDB[order(dataDB[sortCol]), ]
  else
    dataDB
}
##################################################################
##################################################################






##################################################################
# UI Component
##################################################################
header <- dashboardHeader(
  title = "XXX",
  titleWidth = 215
)

sidebar <- dashboardSidebar(
  sidebarMenu(
    id = "tabs",
    menuItem("Data", tabName = "data_analysis", icon = icon("database")),
    menuItem("View", tabName = "view_analysis", icon = icon("glasses")),
    menuItem(
      "Dashboard",
      tabName = "dashboard",
      icon = icon("dashboard")
    ),
    menuItem(
      "Download",
      tabName = "download",
      icon = icon("file-download")
    )
  )
)

body <- dashboardBody(

  tabItems(
    tabItem(
      tabName = "data_analysis",

      h2("PCM Data Analysis"),

      fluidRow(
        column(5,
               actionButton(
                 "start_analysis",
                 "Start!",
                 icon = icon("grin-stars"),
                 width = NULL
               ),

               actionButton(
                 "viewdata",
                 "View Data Table",
                 icon = icon("eye"),
                 width = NULL),

               actionButton(
                 "plotdata",
                 "Plot Data",
                 icon = icon("chart-line"),
                 width = NULL)
        )
      ),

      br(),

      fluidRow(
        column(12,


               radioButtons(
                 "DateFormat",
                 "Select Date type:",
                 c("Lot Ship Date", "Lot Start Date"),
                 width = NULL)
        )
      ),

      fluidRow(

        column(12,

               dateInput(inputId = "from_date", label =  "From:",
                         width = NULL),
               dateInput(inputId = "to_date", label =  "To:",
                         width = NULL)
        )
      ),

      fluidRow(

        column(4,
               uiOutput("fab_ui", width = NULL),
               # Add image here
               uiOutput("technology_ui", width = NULL)
        ),
        column(4,
               uiOutput("route_ui"),
               uiOutput("product_ui")
        ),
        column(4,
               uiOutput("lot_ui"),
               uiOutput("test_ui")
        )
      )

    ),


    tabItem(
      tabName = "view_analysis",
      h2("Data table viewer"),
      fluidRow(DT::dataTableOutput("table"))
    ),
    tabItem(tabName = "dashboard",

            fluidRow(plotOutput("plots"))),
    tabItem(
      tabName = "download",
      h2("Download data and/or report"),
      fluidRow(
        column(
          3,
          offset = 1,
          downloadButton("downloadcsv", "Download CSV File", icon = icon("table"))
        ),
        column(
          3,
          offset = 1,
          downloadButton("downloadpdf", "Download PDF File", icon = icon("file-pdf"))
        )
      )
    )
  )
)

# UI
ui <- dashboardPage(skin = "blue", header = header,
                    sidebar = sidebar,
                    body = body)



server <- function(input, output, session) {


  data1_reactive <- reactive({dbGetQuery(pool,
                               paste("select distinct li.Foundry,
                                     li.Process,li.Route, li.Product,
                                     li.AllegroLot, li.Wafer, li.FoundryLot,
                                     li.LotStartDate, li.LotShipDate, r.tname,
                                     r.units, r.ll, r.hl, r.Site, r.Result,
                                     wy.Yield from v_et_lotinfo li inner join v_et_results r on li.splitlot_id=r.splitlot_id inner join v_wt_waferyield wy on (li.AllegroLot=wy.Lot and li.Wafer=wy.wafer) where
                                     li.LotShipDate >", input$from_date, "and li.LotShipDate <",
                                    input$to_date))})



  # Foundry ########################################################
  foundry <- loadData(fields = "Foundry", 
                      table = "v_et_lotinfo",
                      sortCol = "Foundry")
  ##################################################################


  # Render UI ######################################################
  output$fab_ui <- renderUI({
    selectizeInput(
      "fab",
      "Fab:",
      foundry,
      options = list(
        placeholder = 'Please select an option below',
        onInitialize = I('function() { this.setValue(""); }')
      ),
      width = '100%',
      multiple = FALSE
    )
  })

  data1 <- reactive({data1_reactive() %>% filter(Foundry == input$fab)})

  output$technology_ui <- renderUI({

    selectizeInput(
      "technology",
      "Technology:",
      choices = as.vector(unique(data1()$Process)),
      options = list(
        placeholder = 'Please select an option below',
        onInitialize = I('function() { this.setValue(""); }')
      ),
      width = '100%',
      multiple = FALSE
    )
  })

}

shinyApp(ui, server)

Кажется, что loadData работает, так как внутри Fab selectizeInput я вижу свои дваопции.Однако проблема в технологии.Внутри selectizeInput у меня есть выбор = as.vector (уникальный (data1 () $ Process)), но на панели инструментов я не вижу никаких опций в технологии.

enter image description here

Мне бы очень хотелось узнать, правильно ли кодирован реактивный объект data1!

...