R Shiny - Disable/Able Shinyui Elements

How to disable edit option for displayed values in shiny?

Ok, I think I got what you want to do. You need to store the values in either a reactive "variable" or in reactive values (that both can listen to input changes). The following examples shows both options and also that you can work with these for later.

library(shiny)

ui <- fluidPage(
column(6,
tags$h2("Allow the user to change only here"),
numericInput("valueA", "Value1", value = .333, min = 0, max = 1, step = .1),
numericInput("valueB", "Value2", value = .333, min = 0, max = 1, step = .1),
numericInput("valueC", "Value3", value = .333, min = 0, max = 1, step = .1),
verbatimTextOutput("result")
),
column(6,
uiOutput("ui1"),
tags$hr(),
uiOutput("ui2"),
tags$hr(),
tags$h3("Obs1 * 2"),
verbatimTextOutput("obs1")
)
)

server <- function(input, output, session) {

### reactive "variables"
obs1 <- reactive({
as.numeric(100 * (input$valueA / (input$valueA + input$valueB + input$valueC)))
})
obs2 <- reactive({
as.numeric(100 * (input$valueB / (input$valueA + input$valueB + input$valueC)))
})
obs3 <- reactive({
as.numeric(100 * (input$valueC / (input$valueA + input$valueB + input$valueC)))
})
### or as reative values which I like more
# create
obs <- reactiveValues(obs1 = NULL,
obs2 = NULL,
obs3 = NULL)
# listen to changes
observe({
obs$obs1 <- as.numeric(100 * (input$valueA / (input$valueA + input$valueB + input$valueC)))
obs$obs2 <- as.numeric(100 * (input$valueB / (input$valueA + input$valueB + input$valueC)))
obs$obs3 <- as.numeric(100 * (input$valueC / (input$valueA + input$valueB + input$valueC)))
})

### render ui of reactives variable
# ! note the function notation of obs1() to obs3()
output$ui1 <- renderUI( {
tagList(
tags$h3("Display in % but dont allow user to change here"),
renderText( obs1() ),
renderText( obs2() ),
renderText( obs3() )
)
})

### render ui of reactive values
# ! note: variable called as a normal list
output$ui2 <- renderUI( {
tagList(
tags$h3("Display in % but dont allow user to change here"),
renderText( obs$obs1 ),
renderText( obs$obs2 ),
renderText( obs$obs3 )
)
})

### Code to use the values from obs1,obs2,obs3....
output$obs1<- renderText(obs$obs1 * 2)
}

shinyApp(ui, server)

shiny disable tables in a specific navlistPanel

You can not use both the arguments id and selector in disable, see the documentation for the function here:

id The id of the input element/Shiny tag

selector Query selector of
the elements to target. Ignored if the id argument is given. For
example, to disable all text inputs, use selector =
"input[type='text']"

What you could do however, is change your selector to '#inTabset1 li a', so it will disable all elements of class a that are in an element class li that are in the element with id inTabset1.

Here is a working example, I hope this helps!

library(shiny)
library(shinyjs)

ui <- fluidPage(
useShinyjs(),
navlistPanel(id = "inTabset1",
tabPanel(title = "Panel 1", value = "panel1",
actionButton('jumpToP2', 'Jump to Second Tab')),
tabPanel(title = "Panel 2", value = "panel2",
actionButton('jumpToP1', 'Jump to First Tab'))),
# tags$head(tags$style(HTML('.navbar-nav a {cursor: default}')))),
navlistPanel(id = "inTabset2",
tabPanel(title = "Panel 3", value = "panel3",
actionButton('jumpToP3', 'Jump to fouth Tab')),
tabPanel(title = "Panel 4", value = "panel4",
actionButton('jumpToP4', 'Jump to third Tab'))
# tags$head(tags$style(HTML('.navbar-nav a {cursor: default}')))))

)
)

server <- function(input, output, session) {

# shinyjs::disable(selector = '.navbar-nav a'
shinyjs::disable(
selector = '#inTabset1 li a'
)

observeEvent(input$jumpToP2, {
updateTabsetPanel(session, "inTabset1",
selected = "panel2")
})

observeEvent(input$jumpToP1, {
updateTabsetPanel(session, "inTabset1",
selected = "panel1")
})

observeEvent(input$jumpToP3, {
updateTabsetPanel(session, "inTabset2",
selected = "panel4")
})

observeEvent(input$jumpToP4, {
updateTabsetPanel(session, "inTabset2",
selected = "panel3")
})}

shinyApp(ui, server)

Disable button as long as the email address is not correct R Shiny

Simple example for others:

library(shiny)
library(shinyjs)

ui <- fluidPage(
useShinyjs(),
textInput('mail', 'mail'),
actionButton("send", "send")
)

server <- function(input, output) {
observe({
#if(is.null(input$zip) || input$zip == ""){
# disable("send")
#} else if(is.null(input$indice) || input$indice == ""){
# disable("send")
#} else
if(!grepl("\\<[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\\.[a-zA-Z]{2,}\\>", input$mail)){
disable("send")
}
else{
enable("send")
}
})
}

shinyApp(ui, server)

Disable SwitchInput blue glow in Shiny app

