r - 更新选取器输入 通过使用 updatePickerInput 在闪亮中

Question

我想更新我的一个pickerInput

ui.R看起来像：

library(shiny)
library(gtools)
library(data.table)
library(DT)
library(shinyWidgets)
library(plotly)
# the 'datT2' dataset.
datT2<-fread(paste0('./data/','31122018KRB.csv'),header=TRUE, sep=";",stringsAsFactors = FALSE , encoding="UTF-8")

##
fluidPage(
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
fluidRow(
column(10,
h3("Port"),
selectInput(inputId = 'date',
label = 'Stichtag:',
choices = sort(list.files('./data', full.names = FALSE,
recursive = FALSE))
),
###  
selectInput("gesell",
"company:",
choices = c(
sort(unique(as.character(datT2$Gesellschaftsname ))))),
# Konzernbezeichnung
pickerInput(
inputId = "konz",
label = "Emittent:",
choices = c(sort(unique(as.character(datT2$Konzernbezeichnung )))),     
selected = sort(unique(as.character(datT2$Konzernbezeichnung ))),    
options = list(`actions-box` = TRUE, 
`selected-text-format` = paste0("count > ", length(unique(as.character(datT2$Konzernbezeichnung )))-1) ,
`count-selected-text` = "Alle",liveSearch = TRUE, 
liveSearchPlaceholder= TRUE),  
multiple = T
)
)
)
,width = 3),
###
# Main panel for displaying outputs ----
mainPanel( 
tabsetPanel(type = "tabs",
tabPanel("Tabelle", DT::dataTableOutput("table")),
tabPanel("Glossar")
)#,  
)#End_of_mainPanel
)
)

和我的server.R

function(input, output,session) {

#gesell<-renderText({reactiveValues(input$gesell)})
### read the data for the summary
#read the data 
dataSum <- reactive({
infile <- input$date
if (is.null(infile)){
return(NULL)
}
dataS<-fread(paste0('./data/',infile),header=TRUE, sep=";")
dataS[is.na(data)]<- 0

})
#read the data for GUI
dataGui <- reactive({
infile <- input$date
if (is.null(infile)){
return(NULL)
}
# upload (read) the file (data)
dataGUI<-fread(paste0('./data/',infile),header=TRUE, sep=";", encoding="UTF-8")
dataGui[is.na(data)]<- 0
dataGUI
#})
observeEvent(input$date, {
# 
updatePickerInput(session = session, inputId = "konz",
choices = dataGui$Konzernbezeichnung)
})
})    
}

但是，它不会更新konz。我做错了什么？ 另一个重要的问题是：它会更新input$konz实际上是为了在server.R中使用还是只显示ui.R中的更新？ 第一个数据集是：31122018.csv

Gesellschaftsname Konzernbezeichnung Rating
UL                 LE     YB
JX                 VU     OE
RB                 AD     VZ
XO                 KL     QG
QN                 TP     XE
IV                 UK     GD
BV                 QB     WJ
LZ                 UL     WR
YY                 JC     UZ

第二个31122019.csv

Gesellschaftsname Konzernbezeichnung Rating
UL                LEA     YB
JX                VUA     OE
RB               AAAD     VZ
XO                 KL     QG
QN                 TP     XE
IV                 UK     GD
BV                 QB     WJ
LZ                 UL     WR
YY                 JC     UZ

Answer 1

关于你的第一个问题。我无法使用下面工作示例的代码重现您的错误。也许它可以帮助您调试代码。

关于你的第二个问题。input$konz由selectPickerInput更新。这会影响input$konz在 UI 中的显示方式以及它在服务器部件中携带的值。您可以看到，在下面的工作示例中，无论选择哪个数据集，过滤器都在处理数据 - 因此更新input$konz不仅美观，而且还更改了基础值。

library("shiny")
library("tibble")
library("dplyr")
library("shinyWidgets")
# Generate data
data1 <- tribble(
~Gesellschaftsname, ~Konzernbezeichnung, ~Rating,
"UL",                 "LE",     "YB",
"JX",                 "VU",     "OE",
"RB",                 "AD",     "VZ",
"XO",                 "KL",     "QG",
"QN",                 "TP",     "XE",
"IV",                 "UK",     "GD",
"BV",                 "QB",     "WJ",
"LZ",                 "UL",     "WR",
"YY",                 "JC",     "UZ"
)
data2 <- tribble(
~Gesellschaftsname, ~Konzernbezeichnung, ~Rating,
"UL",                 "LEA",     "YB",
"JX",                 "VUA",     "OE",
"RB",                 "ADA",     "VZ",
"XO",                 "KLA",     "QG",
"QN",                 "TPA",     "XE",
"IV",                 "UKA",     "GD",
"BV",                 "QBA",     "WJ",
"LZ",                 "ULA",     "WR",
"YY",                 "JCA",     "UZ"
)

shinyApp(
ui = fluidPage( # user interface
sidebarLayout( # layout with Sidebar
sidebarPanel( # input sidebarPanel
# select data
selectInput("data",
"Select data:",
choices = c("data1", "data2"),
selected = "data1"),

# konz
pickerInput(
inputId = "konz",
label = "Emittent:",
choices = c(sort(unique(as.character(data1$Konzernbezeichnung)))),     
selected = sort(unique(as.character(data1$Konzernbezeichnung))),    
options = list(`actions-box` = TRUE, 
`selected-text-format` = paste0("count > ", length(unique(as.character(data1$Konzernbezeichnung )))-1) ,
`count-selected-text` = "Alle",liveSearch = TRUE, 
liveSearchPlaceholder = TRUE),  
multiple = T
)

), # closes sidebarPanel
mainPanel( # Output in mainPabel
tableOutput("table")

) # closes mainPanel
) # closes sidebarLayout
), # closes fluidPage
server = function(input, output, session) {
reac_data_gui <- reactive({
get(input$data)
})
reac_data <- reactive({
reac_data_gui() %>% filter(Konzernbezeichnung %in% input$konz)
})
observeEvent(input$data, {
updatePickerInput(session = session, inputId = "konz",
choices = sort(unique(as.character(reac_data_gui()$Konzernbezeichnung))),
selected = sort(unique(as.character(reac_data_gui()$Konzernbezeichnung))))
})
output$table <- renderTable({
reac_data() 
})
}
)