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)

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")
})
}

Embedded inputs in R Shiny Datatable - javascript issue

I have an R/Shiny app containing a datatable from the DT package.
Following this thread render dropdown for single column in DT shiny, I've been able to embed action buttons into a column in my datatable, which trigger a set of corresponding observers.
However, when the datatable is paginated, my action buttons will only function correctly for those buttons on the first page. Buttons on subsequent pages don't work. This remains the case even if I reorder the data using column sorting, as any buttons which were on page 2+ as of the initial render will not work even if they are reordered onto page 1.
I expect the problem is in how the callback argument is using javascript (which is unfortunately over my head) to render the action buttons correctly. Can anyone advise how to get the action buttons working on subsequent pages?
Here is my minimal reprex, using mtcars data:
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("reprex1")
,fluidRow(
dataTableOutput("dt1")
)
)
server <- function(input, output) {
output$dt1 <- renderDataTable({
mtlocal <- mtcars
for(n in 1:nrow(mtlocal)){
mtlocal$actionbutton[[n]] <- as.character(
actionButton(
paste0("buttonpress",n), label = paste0("buttonpress",n)
)
)
}
datatable(
mtlocal
,escape = FALSE
,selection = "none"
,callback = JS("table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-container');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)
}, server = FALSE)
lapply(
1:nrow(mtcars),function(x){
observeEvent(
input[[paste0("buttonpress",x)]],{
showModal(
modalDialog(
h2(paste0("You clicked on button ",x,"!"))
)
)
}
)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)

The callback is executed only once, and then Shiny.bind/unbind is lost when the table is redrawn. You have to use the options preDrawCallback and drawCallback:
datatable(
mtlocal
, escape = FALSE
, selection = "none"
, options = list(
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
)
)

Display Text only on hover

I'm working on a shiny app in which I only want to want textouput on hover or mouse over action
I tried adding an action button
UI:
fluidRow(box (title = p("Rates by Gender and Race", actionButton("titleBtId", "", icon=icon('question-circle'),class = "btn-xs", title = "Info"),textOutput("text_id"),hover=T), width = 15, status = 'primary', solidHeader = TRUE,tabPanel('',plotlyOutput("racegender",height = "100%"))%>% withSpinner(color="#0dc5c1")))
Server:
output$text_id <- renderText({
paste0("hi")
})
I'm not sure how would I edit it to only display text on hover

An alternative to modal popups, depending on what user experience you want, is to use tooltips from the shinyBS package, which has functions for subtle but effective popups and tooltips. Here is an example of the different functionality of hovering or clicking, and putting the tooltips in the UI or in the server, with equivalent experience. Note that theoretically you could put a hover tooltip in the UI using tipify(), but for some reason this doesn't seem to be working with actionButtons though it continues to work for other input elements.
library(shiny)
library(shinyBS)
ui <- fluidPage(
titlePanel("ShinyBS tooltips"),
actionButton("btn", "On hover"),
tipify(actionButton("btn2", "On click"), "Hello again! This is a click-able pop-up", placement="bottom", trigger = "click")
)
server <- function(input, output, session) {
addTooltip(session=session,id="btn",title="Hello! This is a hover pop-up. You'll have to click to see the next one.")
}
shinyApp(ui, server)

Got it working using ModalDialog
UI
fluidRow(
box (title = p("Rates by Gender and Race", tags$head( tags$style(HTML('#titleBtId{background-color:black}'))), actionButton("titleBtId", "", icon=icon('question-circle'),class = "btn-xs", title = "Info"),hover=T), width = 15, status = 'primary', solidHeader = TRUE, tabPanel('',plotlyOutput("racegender",height = "100%"))%>% withSpinner(color="#0dc5c1")))
Server:
observeEvent(input$titleBtId, {
showModal(modalDialog(
title = "Note",
"This chart if independent of Date-range and Age-range selections",
easyClose = TRUE
))
})

update column visibility in DT::datatable while using DT::replaceData

Is there a way (other than a 'colvis' button) to dynamically update which columns are visible in a DT::datatabe while using the DT::replaceData to update the table?
(The reason I can not use the 'colvis' button (as shown here:https://rstudio.github.io/DT/extensions.html) is I need to have a few different short cut convenient buttons that hide and show multiple complex patterns at once.)
This is an example of how I would initiate my app. Is there a way in js or the server-side to hide and show columns? Thanks!
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
fluidRow(
column(2, actionButton('refresh', 'Refresh Data', icon = icon('refresh'))),
column(10, DT::dataTableOutput('foo'))
)
),
server = function(input, output, session) {
df = iris
n = nrow(df)
df$ID = seq_len(n)
loopData = reactive({
input$refresh
df$ID <<- c(df$ID[n], df$ID[-n])
df
})
output$foo = DT::renderDataTable(isolate(DT::datatable(loopData(),
options = list(
columnDefs = list(list(visible=FALSE,targets=c(0,1,2))))
)))
proxy = dataTableProxy('foo')
observe({
replaceData(proxy, loopData(), resetPaging = FALSE)
})
}
)