У меня есть блестящее приложение, которое вызывает у меня проблему.То, что я хотел бы сделать, это динамически создавать некоторые actionLinks, которые при нажатии запускают модальное окно для открытия.Количество ссылок действий будет варьироваться в зависимости от значения selectInput.SelectInput позволяет пользователю выбрать год.Например, количество ссылок на действия в 2018 году может быть 1, а количество ссылок на действия в 2016 году может быть 3.
Код, который я вставил здесь, создает различное количество ссылок ActionLink на основе данных.Проблема, с которой я сталкиваюсь, заключается в том, что, если я нажимаю на actionLink (который открывает модальное окно, а затем закрывает его) и ТОГДА изменяет год, открывается новое модальное окно (без повторного нажатия на activeLink).Мне бы хотелось, чтобы модальное окно открывалось только после нажатия другой actionLink.
Как сохранить модальное окно без открытия actionLink?
library(shiny)
ActionLinkIndex <- NULL
YearCount <- 0
firstCall <- TRUE
savedYear <- 2018
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Test Application"),
sidebarLayout(
sidebarPanel(
radioButtons("graph", "Select Buttons:",
c("Test1",
"Test2")
)
),
mainPanel(
uiOutput("theUI")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
library(tidyr)
library(dplyr)
########################################################
# Data Creation #
########################################################
gReportTable2016 <- data.frame(NAME=c("A", "B", "C"), CH=c(0,1,1), CO=c(0,0,0), M=c(1,0,1))
gReportTable2018 <- data.frame(NAME=c("ABC"), CH=0, CO=0, M=1)
gReportTable2017 <- data.frame(NAME=c("DEF", "GHI"), CH=c(0,1), CO=c(0,0), M=c(1,1))
########################################################
# Observe Events #
########################################################
observeEvent(input$theYear, {
cat("********************** Entered observeEvent(input$theYear) ********************\n")
savedYear <- input$theYear
if(input$theYear=="2016") theTable <<- gReportTable2016
if(input$theYear=="2017") theTable <<- gReportTable2017
if(input$theYear=="2018") theTable <<- gReportTable2018
if(firstCall==TRUE){
firstCall <<- FALSE
} else{
for(i in ActionLinkIndex:1){
cat(" ******************** Destroying", paste0("AL", i), "**********************\n")
t.observers.new[[i]]$destroy()
}
}
ActionLinkIndex <<- NULL
tempCount <- YearCount + 1
assign("YearCount", tempCount, pos=1)
cat("********************** Leaving observeEvent(input$theYear) ********************\n")
}, ignoreInit=TRUE)
create.observers.new <- function(number.of.observers, html.ID, in.data){
trigger.modal.debug <- function(){
showModal(modalDialog(
renderUI({
tagList(
h4("Print something")
)
}),
title = "Blank Modal Window",
easyClose = TRUE
))}
number.of.observers <- dim(theTable)[[1]]
IDs <- seq_len(number.of.observers)
t.out <- lapply(IDs, function(i){
cat("Creating observer:", paste0("AL", i), "\n")
observeEvent(input[[paste0(html.ID, i)]], trigger.modal.debug(), ignoreNULL=TRUE, suspended=FALSE)
})
t.out
}
########################################################
# Create UIs #
########################################################
output$theYearList <- renderUI({
first.year <- 2016
last.year <- 2018
year.list <- c(first.year:last.year)
t.out <- selectInput("theYear", "Year:",
year.list, selected = savedYear
)
t.out
})
output$testReport <- renderUI({
f.NewRow <- function(the.data){
the.rows <- c(1:dim(the.data)[[1]])
t.out <- vector("list", length(the.rows))
t.out <- lapply(the.rows, function(i){
t.out[[i]] <- fluidRow(
f.details(the.data[i,])
)
})
t.out
}
f.details <- function(data){
setValue <- function(data, index){
index <- index + 1
t.out <- list(actionLink(paste0("AL", index), label = paste0("Name:", data$NAME)))
ActionLinkIndex <<- index
t.out
}
if(is.null(ActionLinkIndex))
ActionLinkIndex <<- 0
t.out <- setValue(data, ActionLinkIndex)
t.out
}
if(!is.null(input$theYear)){
t.out <- list(fluidRow(
f.NewRow(theTable)
))
t.1 <- create.observers.new(ActionLinkIndex, "AL", theTable) #the.data)
t.observers.new <<- t.1
} else t.out <- NULL
t.out
})
output$theUI <- renderUI({
tagList(
uiOutput("theYearList"),
uiOutput("testReport")
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Модальные окна открываются безНажатие на actionLink после изменения в selectInput.