I would like to have different labels for gauges created using the flexdashboard package depending on the selection that is made. However, when a new option is chosen the first label that is loaded remains but the input updates. Is there some way to clear the cache so that the labels will change?
Below is a reprex of the problem in Shiny:
library(shiny)
library(flexdashboard)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons("labelChoice",
label = "Choose a label",
choices = c("Label 1", "Label 2")
)
),
mainPanel(
gaugeOutput("gauges")
)
)
)
server <- function(input, output) {
observe({
if(input[["labelChoice"]] == "Label 1") {
output$gauges <- renderGauge({ gauge(15, min = 0, max = 100, label = "Hello I'm label 1!") })
} else {
output$gauges <- renderGauge({ gauge(55, min = 0, max = 100, label = "Hello I'm label 2!") })
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Reactive objects need HTML tags of class shiny-bound-input. The flexdashboard gauge, however, usually creates a svg which is out of the scope of shiny's reactive context.
This is fixed with a newer version (see this issue on 20th Sep 2021). Try to update using remotes::install_github("rstudio/flexdashboard").
I am having trouble getting Rshiny to do what I want.
I would like the user to select an input from the SelectInput choices and based on that input I would like some Text output that is mathematical notation.
I have tried to implement this with withMathJax(), but I cannot seem to get the code right.
Here is some toy code illustrating what I have already:
######################################
ui <-navbarPage(title = "test",
helpText("Here we select which parameters we want to include in our model"),
selectInput("torchp",
label = h4("Torching Parameters"),
choices = list("One parameter",
"Two parameters" ),
selected = 1),
mainPanel(
textOutput("torchvalue")
)
)
server <- function(input, output) {
withMathJax()
torchp_input <- reactive({
switch(input$torchp,
"One parameter" = '$$q$$',
"Two parameters" = '$$q_m, q_f$$'
)
})
output$torchvalue <- renderText({
paste("You have selected", torchp_input())
})
}
shinyApp(ui = ui, server = server)
###################################
The output I get does not recognise my mathematical notation.
Thanks.
Discovered an answer thanks to help in the comments by #Limey.
The issue was which rendering function I used.
In this instance you should use uiOutput and renderUI as follows:
In the UI put:
uiOutput("torchvalue")
In the server use:
output$torchvalue <- renderUI({ p( withMathJax("you have selected", torchp_input())) })
I'm a beginner in shiny app. so first I tried to build an app to calculate distance covered using time taken and speed. I got error as "argument of length zero". Then I entered req(input$num_time,input$select_time,input$slider_speed)this command after that error message is not displaying and also not getting output also. I'm not able to find where I gone wrong. Please help me in getting the output. I have shown the code I used below:
library(shiny)
#library(car)
ui <- fluidPage(
titlePanel("terrain model"),
sidebarLayout(
sidebarPanel(
helpText("To create a suitable model"),
br(),
numericInput("num_time",
label = h6("Enter time"),
value = 1),
selectInput("select_time",
label = h6(""),
choices = list("Hours"= 1,"Minutes" = 2),
selected = "1"),
sliderInput("Speed",
label = "Speed:",
min = 2, max = 4.5, value = 2),
br(),
actionButton("action",label="Refresh & Calculate")
),
mainPanel(
textOutput("text_distance")
)
)
)
server <- function(input, output) {
values <- reactiveValues()
#calculate distance travelled
observe({input$action_Calc
values$int <- isolate({ input$num_time * recode(input$select_time,"1='60';2='1'")*input$slider_speed
})
})
#Display values entered
output$text_distance <- renderText({
req(input$num_time,input$select_time,input$slider_speed)
if(input$action_Calc==0)""
else
paste("Distance:", round(values$int,0))
})
}
shinyApp(ui, server)
I don't find any use of "Refresh & Calculate" button since the calculation is performed as soon as any of the input changes.
You can try this code :
ui <- fluidPage(
titlePanel("terrain model"),
sidebarLayout(
sidebarPanel(
helpText("To create a suitable model"),
br(),
numericInput("num_time",
label = h6("Enter time"),
value = 1),
selectInput("select_time",
label = h6(""),
choices = list("Hours"= 1,"Minutes" = 2),
selected = "1"),
sliderInput("Speed",
label = "Speed:",
min = 2, max = 4.5, value = 2),
br(),
actionButton("action",label="Refresh & Calculate")
),
mainPanel(
textOutput("text_distance")
)
)
)
server <- function(input, output) {
#Display values entered
output$text_distance <- renderText({
val <- input$num_time/dplyr::recode(input$select_time,"1"=1,"2"=60)*input$Speed * 1000
paste("Distance:", round(val,0), 'meters')
})
}
shinyApp(ui, server)
Probably very basic question - but can't translate similar posts I've found to my exact issue.
Within an R Shiny app, I have a first drop-down menu that is populated by a vector produced on the server - this allows me to make one set of choices.
I want to have a tick box that then introduces a second drop down - but I want that drop down to disappear if I un-tick the tick box.
I've had a go - see MWE below - the graph is just there to keep to the structure of my original code (obviously I'm aware my drop-downs do nothing but that's not the case in the original but wanted the MWE to be as 'M' as possible).
If I remove the removeUI() line then ticking the tick-box does create a new drop down as required - but then un-ticking the tick box fails to remove it.
I'm obviously missing something; any help much appreciated as I totally suck at R Shiny but really want to get better!
library(shiny)
library(shinyMobile)
# define UI elements
ui <- f7Page(
f7SingleLayout(
navbar = f7Navbar(
),
f7Card(htmlOutput("initial_drop_down"), #first drop down
f7checkBox(inputId = "switch", label = "Introduce second choice", FALSE), #tick box for second drop down if required
htmlOutput("reactive_drop_down") #second drop down
),
f7Shadow(
intensity = 16,
f7Card(
plotOutput("distPlot", height = "800px") # plot - originally linked to drop down choices but an arbitrary graph here for simplicity
)
)
)
)
# server calculations
server <- function(input, output) {
library(ggplot2)
# generate first drop down - done on server side since usually choices vector is comprised of information read in from files
output$initial_drop_down = renderUI({
selectInput(inputId = "initial_choice",
label = "First choice:",
choices = c("Choice 1", "Choice 2", "Choice 3"))
})
observeEvent(input$initial_choice, {
# trying to add second drop down based on action in switch - not convinced my use of observeEvent is quite right - issue likely sits in here.
observeEvent(input$switch, {
if(input$switch == T){
output$reactive_drop_down = renderUI({
selectInput(inputId = "second_choice",
label = "Second (dynamic) choice:",
choices = c(1,2,3))
})
}else{
removeUI(selector ="#reactive_drop_down")
}
})
output$distPlot <- renderPlot({
ggplot(data = cars) + geom_line(aes(x=speed, y=dist))
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
Could you use conditionalPanel? Put your htmlOutput for your second input there in your ui. I would avoid using nested observeEvent and output.
library(shiny)
library(shinyMobile)
library(ggplot2)
# define UI elements
ui <- f7Page(
f7SingleLayout(
navbar = f7Navbar(
),
f7Card(htmlOutput("initial_drop_down"), #first drop down
f7checkBox(inputId = "switch", label = "Introduce second choice", FALSE), #tick box for second drop down if required
conditionalPanel(
condition = "input.switch==1",
htmlOutput("reactive_drop_down") #second drop down
)
),
f7Shadow(
intensity = 16,
f7Card(
plotOutput("distPlot", height = "800px") # plot - originally linked to drop down choices but an arbitrary graph here for simplicity
)
)
)
)
# server calculations
server <- function(input, output) {
# generate first drop down - done on server side since usually choices vector is comprised of information read in from files
output$initial_drop_down = renderUI({
selectInput(inputId = "initial_choice",
label = "First choice:",
choices = c("Choice 1", "Choice 2", "Choice 3"))
})
output$reactive_drop_down = renderUI({
selectInput(inputId = "second_choice",
label = "Second (dynamic) choice:",
choices = c(1,2,3))
})
output$distPlot <- renderPlot({
ggplot(data = cars) + geom_line(aes(x=speed, y=dist))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I'm building a new Shiny app and I although it works, the code is too extensive and it is not as reactive as I wanted. Right now I have at server.R
dayData <- reactive({...})
pday <- function(data){...}
output$distPlotday <- renderPlot(function() {print(pday(dayData)) })
and at ui.R
plotOutput("distPlotday")
for each variable in
checkboxGroupInput("checkGroup", "Dataset Features:",
choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"))
But I wish I could do something more fancy like this:
shinyServer(function(input, output, session) {
...
output$sliders <- renderUI({
lapply(input$checkGroup, function(i) {
fluidRow(
column(4,
selectInput(paste0('trans',i), i,
choices = c('linear','quadratic','sine')) ,
conditionalPanel(
condition = "input[[paste0('trans',i)]]== 'sine'",
withMathJax(),
h5("Put in your initial kicks for: $$a*\\sin(b*x+c)+d$$"),
textInput3(paste0('trans',i,'a'), h5('A:'),
value = 10),
textInput3(paste0('trans',i,'b'), h5('C:'),
value = 1),
textInput3(paste0('trans',i,'c'), h5('D:'),
value = 0.1),
helpText("Note: B has already been picked up")
),
plotOutput(paste0('distPlot',i))
))
})
})
...
}))
.
shinyUI(navbarPage("",
tabPanel("Data",
sidebarLayout(
sidebarPanel(
checkboxGroupInput("checkGroup", label = h5("Dataset Features:"),
choices = c("day","hour","source","service","relevancy","tollfree","distance","similarity"), inline = F,
selected = c("day","hour","source","service","relevancy","tollfree","distance","similarity"))
),
mainPanel(
numericInput("obs", label = h5("Number of observations to view"), 15, min = 10, max = 20, step = 1),
tableOutput("view")
)
)
),
tabPanel("Variable transformation", uiOutput(outputId = "sliders"))
))
Using lapply and renderUI. But
plotOutput(paste0('distPlot',i))
is not ploting anything, and the
conditionalPanel(condition = "input[[paste0('trans',i)]]== 'sine'",...)
don't show up conditionally, instead it's always there.
Any suggestions? Thanks for the help!
I wasn't sure what you wanted to do with the plotOutput call, since as far as I can tell there wasn't any example code included that linked to it. However, I managed to put together a working example for dynamically showing/hiding the selection boxes and text fields for the sine parameters.
I found it easier to implement by moving the ui generation from the server into the ui. This gets around the problem of conditions being evaluated for input that doesn't exist yet, since on the ui side the functions are just writing html.
An additional benefit is that this way the input fields don't get re-rendered every time the checkbox input changes - this means that their values persist through toggling them on and off, and that enabling or disabling a single variable won't cause the others' values to reset.
The code:
library(shiny)
vars <- c("day","hour","source","service","relevancy",
"tollfree","distance","similarity")
ui <- shinyUI(navbarPage("",
tabPanel("Data",
sidebarLayout(
sidebarPanel(
checkboxGroupInput("checkGroup", label = h5("Dataset Features:"),
choices = c("day","hour","source","service","relevancy",
"tollfree","distance","similarity"), inline = F,
selected = c("day", "hour","source","service","relevancy",
"tollfree","distance","similarity")
)
),
mainPanel(
numericInput("obs", label = h5("Number of observations to view"),
value = 15, min = 10, max = 20, step = 1),
tableOutput("view")
)
)
),
tabPanel("Variable transformation",
fluidRow(
column(4,
lapply(vars, function(i) {
div(
conditionalPanel(
condition =
# javascript expression to check that the box for
# variable i is checked in the input
paste0("input['checkGroup'].indexOf('", i,"') != -1"),
selectInput(paste0('trans',i), i,
choices = c('linear','quadratic','sine'))
),
conditionalPanel(
condition =
paste0("input['trans", i, "'] == 'sine' ",
" && input['checkGroup'].indexOf('", i,"') != -1"),
withMathJax(),
h5("Put in your initial kicks for: $$a*\\sin(b*x+c)+d$$"),
textInput(paste0('trans',i,'a'), h5('A:'), value = 10),
textInput(paste0('trans',i,'b'), h5('C:'), value = 1),
textInput(paste0('trans',i,'c'), h5('D:'), value = 0.1),
helpText("Note: B has already been picked up")
)
)
})
)
)
)
))
server <- shinyServer(function(input, output, session) {})
shinyApp(ui, server)
PS. For dynamically showing/hiding or enabling/disabling objects, the package shinyjs by Dean Attali (link) has some nice tools that allow you to call basic javascript by using only R syntax.