Приложение ниже содержит actionButton Add data, который вставляет элемент пользовательского интерфейса при каждом нажатии.Каждый элемент пользовательского интерфейса представляет собой блок, который содержит один selectInput Select data и actionButton Edit, который открывает модальное окно при нажатии.
Каждый модал содержит:
- Таблица данных с двумя столбцами:
Parameter и Value (этот столбец редактируемый). - actionButton
Apply, который применяет любые изменения, внесенные в столбец Value.
Когда пользователь выбирает набор данных внутри поля x, реактивное значение создается для хранениясоответствующие параметры в data.frame x_paramset (где x - это идентификатор поля, вставленного через insertUI) и добавьте столбец val, который имеет то же значение, что и default (см. список в верхней части кода ниже).Затем я использую renderDataTable, чтобы добавить столбец Value (который содержит numericInput) - эта таблица данных отображается внутри модального поля.
Чтобы обновить data.frame, чтобы применить любые изменения, которые пользователь, возможно, сделал в модальном порядке, я использую Наблюдение за событием, которое прослушивает кнопку Apply и обновляет столбец val в data.frame x_paramset со значениями внутри числовых входов в столбце Value.
Вот приложение (bsModal закомментирован и заменен блестящимWidgets :: dropdownButton):
library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinyWidgets)
library(DT)
library(tidyverse)
all = list(p1 = list(a = list(id = "a", default = 10)),
p2 = list(x = list(id = "x", default = 20)))
# UI ----------------------------------------------------------------------
ui<-fluidPage(shinyjs::useShinyjs(),
tags$head(
tags$script("
$(document).on('click', '.dropdown-shinyWidgets li button', function () {
$(this).blur()
Shiny.onInputChange('lastClickId',this.id)
Shiny.onInputChange('lastClick',Math.random())
});
")
),
box(title = "Add data",
column(width = 12,
fluidRow(
tags$div(id = 'add')
),
fluidRow(
actionButton("addbox", "Add data")
))
)
)
# SERVER ------------------------------------------------------------------
server <- function(input, output, session) {
rvals = reactiveValues()
getInputs <- function(pattern){
reactives <- names(reactiveValuesToList(input))
name = reactives[grep(pattern,reactives)]
}
observeEvent(input$addbox, {
lr = paste0('box', input$addbox)
insertUI(
selector = '#add',
ui = tags$div(id = lr,
box(title = lr,
selectizeInput(lr, "Choose data:", choices = names(all)),
shinyWidgets::dropdownButton(inputId = paste0(lr, "_settings"),
circle = F, status = "success", icon = icon("gear"), width = "1000px",
tooltip = tooltipOptions(title = "Click to edit"),
tags$h4(paste0("Edit settings for Learner", lr)),
hr(),
DT::dataTableOutput( paste0(lr, "_paramdt") ),
bsButton(paste0(lr, "_apply"), "Apply")
) # end dropdownButton
)
) #end tags$div
) # end inserUI
# create reactive dataset
rvals[[ paste0(lr, "_paramset") ]] <- reactive({
do.call(rbind, all[[ input[[lr]] ]]) %>%
cbind(., lr) %>%
as.data.frame %>%
mutate(val = default)
}) # end reactive
# render DT in modal
output[[ paste0(lr, "_paramdt") ]] <- renderDataTable({
DT <- rvals[[ paste0(lr, "_paramset") ]]() %>%
mutate(
Parameter = id,
Value = as.character(numericInput(paste0(lr,"value",id), label = NULL, value = default))) %>%
select(Parameter:Value)
datatable(DT,
selection = 'none',
#server = F,
escape = F,
options = list(preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
}) # end renderDT
# Apply changes
observeEvent(input$lastClick, {
# replace old values with new
rvals[[ paste0(lr, "_paramset") ]](rvals[[ paste0(lr, "_paramset") ]]() %>%
mutate(
val = input$box1valuea
)
)
}) # end apply changes observeEvent
}) #end observeEvent
}
shinyApp(ui=ui, server=server)
Я сталкиваюсь с ошибками при попытке выполнить следующее:
Add data >> Edit >> make some change to numericInput >> Apply - это сбрасывает numericInput внутри модального режима к его значению по умолчанию, тогда как я хотел бы, чтобы указанное пользователем значение сохранялось при применении изменений или закрытиимодальное. - Приложение вылетает при попытке:
Add data >> Edit >> Apply >> close modal >> Add data ИЛИ Дважды нажмите Add data, а затем нажмите Edit в любом из полей.
Я не уверен, где мойлогика сервера не работает.Я знаю, что Shiny не поддерживает модалы «постоянного использования» (https://github.com/rstudio/shiny/issues/1590), но мне было интересно, был ли обходной путь? Я также не уверен, что внутри insertUI observeEvent вызывает сбой приложения вслучаи, описанные выше. Любая помощь, которую вы можете предложить, будет принята с благодарностью!