We Keep Coding

How to hide a conditional panel using js in R Shiny when any action or other button is clicked other than specified inputs?

I am trying to hide the conditional panel illustrated below when there is any user input other than the user clicking on the action button "Delete" or making a selection in the selectInput() function rendered in the conditional panel, as shown in the below image. Other user inputs will be added (action buttons, radio buttons, selectInputs, etc.) so it isn't feasible to list each action that causes the conditional panel to hide. That conditional panel should always render upon the click of "Delete". Any suggestions for how to do this? Code is shown at the bottom.
Code:
library(rhandsontable)
library(shiny)
mydata <- data.frame('Col 1' = c(1,24,0,1), check.names = FALSE)
rownames(mydata) <- c('Term A','Term B','Term C','Term D')
ui <- fluidPage(br(),
rHandsontableOutput("mytable"),br(),
fluidRow(
column(1,actionButton("addCol", "Add",width = '70px')),
column(1,actionButton("delCol","Delete",width = '70px')),
column(3,conditionalPanel(condition = "input.delCol",uiOutput("delCol"))) # js here
)
)
server <- function(input, output) {
output$mytable = renderRHandsontable(df())
df <- eventReactive(input$addCol, {
if(input$addCol > 0){
newcol <- data.frame(mydata[,1])
names(newcol) <- paste("Col",ncol(mydata)+1)
mydata <<- cbind(mydata, newcol)
}
rhandsontable(mydata,rowHeaderWidth = 100, useTypes = TRUE)
}, ignoreNULL = FALSE)
observeEvent(input$delCol,
{output$delCol<-renderUI(selectInput("delCol",label=NULL,choices=colnames(mydata),selected="Col 1"))}
)
}
shinyApp(ui,server)

Per Mike´s comment I started with shinyjs and this simple example from the shinyjs reference manual, with minor modification for 2 buttons:
library(shiny)
library(shinyjs)
ui = fluidPage(
useShinyjs(), # Set up shinyjs
actionButton("btn", "Click to show"),
actionButton("btn1","Click to hide"),
hidden(p(id = "element", "I was invisible"))
)
server = function(input, output) {
observeEvent(input$btn, {show("element")})
observeEvent(input$btn1,{hide("element")})
}
shinyApp(ui,server)
Then I expanded it to my code in the OP per the below. Note that this will still require an observeEvent() for each user action that triggers selectInput() to hide instead of a global hide every time there's any user input other than a click of "Delete" action button. I'm not sure this is possible but will continue researching. Multiple observeEvents() won't be too bad of an option in any case.
Resolving code:
library(rhandsontable)
library(shiny)
library(shinyjs)
mydata <- data.frame('Col 1' = c(1,24,0,1), check.names = FALSE)
rownames(mydata) <- c('Term A','Term B','Term C','Term D')
ui <- fluidPage(
useShinyjs(), # set up shinyjs
br(),
rHandsontableOutput("mytable"),br(),
fluidRow(
column(1,actionButton("addCol", "Add",width = '70px')),
column(1,actionButton("delCol","Delete",width = '70px')),
column(3, hidden(uiOutput("delCol2")))) # hide selectInput()
)
server <- function(input,output,session){
output$mytable = renderRHandsontable(dat())
dat <- eventReactive(input$addCol, {
if(input$addCol > 0){
newcol <- data.frame(mydata[,1])
names(newcol) <- paste("Col",ncol(mydata)+1)
mydata <<- cbind(mydata, newcol)
}
rhandsontable(mydata,rowHeaderWidth = 100, useTypes = TRUE)
}, ignoreNULL = FALSE)
observeEvent(input$delCol, show("delCol2")) # clicking Delete button reveals selectInput()
observeEvent(input$addCol, hide("delCol2")) # clicking Add hides selectInput()
output$delCol2 <-renderUI({
selectInput(
"delCol3",
label=NULL,
choices=colnames(mydata),
selected="Col 1"
)
})
}
shinyApp(ui,server)

Set an alert when all boxes are closed or collapsed in shinydashboardPlus

I have a shinydashboard with 10 boxes, and which can be closed or collapsed. All the box id starts with "box". I was trying set an alert button when all boxes are closed or collapsed.
Below is the code of the dashboard:
library(shiny)
library(shinydashboardPlus)
box_create <- function(i){
shinydashboardPlus::box(tags$p(paste0("Box",i)),
id = paste0("box", i),
closable = TRUE,
collapsible = TRUE)
}
all_box <- purrr::map(1:10, ~box_create(.x))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
all_box
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
I have noticed on pressing close or collapse button shiny sets the display = 'none' for that box.
So is it possible to extract all styles associated with the id which starts with 'box' and check if all the style property sets as 'none' using jQuery?

