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").
Related
I want to perform the Shapiro-Wilk-Test in my Shiny App. Over the two sliders and the numeric input I get the values for rnorm. And because I can change my inputs to rnorm, I made it reactive.
But when running the app it doesn't work - I tried a lot, but it wasn't successful.
How must I change my code that it works? Thanks in advance!
My code:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("slider1", label = h3("Quantity of n"), min = 10, max = 100, value = 50),
sliderInput("slider2", label = h3("Mean of group 1"), min = 0, max = 100, value = 50),
numericInput("num", label = h3("SD of group 1"), value = 1)
),
mainPanel(
textOutput("Text1")
)
)
)
server <- function(input, output) {
group1=reactive({
rnorm(n=input$slider1,mean=input$slider2,sd=input$num)
})
# Shapiro-Wilk-Test
### shapiro.test(....)[[2]][1] shows the p-value
ND_G1=shapiro.test(group1())[[2]][1] # with "rnorm(10,5,2)" instead of group1() it works
output$Text1 <- renderText({paste("The p-value is: ",ND_G1)})
}
# Create Shiny app ----
shinyApp(ui = ui, server = 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)
For a shiny app I'm working on, I'm expecting the histogram will refresh after the user adjust the slider as well as the radio button.
How could I link the radio button and the slider with the plot?
I've tried using filter() and it always ends up the plot not appearing when the radio button adjust to "yes" or "no". However, when the radio button stays at "All" the plot appears well.
Below is the server.r, I've used:
plotdata<- reactive({
if(input$DayTrade=="All")
{dataset %>%
filter(dataset$INVEST<=input$INVEST[2],
dataset$INVEST>=input$INVEST[1],
dataset$Age<=input$Age[2],
dataset$Age>=input$Age[1],dataset$DayTrade==dataset$DayTrade)}
else if (input$DayTrade=="No")
{dataset %>%
filter(dataset$INVEST<=input$INVEST[2],
dataset$INVEST>=input$INVEST[1],
dataset$Age<=input$Age[2],
dataset$Age>=input$Age[1],dataset$DayTrade=="No")}
else
{dataset %>%
filter(dataset$INVEST<=input$INVEST[2],
dataset$INVEST>=input$INVEST[1],
dataset$Age<=input$Age[2],
dataset$Age>=input$Age[1],dataset$DayTrade=="Yes")}
})
output$histogramplot<-renderPlot({
datos<-plotdata()
ggplot(datos, aes(factor(Age),fill=factor(SEX))) + geom_bar(bins=15)
})
Below is the ui.r, I've used:
tabPanel("no-Eaccount",sidebarLayout(
sidebarPanel(
sliderInput("INVEST","Invest Range:",min = 0,max = 5000,value = c(100,300),pre="$"),
sliderInput("Age","Age Range:",min = 0,max = 100,value = c(20,30)),
radioButtons("DayTrade", "Day Trade:",
choices = c("Yes", "No","All"),
selected = "All")
),
mainPanel(
div(plotOutput("histogramplot"),style="width:100%")
)
))
How do I solve this problem?
We can use eventReactive to listen on radiobutton and slider and reacted when they changed. here an example
shinyApp(
ui = fluidPage(
column(4,
radioButtons("x", "Value x", choices = c('5'=5,'7'=7,'8'=8), selected = 5),
sliderInput("y", "Value y", value = 7,6,10)
),
column(8, tableOutput("table"))
),
server = function(input, output, sessio) {
# Take an action every time button is pressed;
# here, we just print a message to the console
observeEvent(input$x, {
cat("Showing", input$x, "rows\n")
})
# Take a reactive dependency on input$x or input$y, but
# not on any of the stuff inside the function
df <- eventReactive(as.numeric(input$x) | input$y, {
data.frame(x=input$x,y=input$y)
})
output$table <- renderTable({
df()
})
}
)
I have achieved to define two interconnected or mutually dependent input in my shiny app. Right now, my problem is to set a specific initial value for these slider and numeric inputs. It seems that they always start with the minimum value, even I don't now exactly why. How can I indicate a unique starting point or an initial value for these input parameters?
I have attached a simplified part of my app in order to provide you a reproducible version of my problem here:
"ui.R"
library(shiny)
shinyUI(fluidPage(
uiOutput("Param_s"),
uiOutput("Param_n")
))
and the "server.R"
library(shiny)
shinyServer(
function(input,output) {
# Mutually dependent slider and numeric inputs
output$Param_s = renderUI({
sliderInput(inputId = "param_slide",
label= "My input parameter",
value= input$param_numeric,
min=1,
max=200)
})
output$Param_n = renderUI({
numericInput(inputId = "param_numeric",
label= "My input parameter",
value= input$param_slide,
min=1,
max=200)
})
})
I tried various things to fix the initial value but eventually nothing worked. Any help would be appreciated!!
wow! I got it guys! You should only update the two input objects at the same time and up to the same value. It means adding these two lines solved my problem to set the initial value to 60 for example:
updateSliderInput(session,"param_slide", value = 60)
updateNumericInput(session,"param_numeric", value = 60 )
Therefore the whole "server.R" would be like this:
#
library(shiny)
shinyServer(
function(input,output,session) {
# Mutually dependent slider and numeric inputs
output$Param_s = renderUI({
sliderInput(inputId = "param_slide",
label= "My input parameter",
value= input$param_numeric,
min=1,
max=200)
})
output$Param_n = renderUI({
numericInput(inputId = "param_numeric",
label= "My input parameter",
value= input$param_slide,
min=1,
max=200)
})
updateSliderInput(session,"param_slide", value = 60)
updateNumericInput(session,"param_numeric", value = 60 )
})
You should only be aware of adding these updates with an
observeEvent()
when you have these input objects on the other tabs. In my case which I am using "sidebarMenu" I used a simple line of code as this:
observeEvent(input$sidebar_id =="tab1",{
updateSliderInput(session,"param_slide", value = 60)
updateNumericInput(session,"param_numeric", value = 60 )
})
Coming from here.
You should try to avoid re-rendering (renderUI) if possible.
It's faster to update existing inputs:
library(shiny)
ui <- fluidPage(
sliderInput(
inputId = "param_slide",
label = "My input parameter",
value = 60,
min = 1,
max = 200
),
numericInput(
inputId = "param_numeric",
label = "My input parameter",
value = 60,
min = 1,
max = 200
)
)
server <- function(input, output, session) {
observeEvent(input$param_numeric, {
updateSliderInput(session, "param_slide", value = input$param_numeric)
}, ignoreInit = TRUE)
observeEvent(input$param_slide, {
updateNumericInput(session, "param_numeric", value = input$param_slide)
}, ignoreInit = TRUE)
}
shinyApp(ui, server)
Furthermore, please check this and this.
I'm building my first shiny app and I've run into a little difficulty which i cant understand
My code wants to take the input from the user - add one then print the output
please ignore the radio buttons for now -
ui <- shinyUI(fluidPage(
titlePanel("alpha"),
sidebarPanel(numericInput("expn",
"Please enter total number of reports received", 1,
min = 0,
max = 1000000
),
radioButtons(inputId = "'QC_Type'", label = "QC Type",
choices = c("Overall", "Solicited", "Spontaneous",
"Clinical Trial","Literature" ),
mainPanel(
textOutput("results"))
))))
server <- function (input, output) {
output$results <- renderText(
{ print(1 +(Input$expn))
}
)
}
shinyApp(ui = ui, server = server)
I'm unable to see any output when I run the code.
Thank you for your time :)
That's because of where your mainPanelis located. It should follow the sidebarPanel. Also, I recommend using as.character() instead of print(), unless you really want to print out the output on the console.
Here's the corrected code:
ui <- shinyUI(fluidPage(
titlePanel("alpha"),
sidebarPanel(
numericInput(
"expn",
"Please enter total number of reports received",
1,
min = 0,
max = 1000000
),
radioButtons(
inputId = "'QC_Type'",
label = "QC Type",
choices = c(
"Overall",
"Solicited",
"Spontaneous",
"Clinical Trial",
"Literature"
)
)
),
mainPanel(textOutput("results"))
))
server <- function (input, output) {
output$results <- renderText({
as.character(1 + (input$expn))
})
}
shinyApp(ui = ui, server = server)
I recommend using good practices when indenting code. It makes things easier to read and to find where braces and parentheses are.