Ответ 1
Понимание вашей проблемы:
Чтобы определить вашу задачу, вы должны знать две вещи.
- Если обновляемый datatable будет обновлен, он будет "удален" и будет построен с нуля (на 100% не уверен, думаю, я его где-то читал).
- Имейте в виду, что вы строите html-страницу по существу.
selectInput() - это всего лишь оболочка для html-кода. Если вы selectInput("a", "b", "c") в консоли, он вернется:
<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>
Обратите внимание, что вы строите <select id="a">, выберите с id="a". Поэтому, если мы предположим, что 1) правильно после обновления, вы пытаетесь создать еще один элемент html: <select id="a"> с существующим идентификатором. Это не должно работать: может ли несколько разных элементов HTML иметь один и тот же идентификатор, если они являются разными элементами? , (Предполагая, что мое предположение 1) истинно;))
Решение вашей проблемы:
На первый взгляд довольно просто: просто убедитесь, что идентификатор, который вы используете, уникален в созданном html-документе.
Очень быстрый и грязный способ заключается в замене:
inputId = paste0("col_",.x)
с чем-то вроде: inputId = paste0("col_", 1:nc, "-", sample(1:9999, nc)).
Но это будет трудно использовать впоследствии для вас.
Более длинный путь:
Таким образом, вы можете использовать какую-то память
- Какие идентификаторы вы уже использовали.
- Какими из них являются ваши текущие идентификаторы.
Ты можешь использовать
global <- reactiveValues(oldId = c(), currentId = c())
для этого.
Идея отфильтровать старые использованные идентификаторы и извлечь текущие может быть такой:
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)
Воспроизводимый пример будет читать:
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)