Блестящий выбор ввода очень медленно работает с большими данными (~ 15 000 записей) в браузере

r shiny

2178 просмотра

2 ответа

7412 Репутация автора

У меня есть это простое блестящее приложение, и оно быстро работает в «средстве просмотра», но когда я использую опцию «Открыть в браузере», выбор вариантов ввода занимает некоторое время для загрузки.

selectList <- sapply(1:15000, function(x) paste(sample(letters, 10), collapse = ''))
ui <- fluidPage(
  selectInput('mylist', 'Select Something',
              choices = c(Choose = '', selectList),
              selected = 1)
)

server <- function(input, output) {
}

shinyApp(ui = ui, server = server)

Согласно этой теме - https://groups.google.com/forum/#!topic/shiny-discuss/doHpFM6ZOGg , проблема была исправлена ​​в какой-то старой частной ветке. Последняя установка, которую я использую это, и я вижу проблему медлительности.

packageVersion('shiny')
[1] ‘0.13.2’

Любые варианты, которые я должен заставить это вести себя по-другому?

Дополнительная необходимость:

Я также хотел бы, чтобы выбранные входы зависели от входа переключателя следующим образом. Но по какой-то причине я не могу сделать так, чтобы на стороне сервера был выбран ввод для работы с наблюдателем на переключателе. Есть мысли о том, что я делаю не так?

# mylist
selectList1 <- sapply(1:15000, function(x) paste0(x, "_", paste(sample(LETTERS, 10), collapse = '')))
selectList2 <- sapply(1:15000, function(x) paste0(x, "_", paste(sample(letters, 10), collapse = '')))

# ui
ui <- fluidPage(
  selectizeInput(
    inputId = 'mylist', label = 'Select Something',
    choices = NULL,
    selected = 1
  ),
  radioButtons('letterType',
               'Select a Letter Type:',
               choices = c('Upper Case' = 'upper',
                           'Lower Case' = 'lower'),
               selected = 'upper',
               inline = TRUE)
)

# server
server <- function(input, output, session) {
  selectListReactive <- reactive({
    validate(need(is.null(input$letterType), FALSE))
    if (input$letterType == 'upper')
      selectList1
    else
      selectList2
  })
  observeEvent(input$letterType, {
    updateSelectizeInput(session = session, inputId = 'mylist',
                         choices = c(Choose = '', selectListReactive()),
                         server = TRUE)
  })
}

# app
shinyApp(ui = ui, server = server)
Автор: Gopala Источник Размещён: 18.07.2016 02:10

Ответы (2)


5 плюса

92 Репутация автора

Я сделал это быстрее с пакетом data.table :

library(data.table)
selectList <- as.data.table(sapply(1:15000, function(x) paste(sample(letters, 10), collapse = '')))
ui <- fluidPage(
  selectInput('mylist', 'Select Something',
              choices = c(Choose = '', selectList),
              selected = 1)
)

server <- function(input, output) {
}

shinyApp(ui = ui, server = server)

Это может стоить

Автор: dangulo Размещён: 01.08.2016 08:34

23 плюса

9301 Репутация автора

Решение

Привет попробуйте поместить варианты на сервере с помощью updateSelectizeInputи использовать server = TRUEдля хранения вариантов на стороне сервера, например:

library("shiny")
# mylist
selectList <- sapply(1:15000, function(x) paste0(x, "_", paste(sample(letters, 10), collapse = '')))
# ui
ui <- fluidPage(
  selectizeInput(
    inputId = 'mylist', label = 'Select Something',
    choices = NULL,
    selected = 1
  )
)
# server
server <- function(input, output, session) {
  updateSelectizeInput(session = session, inputId = 'mylist', choices = c(Choose = '', selectList), server = TRUE)
}
# app
shinyApp(ui = ui, server = server)

Вы должны использовать selectizeInputи не selectInputдля этого работать

Автор: Victorp Размещён: 02.08.2016 07:29
Вопросы из категории :
32x32