To edit a one-to-many like data structure,
- I would like to create a data table (
DTOutput
), on which I observe cell clicksobserveEvent(input$groupingsOut_cell_clicked, {...})
. - Then at every cell click, I would like to generate input fields on the UI.
- Finally, I would like to listen to changed on those rendered/generated UI.
I can't edit these cells directly in the DTOutput, as it doesn't support vectors within cells. (Hence, one-to-many relationship).
I have managed steps 1 and 2. I can render a DTOutput with corresponding cells. I can observe cell clicks and insert UI (insertUI()
) upon cell clicks. I created observeEvent objects to observe those rendered fields. However, those observeEvents are never fired upon editing newly generated fields.
ui = fluidPage(title = titlePanel("Title"),
tags$head(tags$style(HTML("hr {border-top: 1px solid #000000;}"))),
sidebarLayout(
sidebarPanel(),
mainPanel(tabsetPanel(type = "tabs",
tabPanel("Groupings", DTOutput(outputId = "groupingsOut"),
tags$div(id = 'placeholder')),
tabPanel("Test", textOutput(outputId = "statusOut")),
tabPanel("Plot Generator", plotOutput(outputId = "distPlotOut")))
)
)
)
server = function(input, output) {
# Label reactive values
labelRVs = list()
#Example table
groupings = data.frame(names = c("cars", "mbikes", "bikes"),
labels = c("Cars", "Motor Bikes", "Bikes"),
groups = I(list(c("toyota", "vw", "tesla"), c("harley", "kawasaki"), c("somth", "anoth", "bla"))),
groupLabels = I(list(c("Toyota", "VW", "Tesla"), c("Harley Davidson", "Kawasaki"), c("Something", "Another Thing", "Bla bla"))))
#groupings = data.frame()
proxy = dataTableProxy('groupingsOut')
observeEvent(input$groupingsOut_cell_clicked, {
info = input$groupingsOut_cell_clicked
if(!is.null(info$row)){
grouping = groupings[[info$row, 1]]
groupingLabel = groupings[[info$row, 2]]
groups = groupings[[info$row, 3]]
groupLabels = groupings[[info$row, 4]]
# remove previously generated UI
removeUI(selector = paste0('#placeholder input'), multiple = TRUE)
removeUI(selector = paste0('#placeholder label'), multiple = TRUE)
# Generating ID for grouping labels
id = paste0("groupLabel_", i)
# Inserting text input for grouping label
insertUI(selector = '#placeholder', ui = textInput(id, label = "Grouping label:", value = groupingLabel))
labelRVs[[id]] <<- observeEvent(id, {
cat(paste(id, i, "\n")) # THIS LINE ONLY RUNS AT INITIALIZATION :(
})
lapply(1:length(groups), function(i){
index = sprintf("%03d", i)
id = paste0('label_', index)
insertUI(selector = '#placeholder',
ui = textInput(id, label = paste0("Group label for ", groups[i], ":"), value = groupLabels[i]))
labelRVs[[id]] <<- observeEvent(id, {
cat(paste(id, i, "\n")) # ALSO THIS LINE ONLY RUNS AT INITIALIZATION :(
})
})
}
})
output$groupingsOut = renderDT(groupings[, c(1, 3)], rownames = FALSE, editable = TRUE, selection = 'single')
}
shinyApp(ui = ui, server = server)
However, this example Shiny - Can dynamically generated buttons act as trigger for an event runs perfectly fine. In the example instead of insertUI into tags, renderUI to outputUI is used. I adapted my code above to use renderUI, which also failed. At this point, I am suspecting if DTOutput doesn't behave the same way as other input fields.
Beaware of the usage of <<- operator to assign labelRVs to keep observeEvent objects alive. This is indeed necessary, which is shown in the example.
I wonder, if there is any way to observe such fields?