Using shinydashboardPlus's dev version you can access the box state via it's id (pattern: input$mybox$collapsed).
Please see this related article.
Install it via devtools::install_github("RinteRface/shinydashboardPlus")
library(shiny)
library(tools)
library(shinydashboard)
library(shinydashboardPlus)
box_ids <- paste0("box", 1:10)
box_create <- function(box_id){
shinydashboardPlus::box(tags$p(toTitleCase(box_id)),
id = box_id,
closable = TRUE,
collapsible = TRUE)
}
all_boxes <- lapply(box_ids, box_create)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
all_boxes
)
)
server <- function(input, output, session) {
observe({
if(all(sapply(box_ids, function(box_id){input[[box_id]]$collapsed}))){
showModal(modalDialog("All boxes are collapsed!"))
}
})
# observe({
# print(paste("Is box1 collapsed?", input$box1$collapsed))
# })
}
shinyApp(ui, server)

I thought you wanted a button when all were collapsed OR all were closed. Here is a solution for that.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
box_create <- function(i){
shinydashboardPlus::box(tags$p(paste0("Box",i)),
id = paste0("box", i),
closable = TRUE,
collapsible = TRUE)
}
all_box <- purrr::map(1:10, ~box_create(.x))
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
all_box,
div(id = "alert_button")
)
)
server <- function(input, output, session) {
observe({
boxes <- paste0("box", 1:10)
visible_status <- sapply(boxes, \(x) input[[x]]$visible)
collapsed_status <- sapply(boxes, \(x) input[[x]]$collapsed)
if (!any(visible_status) || all(collapsed_status)) {
insertUI(
selector = "#alert_button",
ui = div(id = "added", actionButton("btn","all hidden OR all collapsed"))
)
} else {
removeUI(selector = "#added")
}
})
}
shinyApp(ui, server)

How to enable/disable specific radiogroupbuttons in shiny, shinyjs, shinywidget [duplicate]

I have a below shiny code, I am trying to disable single radio button choice from grouped radio buttons.
I can disable complete radio button using shinyjs::disable() function. But, having trouble disabling single choice.
library(shiny)
library(shinyjs)
library(shinyWidgets)
if (interactive()) {
ui <- fluidPage(
useShinyjs(),
radioGroupButtons(inputId = "somevalue", choices = c("A", "B", "C")),
verbatimTextOutput("value")
)
server <- function(input, output) {
output$value <- renderText({ input$somevalue })
shinyjs::disable(id="somevalue")
}
shinyApp(ui, server)
}

You can do
runjs("$('input[value=B]').parent().attr('disabled', true);")
or
runjs('$("#somevalue button:eq(1)").attr("disabled", true);')
or
disable(selector = "#somevalue button:eq(1)")

In R Shiny, how to maintain reactivity chain when an object in the chain is hidden from view?

