Ускорьте выбор ввода на Shinyapp - PullRequest
Новая
       17

Ускорьте выбор ввода на Shinyapp

0 голосов
/ 12 октября 2018

У меня есть shinyapp, размещенный на глянце .io, который требует загрузки 25k + вариантов в selectizeInput.Пожалуйста, обратите внимание, что при загрузке более по умолчанию 1000 вариантов пользователю доступны все варианты.Это приводит к отставанию, когда пользователь взаимодействует с selectizeInput.

Есть ли способ улучшить загрузку selectizeInput и уменьшить отставание, когда пользователь печатает?

Согласно комментарию здесь это должно занять меньше секунды, но 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;};"
                 )

               )
            )
            )
         )                  
     )   
    )
    )

SERVER 

 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) })

  })
...