I am trying to do something a little bit tricky and I am hoping that someone can help me.
I would like to add selectInput inside a datatable. If I launch the app, I see that the inputs col_1, col_2.. are well connected to the datatable (you can switch to a, b or c)
BUT If I update the dataset (from iris to mtcars) the connection is lost between the inputs and the datatable. Now if you change a selectinput the log doen't show the modification. How can I keep the links?
I made some test using shiny.bindAll() and shiny.unbindAll() without success.
Any Ideas?
Please have a look at the app:
library(shiny) library(DT) library(shinyjs) library(purrr) ui <- fluidPage( selectInput("data","choose data",choices = c("iris","mtcars")), DT::DTOutput("tableau"), verbatimTextOutput("log") ) server <- function(input, output, session) { dataset <- reactive({ switch (input$data, "iris" = iris, "mtcars" = mtcars ) }) output$tableau <- DT::renderDT({ col_names<- seq_along(dataset()) %>% map(~selectInput( inputId = paste0("col_",.x), label = NULL, choices = c("a","b","c"))) %>% map(as.character) DT::datatable(dataset(), options = list(ordering = FALSE, preDrawCallback = JS("function() { Shiny.unbindAll(this.api().table().node()); }"), drawCallback = JS("function() { Shiny.bindAll(this.api().table().node()); }") ), colnames = col_names, escape = FALSE ) }) output$log <- renderPrint({ lst <- reactiveValuesToList(input) lst[order(names(lst))] }) } shinyApp(ui, server) 1 Answers
Answers 1
Understanding your challenge:
In order to identify your challenge at hand you have to know two things.
- If a datatable is refreshed it will be "deleted" and build from scratch (not 100% sure here, i think i read it somewhere).
- Keep in mind that you are building a html page essentially.
selectInput()is just a wrapper for html code. If you type selectInput("a", "b", "c") in the console it will return:
<div class="form-group shiny-input-container"> <label class="control-label" for="a">b</label> <div> <select id="a"><option value="c" selected>c</option></select> <script type="application/json" data-for="a" data-nonempty="">{}</script> </div> </div> Note that you are building <select id="a">, a select with id="a". So if we assume 1) is correct after refresh you attempt to build another html element : <select id="a"> with an existing id. That is not supposed to work: Can multiple different HTML elements have the same ID if they're different elements?. (Assuming my assumption 1) holds true ;))
Solving your challenge:
On first sight pretty simple: Just ensure the id you use is unique within the created html document.
The very quick and dirty way would be to replace:
inputId = paste0("col_",.x) with something like: inputId = paste0("col_", 1:nc, "-", sample(1:9999, nc)).
But that would be difficult to use afterwards for you.
Longer way:
So you could use some kind of memory
- Which ids you already used.
- Which ones are your current ids in use.
You can use
global <- reactiveValues(oldId = c(), currentId = c()) for that.
An idea to filter out the old used ids and to extract the current ones could be this:
lst <- reactiveValuesToList(input) lst <- lst[setdiff(names(lst), global$oldId)] inp <- grepl("col_", names(lst)) names(lst)[inp] <- sapply(sapply(names(lst)[inp], strsplit, "-"), "[", 1) Reproducible example would read:
library(shiny) library(DT) library(shinyjs) library(purrr) ui <- fluidPage( selectInput("data","choose data",choices = c("iris","mtcars")), dataTableOutput("tableau"), verbatimTextOutput("log") ) server <- function(input, output, session) { global <- reactiveValues(oldId = c(), currentId = c()) dataset <- reactive({ switch (input$data, "iris" = iris, "mtcars" = mtcars ) }) output$tableau <- renderDataTable({ isolate({ global$oldId <- c(global$oldId, global$currentId) nc <- ncol(dataset()) global$currentId <- paste0("col_", 1:nc, "-", sample(setdiff(1:9999, global$oldId), nc)) col_names <- seq_along(dataset()) %>% map(~selectInput( inputId = global$currentId[.x], label = NULL, choices = c("a","b","c"))) %>% map(as.character) }) DT::datatable(dataset(), options = list(ordering = FALSE, preDrawCallback = JS("function() { Shiny.unbindAll(this.api().table().node()); }"), drawCallback = JS("function() { Shiny.bindAll(this.api().table().node()); }") ), colnames = col_names, escape = FALSE ) }) output$log <- renderPrint({ lst <- reactiveValuesToList(input) lst <- lst[setdiff(names(lst), global$oldId)] inp <- grepl("col_", names(lst)) names(lst)[inp] <- sapply(sapply(names(lst)[inp], strsplit, "-"), "[", 1) lst[order(names(lst))] }) } shinyApp(ui, server) 
0 comments:
Post a Comment