Enable disable input RShiny - r

I have RShiny code, with which i want to disable/enable number input with checkbox. However, it works only for disable.
library(shiny)
runApp(shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
numericInput("test", "Test", 5),
checkboxInput("submit", label="Choose")
),
server = function(input, output, session) {
observeEvent(input$submit, {
shinyjs::disable("test")
})
}
))
How could I fix that?

Your code is mostly correct. The bug is in what you are observing. Your code would work fine if you are using an action button. But for the checkbox, you need to disable the input when the checkbox is unchecked, and enable when checked, and not just observe the event.
library(shiny)
runApp(shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
numericInput("test", "Test", 5),
checkboxInput("submit", label="Choose")
),
server = function(input, output, session) {
observeEvent(input$submit, {
if(input$submit == F){
shinyjs::disable("test")
} else {
shinyjs::enable("test")
}
})
}
))

Related

How to selective change modal backdrop in R Shiny

I have two modals. When the first is opened, the background should be grayed out, as is default. But this should not happen with the second one. The code is:
library(shiny)
ui <- fluidPage(
tags$style(type = 'text/css', '.modal-backdrop { display: none }'),
actionButton('modal1', 'Modal1'),
actionButton('modal2', 'Modal2'),
)
server <- function(input, output) {
observeEvent(input$modal1,
showModal(modalDialog(title = "Modal1"))
)
observeEvent(input$modal2,
showModal(modalDialog(title = "Modal2"))
)
}
shinyApp(ui = ui, server = server)
The css code should be connected to the id of the second modal dialog, but it is not possible to include an id in the function 'modalDialog'.
Any ideas about how to apply the css code selectively to only the second modal?
You can add JS code to hide the backdrop after showing the second modal using tags$script just after modalDialog.
library(shiny)
ui <- fluidPage(
actionButton('modal1', 'Modal1'),
actionButton('modal2', 'Modal2'),
)
server <- function(input, output) {
observeEvent(input$modal1,
showModal(modalDialog(title = "Modal1"))
)
observeEvent(input$modal2, {
showModal(
list(
modalDialog(title = "Modal2"),
tags$script("$('.modal-backdrop').css('display', 'none');")
)
)
})
}
shinyApp(ui = ui, server = server)

how to use a button to change pages in an R shiny app

I am trying to use a button to change pages in a shiny app. I have found examples like this one that seem pretty straight forward but for some reason I am not able to make it work. Below is a reproducible example I created in an app.R file. This creates a two page app with a button on the first page but clicking the button does not move you to the second page. Any tips would be greatly appreciated.
pageButtonUi <- function(id) {
actionButton(NS(id, "page_change"),
label="Change the Page")
}
pageButtonServer <- function(id) {
moduleServer(id, function(input, output, session) {
observeEvent(input$page_change, {
updateNavbarPage(session=session,
inputId="pages",
selected="second_page")
})
})
}
ui <- navbarPage(
title="test",
id="pages",
tabPanel(title="first page",
sidebarLayout(
sidebarPanel(
pageButtonUi("page")
),
mainPanel(
)
)
),
tabPanel(title="second_page", "second_page")
)
server <- function(input, output, session) {
pageButtonServer("page")
}
shinyApp(ui, server)
You are using shiny modules. The tabPanel is defined in the top-level UI, but your are trying to use a lower-level (module) server to update the top-level UI. This will not work. So you need to use top-level server to update top-level UI. In other words, you need to pass the parent session object to your module.
This is how to fix:
library(shiny)
pageButtonUi <- function(id) {
actionButton(NS(id, "page_change"),
label="Change the Page")
}
pageButtonServer <- function(id, parentSession) {
moduleServer(id, function(input, output, session) {
observeEvent(input$page_change, {
updateNavbarPage(session=parentSession,
inputId="pages",
selected="second_page")
})
})
}
ui <- navbarPage(
title="test",
id="pages",
tabPanel(title="first page",
sidebarLayout(
sidebarPanel(
pageButtonUi("page")
),
mainPanel(
)
)
),
tabPanel(title="second_page", "second_page")
)
server <- function(input, output, session) {
pageButtonServer("page", parentSession = session)
}
shinyApp(ui, server)
This is not easy to understand even for advanced users. Try to read Rstudio articles see how they define session will be helpful.