Add the following CSS tag to your UI.r file or UI section of your Shiny app:

tags$head(tags$style(HTML('.bootstrap-switch.bootstrap-switch-focused {
-webkit-box-shadow: none;
border-color: #CCCCCC;
box-shadow: none;
outline: none;
}'))),

This will disable the blue glow and change the outline color to gray.

How to prevent user from doing anything on shiny app when app is busy

After analyzing yours answers and think more about it, I think I found the simpliest solution.

On "shiny busy" event, I display a div in the conditional panel which is 100% of the screen and on first plan, so it prevents any click on the inputs / outputs behind it. When the app is not busy anymore, the panel disappear. The panel is transparent so the user doesn't see it.

Also, it enables me to disable all inputs and output without being dependant of a timer, only on if the app is busy or not.

library(shiny)

ui <- fluidPage(

# spinner css
tags$head(
tags$style(HTML("
#loadmessage {
position:fixed; z-index:8; top:50%; left:50%; padding:10px;
text-align:center; font-weight:bold; color:#000000; background-color:#CCFF66;
}

.loader {
position:fixed; z-index:8; border:16px solid #999999;
border-top: 16px solid #8B0000; border-radius: 50%;
width: 120px; height: 120px; top:45%; left:45%;
animation: spin 2s linear infinite;
}

.prevent_click{
position:fixed;
z-index:9;
width:100%;
height:100vh;
background-color: transpare'nt;
}

@keyframes spin {
0% { transform: rotate(0deg); }
100% { transform: rotate(360deg); }
}"))
),

# display load spinner when shiny is busy
conditionalPanel(
condition = "$(\'html\').hasClass(\'shiny-busy\')",
tags$div(class = "loader"),
tags$div(class = "prevent_click")
),
actionButton(
inputId = "increment",
label = "Increment"
),
textOutput("result"),
actionButton(
inputId = "busy",
label = "Busy app"
)
)

server <- function(input, output, session) {

rv <- reactiveValues(counter = 0)

#increment counter
observeEvent(input$increment,{
rv$counter = rv$counter + 1
})

#display incremented counter
output$result <- renderText({
rv$counter
})

observeEvent(input$busy, {
Sys.sleep(5)
# during this time, the user should not be able to do anything on the app
})
}

shinyApp(ui = ui, server = server)

Disable selectinput once user selected multiple choices in R shiny

In the current setup you don't actually know when user has finished the selection.

Consider various scenarios -

  • If you disable after 1st selection then user cannot select 2 or 3 values.
  • If you disable after 2nd selection then user cannot select 3 values.
  • If you disable after 3rd then what if user only want to select 1 value ?

You'll never know when to disable based on length of values. I think a better option would be to provide an actionButton for user to submit after they are done with their selection.

library(shiny)
library(shinyjs)

ui <- fluidPage(
br(),
useShinyjs(),
fluidRow(
column(
width = 6,
selectInput(inputId = "check1", label = "Choose",
choices = c("choice A","choice B","choice C"), multiple = T),
verbatimTextOutput(outputId = "res1"),
actionButton('submit', 'Done')
)
)
)
server <- function(input, output, session) {

flag_lifecycle <- reactiveValues(val = "Yes")

output$res1 <- renderPrint({
input$check1
})

observeEvent(input$submit, {
shinyjs::disable("check1")
})

}
shinyApp(ui = ui, server = server)

Sample Image

Shiny - elements are not being rendered once function is complete

What you are describing is the expected behaviour. The server will not return anything to the UI before all calculations are finished.

I see you are relying a lot on renderUI. This tends to make the Shiny app slow. When the app starts, it must load, realize that it lacks a portion of the UI, ask the server to create the UI - then the server will create the HTML for all of your boxes and send them to the UI before anything is shown. You should try to keep as much as possible of the UI static.

Dependent on what you want to achieve there are probably a lot of different ways of doing it without renderUI.

Under is an example where the HTML for the boxes are created outside of renderUI. This will work, as long as you don't need input controls or outputs in the boxes - because then they need their own ID.



library(shiny)
library(shinydashboard)
library(dplyr)
library(purrr)

qtd <- 500

my_dataset <- data.frame(
stringsAsFactors = FALSE,
Name = rep('Sample', qtd),
Value = runif(qtd)
) %>%
mutate(
x = map2(
Name,
Value,
~column(
width = 3,
box(
width = 3,
title = .x,
.y
)
)
)
)

ui <- function() {
fluidPage(
fluidRow(
column(
12,
textInput(
inputId = 'my_text_input',
label = NULL,
placeholder = 'Search',
width = '100%'
)
),
uiOutput('custom_ui')
)
)
}

server <- function(input, output, session) {

# Only the filtering of the data is done inside `renderUI`
output[['custom_ui']] <- renderUI({

filtered_dataset <-
my_dataset %>%
filter(grepl(input[['my_text_input']], Name, ignore.case = TRUE)) %>%
arrange(Name) %>%
pull(x)

})

}

runApp(shinyApp(ui = ui, server = server), launch.browser = TRUE)



Last I just want to recommend this book by Hadley Wickham. I think reading this (or parts of this) book before working with Shiny will make everything easier for you.



Related Topics



Leave a reply



Submit