In the MWE code below, user inputs into the first matrix (firstInput is the name of the custom function that invokes the first matrix) are fed into a second matrix (secondInput) that the user can optionally input into, and the results of secondInput are fed into the output plot. (This link between the 2 matrices may sound absurd, but in the more complete code this is extracted from, inputs into the second matrix go through extra/intrapolations; in the spirit of MWE I removed that functionality).
In running this you can see that the user can click action button "Show" to see that 2nd matrix, since those inputs are optional.
My issue is reactivity. Currently as drafted, if the user makes a change to the value in the first matrix without showing the second matrix, then those changes are not reactively reflected in the plot. I would like data to flow through the reactivity chain even when the 2nd matrix is hidden. Is there a workaround, a simple other way, to "skin this cat"?
MWE code:
rm(list = ls())
library(shiny)
library(shinyMatrix)
library(shinyjs)
firstInput <- function(inputId){
matrixInput(inputId,
value = matrix(c(5), 1, 1, dimnames = list(c("1st input"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
secondInput <- function(inputId,x){
matrixInput(inputId,
value = matrix(c(x), 1, 1, dimnames = list(c("2nd input"),NULL)),
rows = list(extend = FALSE, names = TRUE),
cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
class = "numeric")}
ui <- fluidPage(
titlePanel("Model"),
sidebarLayout(
sidebarPanel(
uiOutput("panel"),
hidden(uiOutput("secondInput")) # <<< remove "hidden" and reactivity is restored
),
mainPanel(plotOutput("plot1"))
)
)
server <- function(input, output) {
input1 <- reactive(input$input1)
input2 <- reactive(input$input2)
output$panel <- renderUI({
tagList(
useShinyjs(),
firstInput("input1"),
actionButton('show','Show 2nd inputs'),
actionButton('hide','Hide 2nd inputs'))
})
output$secondInput <- renderUI({
req(input1())
secondInput("input2",input$input1[1,1])
})
output$plot1 <-renderPlot({
req(input2())
plot(rep(input2(),times=5))
})
observeEvent(input$show,{shinyjs::show("secondInput")})
observeEvent(input$hide,{shinyjs::hide("secondInput")})
}
shinyApp(ui, server)

You can do:
output$secondInput <- renderUI({
req(input1())
secondInput("input2",input$input1[1,1])
})
outputOptions(output, "secondInput", suspendWhenHidden = FALSE)
EDIT
Another possibility is to use the CSS property visibility: hidden to hide the second input, instead of shinyjs::hidden (which sets the CSS property display: none). With this property, the second input is not visible but it takes up some space, it is not "strictly hidden".
ui <- fluidPage(
useShinyjs(),
tags$head(
tags$style(HTML(".Hidden {visibility: hidden;}"))
),
titlePanel("Model"),
sidebarLayout(
sidebarPanel(
uiOutput("panel"),
div(
id = "secondInputContainer",
class = "Hidden",
uiOutput("secondInput")
)
),
mainPanel(plotOutput("plot1"))
)
)
server <- function(input, output) {
# input1 <- reactive(input$input1) useless
# input2 <- reactive(input$input2) useless
output$panel <- renderUI({
tagList(
firstInput("input1"),
actionButton('show', 'Show 2nd inputs'),
actionButton('hide', 'Hide 2nd inputs'))
})
output$secondInput <- renderUI({
req(input$input1)
secondInput("input2", input$input1[1,1])
})
output$plot1 <-renderPlot({
req(input$input2)
plot(rep(input$input2, times=5))
})
observeEvent(input$show, {
removeCssClass("secondInputContainer", "Hidden")
})
observeEvent(input$hide, {
addCssClass("secondInputContainer", "Hidden")
})
}

r introjs bsModal

I am trying to highlight elements of my bsModal with the r wrapper for intro.js, however cannot get it to work. I have also tried to include custom js scripts, but my js is terrible.
I have also set up multiple different tests hoping it would snag onto something, however it seem like intro.js cannot find the modal's div or any any of the of the elements inside it. I am using rintrojs
Here are some example of people getting it to work in javascript:
https://github.com/usablica/intro.js/issues/302
How do I fire a modal for the next step in my introjs?
But I personally don't know Javascript well enough to integrate a custom solution myself. I've already tried :(
Here's a link to an example I've hosted with the issue:
https://arun-sharma.shinyapps.io/introjs/
Does anyone know how I can get the following dummy example to work?
library(rintrojs)
library(shiny)
library(shinydashboard)
intro_df <- data.frame(element = c('#plot_box', '#bttn2', '#box', '#modal'),
intro = c('test plot_box', 'test bttn2', 'test box', 'test modal'))
ui <- shinyUI(fluidPage(
introjsUI(),
mainPanel(
bsModal('modal', '', '', uiOutput('plot_box'), size = 'large'),
actionButton("bttn", "Start intro")
)))
server <- shinyServer(function(input, output, session) {
output$plot <- renderPlot({
plot(rnorm(50))
})
output$plot_box <- renderUI({
box(id = 'box',
actionButton('bttn2', 'dummy'),
plotOutput('plot'), width = '100%'
)
})
observeEvent(input$bttn,{
toggleModal(session, 'modal', toggle = 'toggle')
introjs(session, options = list(steps = intro_df))
})
})
shinyApp(ui = ui, server = server)

Ultimately, I think this request could make for some useful features in the rintrojs library. In any case, your problems are two-fold:
introjs should not fire until the modal is available in the HTML. The easiest way to do this is to use a button within the modal to fire the tutorial. If you want it to be automatic, you will need some JavaScript that waits until the Modal is ready before firing.
introjs wants to grey out the background and highlight the current item in the tutorial. This means it needs to "interleave" with the modal children. Because the modal is its own stacking context, introjs needs to be fired from within the modal to look at modal children. If you want to look at the entire modal, then it is sufficient to fire introjs from the parent. This functionality does not seem to be in the rintrojs package yet, but is in the JavaScript library.
In order to accomplish #1, I added a JavaScript function to fire introjs on Modal load (after a configurable delay for HTML elements to load). This requires the shinyjs package. Notice the introJs(modal_id), this ensures that the tutorial fires within the modal. In pure JavaScript, it would be introJs('#modal'):
run_introjs_on_modal_up <- function(
modal_id
, input_data
, wait
) {
runjs(
paste0(
"$('"
, modal_id
, "').on('shown.bs.modal', function(e) {
setTimeout(function(){
introJs('", modal_id, "').addSteps("
, jsonlite::toJSON(input_data, auto_unbox=TRUE)
, ").start()
}, ", wait, ")
})"
)
)
}
I also added a simple helper for closing the introjs tutorial when navigating away from the modal.
introjs_exit <- function(){
runjs("introJs().exit()")
}
There was also a single line of CSS necessary to fix the modal-backdrop from getting over-eager and taking over the DOM:
.modal-backdrop { z-index: -10;}
And a (large / not minimal) working example with multiple modals.
library(rintrojs)
library(shiny)
library(shinydashboard)
library(shinyBS)
library(shinyjs)
intro_df <- data.frame(element = c('#plot_box', '#bttn2', '#box', '#modal'),
intro = c('test plot_box', 'test bttn2', 'test box', 'test modal'))
intro_df2 <- data.frame(element = c('#plot_box2'),
intro = c('test plot_box'))
run_introjs_on_modal_up <- function(
modal_id
, input_data
, wait
) {
runjs(
paste0(
"$('"
, modal_id
, "').on('shown.bs.modal', function(e) {
setTimeout(function(){
introJs('", modal_id, "').addSteps("
, jsonlite::toJSON(input_data, auto_unbox=TRUE)
, ").start()
}, ", wait, ")
})"
)
)
}
introjs_exit <- function(){
runjs("introJs().exit()")
}
ui <- shinyUI(fluidPage(
useShinyjs(),
tags$head(tags$style(".modal-backdrop { z-index: -10;}")),
introjsUI(),
mainPanel(
bsModal('modal', '', '', uiOutput('plot_box'), size = 'large'),
bsModal('modalblah', '', '', uiOutput('plot_box2'), size = 'large'),
actionButton("bttn", "Start intro")
)))
server <- shinyServer(function(input, output, session) {
output$plot <- renderPlot({
plot(rnorm(50))
})
output$plot2 <- renderPlot({
plot(rnorm(50))
})
output$plot_box <- renderUI({
box(id = 'box',
actionButton('bttn2', 'dummy'),
plotOutput('plot'), width = '100%'
)
})
output$plot_box2 <- renderUI({
box(id = 'box2',
plotOutput('plot2'), width = '100%'
)
})
run_introjs_on_modal_up("#modal",intro_df, 1000)
run_introjs_on_modal_up("#modalblah",intro_df2, 1000)
observeEvent(input$bttn,{
toggleModal(session, 'modal', toggle = 'toggle')
})
observeEvent(input$bttn2, {
toggleModal(session, 'modal', toggle = 'toggle')
introjs_exit()
toggleModal(session, 'modalblah', toggle = 'toggle')
})
})
shinyApp(ui = ui, server = server)

I was able to fix the problem by adding
.introjs-fixParent.modal {
z-index:1050 !important;
}
to my CSS.
Working example:
library(rintrojs)
library(shiny)
library(shinydashboard)
library(shinyBS)
library(shinyjs)
intro_df <- data.frame(element = c('#plot_box', '#bttn2_intro', '#box', '#plot', '#shiny-modal'),
intro = c('test plot_box', 'test bttn2', 'test box', 'plot', 'test modal'))
ui <- shinyUI(fluidPage(
dashboardPage(dashboardHeader(title = "Test"),
dashboardSidebar(sidebarMenu(menuItem("item1", tabName = "item1"))),
dashboardBody(tabItems(tabItem("item1", actionButton("bttn", "start intro"))))),
useShinyjs(),
tags$head(tags$style(".introjs-fixParent.modal {
z-index:1050 !important;
}")),
introjsUI()
))
server <- shinyServer(function(input, output, session) {
output$plot <- renderPlot({
plot(rnorm(50))
})
output$plot_box <- renderUI({
box(id = 'box',
div(id = "bttn2_intro", actionButton('bttn2', 'dummy')),
plotOutput('plot'), width = '100%'
)
})
observeEvent(input$bttn,{
showModal(modalDialog(uiOutput('plot_box')))
})
observeEvent(input$bttn2, {
introjs(session, options = list(steps = intro_df))
})
})
shinyApp(ui = ui, server = server)