Server Code working with Javascript in Shiny

I want to understand how we can interact server section of code with pure JS (or Jquery). I prepared two examples - Basically I want to hide h4( ) on clicking of button by user. First example works as expected but second one does not work as h4() is in renderUI( ) in server. I know this can be solved via observeEvent or shinyJS package but I am more interested to make it work with pure JS not running JS code in server.
Example 1
library(shiny)
ui <- fluidPage(
fluidRow(
h4("Testing"),
actionButton("Disable", "Disable Element"),
tags$script("
$(document).ready(function() {
$('#Disable').click(function(){
$('h4').css('display', 'none');
});
})")
)
)
shinyApp(ui, server = function(input, output) { })
Example 2
ui <- fluidPage(
fluidRow(
h4("Testing"),
uiOutput("myfun"),
tags$script("
$(document).ready(function() {
$('#Disable').click(function(){
$('h4').css('display', 'none');
});
})")
)
)
shinyApp(ui, server = function(input, output) {
output$myfun <- renderUI({
tagList(
actionButton("Disable", "Disable Element")
)
})
})
One option is to add an onclick event to the button itself.
ui <- fluidPage(
fluidRow(
h4("Testing"),
uiOutput("myfun"),
tags$script("hideH4 = function() {$('h4').css('display', 'none');}")
)
)
shinyApp(ui, server = function(input, output) {
output$myfun <- renderUI({
tagList(
actionButton("Disable", "Disable Element", onclick="hideH4()")
)
})
})
Or add a document event hadler for the click and check the ID
ui <- fluidPage(
fluidRow(
h4("Testing"),
uiOutput("myfun"),
tags$script("
$(document).click(function(evt) {
if (evt.target.id=='Disable') {
$('h4').css('display', 'none');
}})")
)
)
shinyApp(ui, server = function(input, output) {
output$myfun <- renderUI({
tagList(
actionButton("Disable", "Disable Element")
)
})
})

Using the "click" function to programatically launch R shiny Action Button

I recently came across the click() function and want to incorporate this in to my app.
https://www.rdocumentation.org/packages/shinyjs/versions/1.1/topics/click
However attempting to run the given example:
if (interactive()) {
library(shiny)
library(shinyjs)
shinyApp(
ui = fluidPage(
useShinyjs(), # Set up shinyjs
"Count:", textOutput("number", inline = TRUE), br(),
actionButton("btn", "Click me"), br(),
"The button will be pressed automatically every 3 seconds"
),
server = function(input, output) {
output$number <- renderText({
input$btn
})
observe({
click("btn")
invalidateLater(3000)
})
}
)
}
# }
Did not give the desired behaviour. It appears no auto-clicking is taking place! Can anybody explain? Thanks in advance.

Uncheck box but be able to recheck R Shiny

In a shiny app I'm developing there is a check box I want to reset to off when I click an action button. I've found code that unchecks the box when I click the button but then the button stays permanently unchecked and I'm not able to recheck it. Does anyone have any idea how I can uncheck the box after pressing the button while maintaining the capability of checking the box?
Here are some attempts I've already tried that run into the issue discussed above:
ui <- fluidPage(
# Application title
titlePanel("Preflop Trainer"),
sidebarLayout(
sidebarPanel(
checkboxInput("checkbox",
"Check Box"),
actionButton("reset",
"Reset the box")
)
)
server <- function(input, output,session) {
#I tried this
if (input$reset) {
if (input$reset != number) {
updateCheckboxInput(session,"checkbox","Check Box",value = F)
}
number <- input$reset
}
#And I've tried this
observeEvent(input$reset, {
updateCheckboxInput(session,"checkbox","Check Box",value = F)
}
}
Please try again. After correcting some bracket issues, this works for me:
library(shiny)
ui <- fluidPage(
# Application title
titlePanel("Preflop Trainer"),
sidebarLayout(mainPanel =
mainPanel(),
sidebarPanel =
sidebarPanel(
checkboxInput("checkbox",
"Check Box"),
actionButton("reset",
"Reset the box")
)
)
)
server <- function(input, output,session) {
#this works for me
observeEvent(input$reset, {
updateCheckboxInput(session, "checkbox", "Check Box", value = F)
}
)
}
shinyApp(ui, server)

Resources