我正在开发一个应用程序,允许用户动态地向UI添加新的selectInput框,我希望所有这些selectInput框都将数据集的列名作为他们的选择' ;。数据集也应该由用户选择,这就是为什么我使selectInput选项对数据集选择中的更改起反应的原因。
听起来很简单但我似乎无法让它正常工作。当我第一次打开应用程序时,第一个selectInput为空;这没关系,因为我希望用户能够上传他们自己的数据集,因此默认数据集无论如何都是NULL(这里使用预先加载的数据集进行再现,因此它略有不同)。
我选择了一个(不同的)数据集,' iris'从下拉列表中选择框,以及' iris'的列名称。数据集会自动加载到selectInput框中(表1)。这根据需要完美地工作。
接下来,我通过单击表1中的Plus符号添加一个新的selectInput框,旁边会出现一个新的selectInput框(表2)。
问题在于:我希望新创建的子selectInput框自动使用数据集的列名,但我无法弄清楚如何执行此操作。填充新selectInput框的唯一方法是再次更改数据集选项,这是不可取的。
以下是此示例中使用的代码:
library(shiny)
library(datasets)
server <- function(input, output, session) {
### FUNCTIONS ###
newNode <- function(id, parentId) {
node <- list(
parent = parentId,
children = list()
)
# Create the UI for this node
createSliceBox(id, parentId)
return(node)
}
createSliceBox <- function(id, parentId) {
# Div names
containerDivID <- paste0('container',id,'_div')
nodeDivID <- paste0('node',id,'_div')
childrenDivID <- paste0('children',id,'_div')
if (parentId == 0) { # Root node case
parentDivID <- 'allSliceBoxes'
} else {
parentDivID <- paste0('children',parentId,'_div')
}
# Input names
selectID <- paste0("sliceBoxSelect", id)
buttonID <- paste0("sliceBoxButton", id)
# Insert the UI element for the node under the parent's children_div
insertUI(
selector = paste0('#',parentDivID),
where = 'afterBegin',
ui = tagList(
tags$div(id=containerDivID, style='float:left',
tags$div(id=nodeDivID, style='float:left; margin: 5px; min-width:250px',
actionButton(buttonID, "",
icon("plus-circle fa-1x"), style="float:right; border:none; color:#00bc8c; background-color:rgba(0,0,0,0)"),
wellPanel(class="well well-sm",
selectInput(selectID, paste0("Table ", id, ", child of ", parentId, "."), c(''), multiple=FALSE)
)
),
tags$div(id=childrenDivID, style='float:left') # Container for children, starts empty
),
tags$br('')
)
)
# Observer for selectors
observe(
updateSelectInput(session, selectID, choices=names(d.Preview()) ) # Doesn't work as expected?
)
}
### CODE STARTS HERE
tags$head(tags$script(src="https://use.fontawesome.com/15c2608d79.js")) # Import FontAwesome for icons
# File upload
d.Preview <- reactive({
switch(input$dataset,
"mtcars" = mtcars,
"iris" = iris,
"esoph" = esoph)
})
# We'll store our nodes as a 1D list, so parent and child ID's are recorded as their indices in the list
sliceBox.data <- reactiveValues(display=list(), selected=list())
rootNode <- newNode(1, 0) # Page loads with NULL first node, before input is chosen
sliceBox.tree <- reactiveValues(tree=list(rootNode))
# Special case for loading data into first node, needs reactive parentData - not the case for children nodes
observeEvent(input$dataset, {
slice <- reactive({
sliceData(d.Preview(), input$sliceBoxSelect1)
})
# Creating data for the first node
sliceBox.data$display[[1]] <- reactive(slice())
sliceBox.data$selected[[1]] = reactive({
selectedRows <- input[[paste0("sliceBoxTable", 1, "_rows_selected")]]
filterData(d.Preview(), sliceBox.data$display[[1]](), selectedRows, input[[paste0("sliceBoxSelect",1)]])
})
})
# Keep a total count of all the button presses (also used loosely as the number of tables created)
v <- reactiveValues(counter = 1L)
# Every time v$counter is increased, create new handler for the new button at id=v$counter
observeEvent(v$counter, {
parentId <- v$counter
buttonID <- paste0("sliceBoxButton", parentId)
# Button handlers to create new sliceBoxes
observeEvent(input[[buttonID]], {
v$counter <- v$counter + 1L
childId <- v$counter
# Note that because the ObserveEvents are run separately on different triggers, (childId != parentId+1)
# Create new child
sliceBox.tree$tree[[childId]] <- newNode(childId, parentId)
# Append new childId to parent's list of children
numChildren <- length(sliceBox.tree$tree[[parentId]]$children)
sliceBox.tree$tree[[parentId]]$children[numChildren+1] <- childId
})
})
}
ui <- fluidPage(theme = "bootstrap.css",
# Main display body
fluidRow(style="padding:5px",
selectInput("dataset", "Choose a dataset:", choices = c("mtcars", "iris", "esoph"), selected=NULL),
tags$div(uiOutput("allSliceBoxes"), style="padding:20px")
)
)
shinyApp(ui = ui, server = server)
希望有人可以提供帮助,有很多关于selectInput在线的问题,但我还没有找到解决这个特殊问题的解决方案。