如何根据用户选择使用 shiny 呈现动态 UI
How to render dynamic UIs based on user selection with shiny
给定一组闪亮的 UI 及其不同的参数(从 rdf 中读取,此处作为显式列表给出)用户如何select 获得所需的输入类型(对于具有许多不同的输入,全部预设为默认值)要更改?
library(shiny)
library(shinyWidgets)
library(DT)
library(purrr)
library(dplyr)
library(data.table)
#-----------------someWidgetsAndArguments-------------------.
inputWidget <- list("selectInput", "sliderInput", "textInput", "numericInput")
inpWidgArgs <- list(list(inputId = "inpUI01", label = "seInp01", choices = "seq(1,20,1)", selected = 10),
list(inputId = "inpUI02", label = "slInp02", min= 0, max = 100, value = "c(25,75)" ),
list(inputId = "inpUI03", label = "txInp03", value = "enter some text"),
list(inputId = "inpUI04", label = "nrInp04", value = 1000000) )
#----------------presetPickerInput---------------------
if (interactive()) {
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
pickerInput(inputId = "pkInp01",
label = "Select CF-Model Inputs for change",
choices = inputWidget,
selected = inputWidget[1:2],
multiple = TRUE,
options = list(`actions-box` = TRUE,
`selected-text-format`= "count",
`count-selected-text` = "{0} inputs of {1} selected") ),
uiOutput("inpUI"),
),
mainPanel(
dataTableOutput("table01")
)
)
)
#-----------------generateArguments4invoke_map---------------------------.
server <- function(input, output, session) {
#B: obs <- reactiveValues(
#A: pckdWdgt <- inputWidget[match(input$pkInp01, inputWidget)],
#A: wdgtArgs <- inpWidgArgs[match(input$pkInp01, inputWidget)]
#B: )
#B: observe({
#B: obs$pW01 = inputWidget[match(input$pkInp01, inputWidget)]
#B: obs$wA02 = inpWidgArgs[match(input$pkInp01, inputWidget)]
#B: })
#------------------renderAsManyInputUisAsPicked------------
output$inpUI <- renderUI({
#A: invoke_map(match.fun(pckdWdgt), wdgtArgs)
#B: invoke_map(match.fun(obs$pW01), obs$WA02)
invoke_map(list(selectInput, sliderInput), list(
list(inputId = "inpUI01", label = "selectInput01", choices = seq(1,20,1), selected = 10),
list(inputId = "inpUI02", label = "sliderInput02", min= 0, max = 100, value = c(25,75) )
)
)
})
}
}
#-----------------------------------------------------
shinyApp(ui, server)
使用 map() 或 invoke_map() 应该可以传递 function/UIinput 的类型及其参数(比较:https://hadley.shinyapps.io/ms-render-palette-full)。
下面的两种方法(A: 和 B:)失败了(可能的原因:environment/namespace?)非常感谢任何建议。
非常感谢
我清理了您的一些代码并创建了解决方案。从一些小事开始:seInp01 中的 choices 参数不应该在引号之间。 slInp01 中的值参数也是如此。最后,UI 中的 uiOutput 参数后面有一个尾随逗号。对于代码的功能,我只是把一些你已经想到的代码放在正确的地方,你的想法是正确的。
代码:
library(shiny)
library(shinyWidgets)
library(DT)
library(purrr)
library(dplyr)
library(data.table)
#-----------------someWidgetsAndArguments-------------------.
inputWidget <- list("selectInput", "sliderInput", "textInput", "numericInput")
inpWidgArgs <- list(list(inputId = "inpUI01", label = "seInp01", choices = seq(1,20,1), selected = 10),
list(inputId = "inpUI02", label = "slInp02", min= 0, max = 100, value = c(25,75) ),
list(inputId = "inpUI03", label = "txInp03", value = "enter some text"),
list(inputId = "inpUI04", label = "nrInp04", value = 1000000) )
#----------------presetPickerInput---------------------
if (interactive()) {
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
pickerInput(inputId = "pkInp01",
label = "Select CF-Model Inputs for change",
choices = inputWidget,
selected = inputWidget[1:2],
multiple = TRUE,
options = list(`actions-box` = TRUE,
`selected-text-format`= "count",
`count-selected-text` = "{0} inputs of {1} selected") ),
uiOutput("inpUI")
),
mainPanel(
dataTableOutput("table01")
)
)
)
#-----------------generateArguments4invoke_map---------------------------.
server <- function(input, output, session) {
#------------------renderAsManyInputUisAsPicked------------
output$inpUI <- renderUI({
wdgtArgs <- inpWidgArgs[match(input$pkInp01, inputWidget)]
invoke_map(input$pkInp01, wdgtArgs)
})
}
}
#-----------------------------------------------------
shinyApp(ui, server)
给定一组闪亮的 UI 及其不同的参数(从 rdf 中读取,此处作为显式列表给出)用户如何select 获得所需的输入类型(对于具有许多不同的输入,全部预设为默认值)要更改?
library(shiny)
library(shinyWidgets)
library(DT)
library(purrr)
library(dplyr)
library(data.table)
#-----------------someWidgetsAndArguments-------------------.
inputWidget <- list("selectInput", "sliderInput", "textInput", "numericInput")
inpWidgArgs <- list(list(inputId = "inpUI01", label = "seInp01", choices = "seq(1,20,1)", selected = 10),
list(inputId = "inpUI02", label = "slInp02", min= 0, max = 100, value = "c(25,75)" ),
list(inputId = "inpUI03", label = "txInp03", value = "enter some text"),
list(inputId = "inpUI04", label = "nrInp04", value = 1000000) )
#----------------presetPickerInput---------------------
if (interactive()) {
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
pickerInput(inputId = "pkInp01",
label = "Select CF-Model Inputs for change",
choices = inputWidget,
selected = inputWidget[1:2],
multiple = TRUE,
options = list(`actions-box` = TRUE,
`selected-text-format`= "count",
`count-selected-text` = "{0} inputs of {1} selected") ),
uiOutput("inpUI"),
),
mainPanel(
dataTableOutput("table01")
)
)
)
#-----------------generateArguments4invoke_map---------------------------.
server <- function(input, output, session) {
#B: obs <- reactiveValues(
#A: pckdWdgt <- inputWidget[match(input$pkInp01, inputWidget)],
#A: wdgtArgs <- inpWidgArgs[match(input$pkInp01, inputWidget)]
#B: )
#B: observe({
#B: obs$pW01 = inputWidget[match(input$pkInp01, inputWidget)]
#B: obs$wA02 = inpWidgArgs[match(input$pkInp01, inputWidget)]
#B: })
#------------------renderAsManyInputUisAsPicked------------
output$inpUI <- renderUI({
#A: invoke_map(match.fun(pckdWdgt), wdgtArgs)
#B: invoke_map(match.fun(obs$pW01), obs$WA02)
invoke_map(list(selectInput, sliderInput), list(
list(inputId = "inpUI01", label = "selectInput01", choices = seq(1,20,1), selected = 10),
list(inputId = "inpUI02", label = "sliderInput02", min= 0, max = 100, value = c(25,75) )
)
)
})
}
}
#-----------------------------------------------------
shinyApp(ui, server)
使用 map() 或 invoke_map() 应该可以传递 function/UIinput 的类型及其参数(比较:https://hadley.shinyapps.io/ms-render-palette-full)。
下面的两种方法(A: 和 B:)失败了(可能的原因:environment/namespace?)非常感谢任何建议。
非常感谢
我清理了您的一些代码并创建了解决方案。从一些小事开始:seInp01 中的 choices 参数不应该在引号之间。 slInp01 中的值参数也是如此。最后,UI 中的 uiOutput 参数后面有一个尾随逗号。对于代码的功能,我只是把一些你已经想到的代码放在正确的地方,你的想法是正确的。
代码:
library(shiny)
library(shinyWidgets)
library(DT)
library(purrr)
library(dplyr)
library(data.table)
#-----------------someWidgetsAndArguments-------------------.
inputWidget <- list("selectInput", "sliderInput", "textInput", "numericInput")
inpWidgArgs <- list(list(inputId = "inpUI01", label = "seInp01", choices = seq(1,20,1), selected = 10),
list(inputId = "inpUI02", label = "slInp02", min= 0, max = 100, value = c(25,75) ),
list(inputId = "inpUI03", label = "txInp03", value = "enter some text"),
list(inputId = "inpUI04", label = "nrInp04", value = 1000000) )
#----------------presetPickerInput---------------------
if (interactive()) {
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
pickerInput(inputId = "pkInp01",
label = "Select CF-Model Inputs for change",
choices = inputWidget,
selected = inputWidget[1:2],
multiple = TRUE,
options = list(`actions-box` = TRUE,
`selected-text-format`= "count",
`count-selected-text` = "{0} inputs of {1} selected") ),
uiOutput("inpUI")
),
mainPanel(
dataTableOutput("table01")
)
)
)
#-----------------generateArguments4invoke_map---------------------------.
server <- function(input, output, session) {
#------------------renderAsManyInputUisAsPicked------------
output$inpUI <- renderUI({
wdgtArgs <- inpWidgArgs[match(input$pkInp01, inputWidget)]
invoke_map(input$pkInp01, wdgtArgs)
})
}
}
#-----------------------------------------------------
shinyApp(ui, server)