I am having trouble getting this observeEvent to work properly.
The sliderInput() should only be enabled and accessible if Yes is selected in radioButton()
What am I missing?
library(shiny)
ui <- fluidPage(
radioButtons("EXBR", "External Beam Radiation", choiceValues=list("No","Yes"),
choiceNames=list("No","Yes"), selected ="No", inline=T),
sliderInput("EXBRGy", "Cumulative Gy dosage",
min = 2, max = 60, value = 40)
)
server <- function(input, output, session) {
observeEvent(input$EXBR, {
if((input$EXBR == "Yes")){
disable("EXBRGy")
}else{
enable("EXBRGy")
}
})
}
shinyApp(ui, server)
Before using most shinyjs functions, you need to call useShinyjs() in the app’s ui. It’s best to include it near the top as a convention. Also added library(shinyjs) and removed extra parentheses in the if statement.
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
radioButtons("EXBR", "External Beam Radiation", choiceValues=list("No","Yes"),
choiceNames=list("No","Yes"), selected ="No", inline=T),
sliderInput("EXBRGy", "Cumulative Gy dosage",
min = 2, max = 60, value = 40)
)
server <- function(input, output, session) {
observeEvent(input$EXBR, {
if(input$EXBR == "Yes"){
disable("EXBRGy")
}else{
enable("EXBRGy")
}
})
}
shinyApp(ui, server)
Related
I have a shiny app with a bunch of numeric inputs. Some of them are dependent on the value of others. As an example, let's say that I need input_1 to be changed if the entered input_2 is greater, such that input_1 = input_2 + 1. The problem is that if the user inputs their value too slowly, it takes the first digit of the entered input_2, for instance 5, and makes the input_1 equal to 6, even if you finish typing 540.
Here's an example:
library(shiny)
ui <- fluidPage(
numericInput("input1", "Input 1:", 0),
numericInput("input2", "Input 2:", 0)
)
server <- function(input, output, session) {
observeEvent(input$input2, {
if (input$input2 > input$input1) {
updateNumericInput(session, "input1", value = input$input2 + 1)
}
})
}
shinyApp(ui, server)
I have tried using invalidateLater, or debounce, but I believe I haven't done it correctly since the output still changes almost immediately. Ideally it would only update once focus is lost, but I don't want to add js to my code. So having a fixed timer to update seems like a good middle ground. Any ideas?
As you have already mentioned debounce is the right way to go:
library(shiny)
ui <- fluidPage(
numericInput("input1", "Input 1:", 0),
numericInput("input2", "Input 2:", 0)
)
server <- function(input, output, session) {
input2_d <- debounce(reactive({input$input2}), 1000L)
observeEvent(input2_d(), {
if (input2_d() > input$input1) {
updateNumericInput(session, "input1", value = input2_d() + 1)
}
})
}
shinyApp(ui, server)
Here's an example using the delay function from the shinyjs package:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(), # call for shinyjs to be used in the ui part of the dashboard
numericInput("value1",
"Value 1:",
value = 40),
numericInput("value2",
"Value 2:",
value = 50)
)
server <- function(input, output, session) {
observeEvent(input$value1, {
if (input$value1 > input$value2) {
delay(2000, # the delay in milliseconds that is imposed
updateNumericInput(session = session, "value2", value = input$value1 + 1))
}
})
}
shinyApp(ui, server)
In the event that value1 should be greater than value2, after 2 sec., value2 will be updated to be equal to 1 + value1.
I am trying to increase and decrease the number of UI elements based on user input. This MRE code kind of works but it is leaving behind the UI label when I use removeUI, which I did not expect. Any ideas on how to make the label go away along with the input box?
## Only run this example in interactive R sessions
if (interactive()) {
# Define UI
ui <- fluidPage(
numericInput(inputId = "assessors",label = "Number of Assessors",value = 1,min = 1,step = 1),
textInput(inputId = "assessor1",label = "Assessor 1 Columns")
)
# Server logic
server <- function(input, output, session) {
tot_app<-0
observeEvent(input$assessors, {
num<-input$assessors
if(num>tot_app){#add
adds<-seq(tot_app+1,num)
for(i in adds){
here<-paste0("#assessor",i-1)
insertUI(
selector = here,
where = "afterEnd",
ui = textInput(paste0("assessor", i),
paste0("Assessor ",i," columns"))
)
}
tot_app<<-num
} else if(num<tot_app){#subtract
subs<-seq(num+1,tot_app)
for(i in subs){
removeUI(selector = paste0("#assessor",i))
}
tot_app<<-num
}
})
}
# Complete app with UI and server components
shinyApp(ui, server)
}
As in the help example, it works if you use use this syntax:
removeUI(selector = paste0("div:has(> #assessor",i,")"))
I am trying to set a default (or fallback) value for numericInput() in my shiny app to prevent NAs.
I am aware that the NA can be dealt with later in the server.r, but was wondering if there is a more elegant way of replacing the value within the input whenever a user deletes it in the ui.
The best way is to use the validate package with need() (see this SO thread), but here is something simpler and closer to what you are asking for:
library(shiny)
ui <- fluidPage(
numericInput("obs", "Observations:", 10, min = 1, max = 100),
verbatimTextOutput("value")
)
server <- function(input, session, output) {
dafault_val <- 0
observe({
if (!is.numeric(input$obs)) {
updateNumericInput(session, "obs", value = dafault_val)
}
})
output$value <- renderText({ input$obs })
}
shinyApp(ui, server)
I'd recommend using library(shinyvalidate), which is RStudios "official" way to solve this:
library(shiny)
library(shinyvalidate)
ui <- fluidPage(
numericInput(
inputId = "myNumber",
label = "My number",
value = 0,
min = 0,
max = 10
),
textOutput("myText")
)
server <- function(input, output, session) {
iv <- InputValidator$new()
iv$add_rule("myNumber", sv_required(message = "Number must be provided"))
iv$add_rule("myNumber", sv_gte(0))
iv$add_rule("myNumber", sv_lte(10))
iv$enable()
output$myText <- renderText({
req(iv$is_valid())
input$myNumber
})
}
shinyApp(ui, server)
I have created a module sliderCheckbox which bundles together a sliderInput and a checkBoxInput to disable the sliderInput - basically a possibility to state "I don't know", which is necessary for survey-like inputs. When the slider is disabled, I want it to return a default value - most often the initial value, but not necessarily.
Now my question is: Is there any possibility to pass this default value when initialising the UI, that is with sliderCheckboxInput()? As the default value is a property like minimum and maximum, that is where it logically belongs to, and it also fits better to the rest of my setup.
Example:
library(shiny)
library(shinyjs)
sliderCheckboxInput <- function(id,description="",
min = 0,
max = 100,
value = 30,
default= NULL ##HERE I would want the default value to be set
cb_title = "I don't know"){
ns <- NS(id)
fluidRow(
column(width=9,
sliderInput(ns("sl"),
paste0(description, collapse=""),
min = min,
max = max,
value = value)
),
column(width=2,
checkboxInput(ns("active"),
cb_title, value=FALSE )
)
)
}
sliderCheckbox<- function(input, output, session,
default=NA) { #Problem: set default when initialising module
oldvalue<- reactiveVal()
observeEvent(input$active, {
if (input$active){
oldvalue(input$sl)
disable("sl")
updateSliderInput(session, "sl", value=default)
}else {
updateSliderInput(session, "sl", value=oldvalue())
enable("sl")
}
toggleState("sl", !input$active)
})
onclick("sl",
if(input$active) updateCheckboxInput(session, "active", value=FALSE)
)
return ( reactive({
if (input$active){
default
}else {
input$sl
}
}))
}
ui <- fluidPage(
useShinyjs(),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderCheckboxInput("bins", "Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output, session) {
bins_nr <- callModule(sliderCheckbox, "bins", default=44)
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = bins_nr() + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui, server)
You can send the value from the ui to the server using a hidden textInput
library(shiny)
library(shinyjs)
sendValueToServer <- function(id, value) {
hidden(textInput(
id, "If you can see this, you forgot useShinyjs()", value
))
}
myModuleUI <- function(id, param) {
ns <- NS(id)
tagList(
sendValueToServer(ns("param_id"), param),
textOutput(ns("text_out"))
)
}
myModule <- function(input, output, session) {
param <- isolate(input$param_id)
output$text_out <- renderText({
param
})
}
shinyApp(
ui = fluidPage(
useShinyjs(),
myModuleUI("id", "test")
),
server = function(input, output, session) {
callModule(myModule, "id")
}
)
There are probably more direct ways to do this using the JavaScript API of shiny but this is a "pure R" solution which should be enough for most usecases. Note that you can use the input value at initialization time with
isolate(input$text_in)
because the ui is always built before the server. Things get more complicated if everything is wrapped into renderUI but this does not seem to be the case for you.
Somewhat late to the party, but I think a neater way to do this is to use session$userData. This is available to both the main server function and the module's sewrver function.
So, in the main server, before callModule creates the module server:
session$userData[["module_id"]]$defaultValue <- myDefaultValue
and then at the end of module server function:
return ( reactive({
if (input$active){
session$userData[["module_id"]]$defaultValue
} else {
input$sl
}
})
)
That strikes me as neater, more robust and more generic than using a hidden input.
I have the following Shiny Application:
library(shiny)
library(shinyjs)
library(shinydashboard)
UI <- fluidPage(
actionButton("get_tweets", "Fetch tweets"),
numericInput("tweet_amount", "Set the amount of Tweets", 10, min = 10, max = 1000),
selectInput("tweet_name", "Select the tweeter", selected = NULL, choices = c("#RealDonaldTrump")),
#Set hidden buttons
hidden(
div(id="status_update",
verbatimTextOutput("status")
)
),
hidden(
div(id="tweet_fetcher",
verbatimTextOutput("status2")
)
)
)
Server <- function(input, output){
list = c(1,2,3)
get_connected <- reactive({
for(i in 1:length(list)){
Sys.sleep(2)
}
})
observeEvent(input$get_tweets, {
get_connected()
toggle("status_update")
output$status <- renderText({"You're now connected to the API"})
toggle("tweet_fetcher")
output$status2 <- renderText("Test")
})
}
shinyApp(ui = UI, server = Server)
Thing is that now I works. However, ideally I would like to make sure a button appears. Therefore I want to change:
output$status2 <- renderText("Test")
and this
verbatimTextOutput("status2") #actionButton("status2", "a_button")
This does not work. Any tips on what I should use if I want JS to let a button appear?
If i understand the question correctly you want to interchange
verbatimTextOutput("status2") with actionButton("status2", "a_button").
Then you should use renderUI():
Server side: output$status2 <- renderUI(actionButton("status2",
"a_button"))
UI side: uiOutput("status2")
Full app would read:
library(shiny)
library(shinyjs)
library(shinydashboard)
UI <- fluidPage(
actionButton("get_tweets", "Fetch tweets"),
numericInput("tweet_amount", "Set the amount of Tweets", 10, min = 10, max = 1000),
selectInput("tweet_name", "Select the tweeter", selected = NULL, choices = c("#RealDonaldTrump")),
#Set hidden buttons
hidden(
div(id="status_update",
verbatimTextOutput("status")
)
),
hidden(
div(id="tweet_fetcher",
uiOutput("status2")
)
)
)
Server <- function(input, output){
list = c(1,2,3)
get_connected <- reactive({
for(i in 1:length(list)){
Sys.sleep(2)
}
})
observeEvent(input$get_tweets, {
get_connected()
toggle("status_update")
output$status <- renderText({"You're now connected to the API"})
toggle("tweet_fetcher")
output$status2 <- renderUI(actionButton("status2", "a_button"))
})
}
shinyApp(ui = UI, server = Server)