R Shiny：如何动态附加任意数量的输入小部件 [英] R Shiny: How to dynamically append arbitrary number of input widgets
问题描述
我正在开发一个Shiny应用程序，该应用程序允许用户上传自己的数据，并通过提供数据过滤小部件来关注整个数据或子集由下图
描述
选择输入 变量1 将显示由用户和选择输入 值将显示在 变量1 中选择的相应列的所有唯一值。理想情况下，用户可以通过某种触发方式添加尽可能多的此类行（ 变量X + 值），一种可能性是点击添加更多操作按钮。
I am working on a Shiny app that allows the user to upload their own data and focus on the entire data or a subset by providing data filtering widgets described by the below graph The select input "Variable 1" will display all the column names of the data uploaded by the user and the selectize input "Value" will display all the unique values of the corresponding column selected in "Variable 1". Ideally, the user will be able to add as many such rows ("Variable X" + "Value") as possible by some sort of trigger, one possibility being clicking the "Add more" action button.
在网上查找后，我发现了一个由 Nick Carchedi 粘贴在
After looking up online, I've found one promising solution given by Nick Carchedi pasted below
ui.R
library(shiny)
shinyUI(pageWithSidebar(
# Application title
headerPanel("Dynamically append arbitrary number of inputs"),
# Sidebar with a slider input for number of bins
sidebarPanel(
uiOutput("allInputs"),
actionButton("appendInput", "Append Input")
),
# Show a plot of the generated distribution
mainPanel(
p("The crux of the problem is to dynamically add an arbitrary number of inputs
without resetting the values of existing inputs each time a new input is added.
For example, add a new input, set the new input's value to Option 2, then add
another input. Note that the value of the first input resets to Option 1."),
p("I suppose one hack would be to store the values of all existing inputs prior
to adding a new input. Then,", code("updateSelectInput()"), "could be used to
return inputs to their previously set values, but I'm wondering if there is a
more efficient method of doing this.")
)
))
服务器.R
library(shiny)
shinyServer(function(input, output) {
# Initialize list of inputs
inputTagList <- tagList()
output$allInputs <- renderUI({
# Get value of button, which represents number of times pressed
# (i.e. number of inputs added)
i <- input$appendInput
# Return if button not pressed yet
if(is.null(i) || i < 1) return()
# Define unique input id and label
newInputId <- paste0("input", i)
newInputLabel <- paste("Input", i)
# Define new input
newInput <- selectInput(newInputId, newInputLabel,
c("Option 1", "Option 2", "Option 3"))
# Append new input to list of existing inputs
inputTagList <<- tagAppendChild(inputTagList, newInput)
# Return updated list of inputs
inputTagList
})
})
缺点
Nick Carchedi 本人，每次添加新的小部件时，所有现有的输入小部件都会被重置。
The downside
As pointed by Nick Carchedi himself, all the existing input widgets will undesirably get reset every time when a new one is added.
如warmover流 ，datatable 函数> DT 包提供了一种很好的方法来过滤Shiny中的数据。
As suggested by warmoverflow, the datatable function in DT package provides a nice way to filter the data in Shiny. See below a minimal example with data filtering enabled.
library(shiny)
shinyApp(
ui = fluidPage(DT::dataTableOutput('tbl')),
server = function(input, output) {
output$tbl = DT::renderDataTable(
iris, filter = 'top', options = list(autoWidth = TRUE)
)
}
)
如果要在Shiny应用程序中使用它，则需要注意一些重要方面。
If you are going to use it in your Shiny app, there are some important aspects that are worth noting.
- 过滤框类型
- 对于数字/日期/时间列：范围滑块用于过滤范围内的行
- 对于要素列：选择输入用于显示所有可能的类别
- 对于字符列：使用普通的搜索框
- 假设表输出ID为
tableId，请使用input $ tableId_rows_all为所有页面上的行的索引（在表被搜索字符串过滤之后）。 请注意，input $ tableId_rows_all返回DT所有页面上行的索引（> = 0.1.26）。如果您通过常规install.packages（'DT'）使用DT版本，则仅返回当前页面的索引 - 要安装 DT （> = 0.1.26），请参阅其 GitHub页面
- Suppose the table output id is
tableId, useinput$tableId_rows_allas the indices of rows on all pages (after the table is filtered by the search strings). Please note thatinput$tableId_rows_allreturns the indices of rows on all pages for DT (>= 0.1.26). If you use the DT version by regularinstall.packages('DT'), only the indices of the current page are returned - To install DT (>= 0.1.26), refer to its GitHub page
- 如果数据有很多列，列宽和过滤器框的宽度会很窄，这使得很难在报告中看到文本此处
- If the data have many columns, column width and filter box width will be narrow, which makes it hard to see the text as report here
仍有待解决
尽管存在一些已知问题，但 datatable DT 包中的$ c>是一个有前途的数据子集解决方案闪亮然而，问题本身，即如何在Shiny中动态附加任意数量的输入窗口小部件，这很有趣，而且也很有挑战性。在人们找到解决问题的好方法之前，我将不公开这个问题：）
Still to be solved
Despite some known issues, datatable in DT package stands as a promising solution for data subsetting in Shiny. The question itself, i.e. how to dynamically append arbitrary number of input widgets in Shiny, nevertheless, is interesting and also challenging. Until people find a good way to solve it, I will leave this question open :)
谢谢！
推荐答案
您是否正在寻找类似的东西？
are you looking for something like this?
library(shiny)
LHSchoices <- c("X1", "X2", "X3", "X4")
#------------------------------------------------------------------------------#
# MODULE UI ----
variablesUI <- function(id, number) {
ns <- NS(id)
tagList(
fluidRow(
column(6,
selectInput(ns("variable"),
paste0("Select Variable ", number),
choices = c("Choose" = "", LHSchoices)
)
),
column(6,
numericInput(ns("value.variable"),
label = paste0("Value ", number),
value = 0, min = 0
)
)
)
)
}
#------------------------------------------------------------------------------#
# MODULE SERVER ----
variables <- function(input, output, session, variable.number){
reactive({
req(input$variable, input$value.variable)
# Create Pair: variable and its value
df <- data.frame(
"variable.number" = variable.number,
"variable" = input$variable,
"value" = input$value.variable,
stringsAsFactors = FALSE
)
return(df)
})
}
#------------------------------------------------------------------------------#
# Shiny UI ----
ui <- fixedPage(
verbatimTextOutput("test1"),
tableOutput("test2"),
variablesUI("var1", 1),
h5(""),
actionButton("insertBtn", "Add another line")
)
# Shiny Server ----
server <- function(input, output) {
add.variable <- reactiveValues()
add.variable$df <- data.frame("variable.number" = numeric(0),
"variable" = character(0),
"value" = numeric(0),
stringsAsFactors = FALSE)
var1 <- callModule(variables, paste0("var", 1), 1)
observe(add.variable$df[1, ] <- var1())
observeEvent(input$insertBtn, {
btn <- sum(input$insertBtn, 1)
insertUI(
selector = "h5",
where = "beforeEnd",
ui = tagList(
variablesUI(paste0("var", btn), btn)
)
)
newline <- callModule(variables, paste0("var", btn), btn)
observeEvent(newline(), {
add.variable$df[btn, ] <- newline()
})
})
output$test1 <- renderPrint({
print(add.variable$df)
})
output$test2 <- renderTable({
add.variable$df
})
}
#------------------------------------------------------------------------------#
shinyApp(ui, server)
这篇关于R Shiny：如何动态附加任意数量的输入小部件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
