У меня блестящее приложение с виджетом selectizeInput
, который получает около 26000 вариантов выбора из удаленной базы данных в форме реактивных данных.Использование удаленной базы данных и реактивности позволяет избежать отставания и медлительности при загрузке вариантов.Проблема в том, что при локальном запуске на рабочем столе он работает нормально, но при загрузке на shinyapps.io виджет не предоставляет пользователю все доступные варианты.Я поиграл с атрибутами виджетов безрезультатно, например, установил SERVER =TRUE
и так далее.Я поставил код, который я использую ниже, а также ссылку на данные, которые я хочу загрузить в selectizeInput
в качестве выбора.
Часть пользовательского интерфейса
library(shiny)
library(DBI)
library(RMySQL)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
skin="yellow",
dashboardHeader( ),
#sidebar content
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 = 1000,
maxItems = 100,multiple = F, searchConjunction = 'and')),
tags$style(type="text/css",
".selectize-
input::after{visibility:hidden;};"
)
)
)
)
)
)
)
)
Серверная часть
library(shiny)
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)),
server = TRUE)
})
session$onSessionEnded(function() { dbDisconnect(con) })
})
Что я делаю не так?Это проблема shinyapps.io или проблема кодирования?