I am working with bsModal in R shiny for first time. Need help in the below query.
I need to show Modal dialog box while executing the model, but with conditions as well as it should halt the execution while the user is making choice from the modal dialog box.
Below is minimal code:
library(shiny)
library(dplyr)
library(shinyBS)
m = data.frame(Model = c('Model1', 'Model2', 'Model3', 'Model4', 'Model5'),
A = c(2,3,5,8,9),
B = c(3,6,8,9,10),
C = c(3,8,9,10,8),
D = c(1, 8, 9,9,8),
E = c(3,1,9,8,8))
loop = data.frame( loop = c(1,2,3,4,5,6,7),
value = c(1,2,3,6,8,9,7),
remark = c('','','modal appear','','modal appear','',''))
shinyApp(
ui = fluidPage(
title = 'Radio buttons in a table',
datatable(loop),
actionButton('execute', 'Execute',style="color: #fff; background-color: #337ab7; border-color: #2e6da4"),
bsModal("dialog", "Select your model", "execute", size = "large",
##although target for modal appear is 'execute' button, but it only appears conditionally as many times as loop contains 'modal appear' remark
selectInput("metric", "Select Metric", choices = c("A", "B","C", "D", "E"),selected = "A"),
tags$div(id="Selected",class='shiny-input-radiogroup',DT::dataTableOutput("metric_table")),
tags$head(tags$style("#dialog .modal-footer{ display:none}")),
actionButton('select_model', 'Select Model',style="color: #fff; background-color: #337ab7; border-color: #2e6da4")
)
),
server = function(input, output, session) {
observeEvent(input$execute,{
for( id in 1:nrow(loop)) { #when clicking 'execute', it runs in the loop sequentially
#if loop remark in NULL, then dont show modal dialog, continue execute with new value = value + loop id
# if(loop$remark[id] =='') {
# loop$value[id] <- loop$value[id]+id
# }
#if remark in loop is 'modal appear', then only modal box appear, execution halts, user select which value to update,
#then after which execution continues in the loop. Again a 2nd modal box appears when loop reaches another 'modal appear' row, same goes on..
#here value = user selected value using radio button.
if(loop$remark[id] == 'modal appear') {
output$metric_table = DT::renderDataTable({
m <- m %>% dplyr::select(Model, input$metric) %>% cbind('Selected' =3)
for (i in seq_len(nrow(m))) {
m[i, 3] = sprintf(
if_else(i == 1,
'<input type="radio" name="%s" value="%s" checked="checked"/>',
'<input type="radio" name="%s" value="%s"/>'),
"Selected", i
)
}
m
}, escape = FALSE, selection = 'none', server = FALSE,
options = list(dom = 't', paging = FALSE, ordering = FALSE)
)
#loop$value[id] <- input$Selected
}
}
})
}
)
Here the modal box is attached to the button execute , however, if the loop does not contain certain text (in this case 'modal appear') then the dialog box does not appear. If any row in the loop contains this text, then, a dialog box appears to ask the user to update the value (the model execution halts). when users update the value, model execution continues. For each row in the loop, it checks for the text ( 'modal appear') and halts execution until the user selects an option. So the modal dialog box should appear 2 times in this example.