加快ShinyApp上的selectizeInput

时间:2018-10-12 13:21:28

标签: shiny selectize.js shiny-reactivity

我在Shiny.io上托管了Shinyapp,它需要将25k +个选项加载到selectizeInput。请注意,加载超过default 1000个选项是为了使用户可以使用所有选项。当用户与selectizeInput交互时,这会导致滞后。

有没有一种方法可以改善selectizeInput的加载并减少用户键入时的滞后?

根据评论here,它应该花费不到一秒钟的时间,但是SelectizeInput在Shinyapp上呈现缓慢。

我的代码如下

UI

library(shiny)
library(DBI)
library(RMySQL)
library(shinydashboard)
library(shinyjs)

ui <- dashboardPage(  
    skin="yellow",  
    dashboardHeader(   ),
   dashboardSidebar(
   sidebarMenu(  

      selectInput(
        inputId="selectData",
         label=" ", selected = NULL,
         choices=c( "title" )),      

   menuItem("Titles Search", tabName = "Titles", icon = icon("font"))

    )
   ),

 dashboardBody(
     tags$head(
       tags$style(HTML("
              .content-wrapper {
              background-color: green !important;
              }
              .main-header {
              background-color: red !important;
              }

              "))

      ),

    tabItems(      
       tabItem(tabName = "Titles",              
          fluidRow(
           column(width=3,                        
                box(                         
                  title=" ",
                   solidHeader=TRUE,
                    collapsible=TRUE,
                 width=NULL,
                 selectizeInput('titles', label = "Search by title", 
            choices = NULL, options = list(
                   placeholder = 'Type the title', maxOptions = 26000, 
            maxItems = 10,multiple = F, searchConjunction = 'and')),
                 tags$style(type="text/css",
                            ".selectize- 
    input::after{visibility:hidden;};"
                 )

               )
            )
            )
         )                  
     )   
    )
    )

服务器

 library(DBI)
 library(RMySQL)
 library(shinydashboard)
 library(shinyjs)
  shinyServer(function(input, output, session) { 

    con <- dbConnect(MySQL(), user='XXXX', 
             port = 3306, password='XXXXX', 
             dbname='XXXXXX', 
             host='XXXXXXXX' )
       query <- function(...) dbGetQuery(con, ...)
      on.exit(dbDisconnect(con), add = TRUE)

    selectedData <- reactiveValues()
   observeEvent(input$selectData, {
      con <- dbConnect(MySQL(), user='XXXXXX', port = 3306, password='XXXX', 
         dbname='XXXXX', host='XXXXXXX' )
     query <- function(...) dbGetQuery(con, ...)
   on.exit(dbDisconnect(con), add = TRUE)

  if (input$selectData == "title") {
    selectedData$titledata <- query("SELECT titles FROM titles ;")
        }

   updateSelectizeInput(session, "titles",
                   choices =  
 as.character(unique(selectedData$titledata$titles)),
 options = list (maxOptions = 26000)
                   server = TRUE)
 })

   session$onSessionEnded(function() { dbDisconnect(con) })

  })

0 个答案:

没有答案