How to refresh the plot after adjusting radio button and slider? - r

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()
})
}
)

Related

Shiny widgets check box groups activating on enter

I am trying to design a search feature where you can search via a text input and through check boxes (I am using shinyWidgets), except for some reason, when you hit enter inside the text input it is activating my "ALL/NONE" button.
The goal is that when the ALL/NONE button is hit that it alternates between selecting all of the check boxes and selecting none of them. The issue is that hitting enter in the text box also seems to activate the observe, even when it should only be activating by the button.
library(shiny)
library(shinyWidgets)
Habitat <- c("grass", "water", "stone")
ID <- c(1, 2, 3)
data <- data.frame(ID, Habitat)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
width = 2,
textInput("keyword_search", label = "Search by Keyword"),
uiOutput("h_button"),
uiOutput("habitat_filter")
),
mainPanel(width = 10
))
)
server <- function(input, output, session) {
output$habitat_filter <- renderUI({
habitat_choices <- checkboxGroupInput(inputId = "habitat", label = "",
choices = unique(data$Habitat[!is.na(data$Habitat)]),
selected = unique(data$Habitat[!is.na(data$Habitat)]))
})
output$h_button <- renderUI({
habitat_button <- checkboxGroupButtons(
inputId = "habitat_switch",
choices = "ALL / NONE",
size = "sm",
selected = "ALL / NONE")
})
observe({ #all/none button for habitats
x <- input$habitat_switch
if (!is.null(x)) {
x <- unique(data$Habitat[!is.na(data$Habitat)])
}
else {
x <- character(0)
}
updateCheckboxGroupInput(
session,
"habitat",
label = NULL,
choices = unique(data$Habitat[!is.na(data$Habitat)]),
selected = x
)
})
}
shinyApp(ui = ui, server = server)
Weirdly, this problem seems to go away if it is coded outside of the sidebarLayout. i.e. if the ui side looks like this:
ui <- fluidPage(
textInput("keyword_search", label = "Search by Keyword", width = '100%', placeholder = "Type here to search the archive..."),
uiOutput("h_button"),
uiOutput("habitat_filter")
)
Unfortunately, I need the sidebar so removing it isn't an option for fixing the problem. Does anyone have a solution to prevent these features from being connected? Or an explanation for why this happening?
Replacing my observe for the button with this seems to avoid the problem as suggested here: Select/Deselect All Button for shiny variable selection
observe({ #all/none button for habitats
x <- unique(data$Habitat[!is.na(data$Habitat)])
if (!is.null(input$habitat_switch) && input$habitat_switch >= 0) {
if (input$habitat_switch %% 2 == 0) {
x <- unique(data$Habitat[!is.na(data$Habitat)])
}
else {
x <- character(0)
}
}
updateCheckboxGroupInput(
session,
"habitat",
label = NULL,
choices = sort(unique(data$Habitat[!is.na(data$Habitat)])),
selected = x
)
})
Still no idea what caused this issue initially, but this work around seems good enough

How to add a spinner before a selectizeInput has loaded all the choices? [Shiny]

I want to make an app with 2 actionButtons: 1) to submit the changes before loading a selectizeInput and 2) to draw the plot.
I know how to add a spinner after clicking a actionButton but the majority of the cases is added when you want to show the plot.
However, is it possible to add a spinner without showing any plot?
In this particular case, I want to show a spinner after clicking "Submit" until the selectizeInput from the 'Selection tab' is loaded. As you can see the example that I attach, it takes a bit to load all the choices (since the file has 25000 rows).
I already have one spinner after clicking the second actionButton (Show the plot) but I need one more.
I have created an example, but for some reason the plot is not shown in the shiny app and it appears in the window from R (I don't know why but I added the plot just to show you how I put the second spinner. I want a similar one but with the first actionButton.).
library(shiny)
library(shinycssloaders)
ui <- fluidPage(
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Submit",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Selection",
br(),
selectizeInput(inputId = "numbers", label = "Choose one number:", choices=character(0)),
actionButton("show_plot", "Show the plot")
))
),
mainPanel(
conditionalPanel(
condition = "input.show_plot > 0",
style = "display: none;",
withSpinner( plotOutput("hist"),
type = 5, color = "#0dc5c1", size = 1))
)
)
)
server <- function(input, output, session) {
data <- reactive({
data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
data[,1] <- as.character(data[,1])
if(input$log2 == TRUE){
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
return(data)
})
mylist <- reactive({
req(data())
data <- data()
data <- data[,1]
return(data)
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$submit, {
updateSelectizeInput(
session = session,
inputId = "numbers",
choices = mylist(), options=list(maxOptions = length(mylist()))
)
})
v <- reactiveValues()
observeEvent(input$show_plot, {
data <- data()
v$plot <- plot(x=data[,1], y=data[,2])
})
# If the user didn't choose to see the plot, it won't appear.
output$hist <- renderPlot({
req(data())
if (is.null(v$plot)) return()
if(input$show_plot > 0){
v$plot
}
})
}
Does anyone know how to help me, please?
Thanks very much
It's a little tricky.
First of all I'd update the selectizeInput on the server side as the warning suggests:
Warning: The select input "numbers" contains a large number of
options; consider using server-side selectize for massively improved
performance. See the Details section of the ?selectizeInput help
topic.
Furthermore I switched to ggplot2 regarding the plotOutput - Please see this related post.
To show the spinner while the selectizeInput is updating choices we'll need to know how long the update takes. This information can be gathered via shiny's JS events - please also see this article.
Finally, we can show the spinner for a non-existent output, so we are able to control for how long the spinner is shown (see uiOutput("dummyid")):
library(shiny)
library(shinycssloaders)
library(ggplot2)
ui <- fluidPage(
titlePanel("My app"),
tags$script(HTML(
"
$(document).on('shiny:inputchanged', function(event) {
if (event.target.id === 'numbers') {
Shiny.setInputValue('selectizeupdate', true, {priority: 'event'});
}
});
$(document).on('shiny:updateinput', function(event) {
if (event.target.id === 'numbers') {
Shiny.setInputValue('selectizeupdate', false, {priority: 'event'});
}
});
"
)),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel("Submit",
checkboxInput("log2", "Log2 transformation", value = FALSE),
actionButton("submit", "Submit")
),
tabPanel("Selection",
br(),
selectizeInput(inputId = "numbers", label = "Choose one number:", choices=NULL),
actionButton("show_plot", "Show the plot")
))
),
mainPanel(
uiOutput("plotProxy")
)
)
)
server <- function(input, output, session) {
previousEvent <- reactiveVal(FALSE)
choicesReady <- reactiveVal(FALSE)
submittingData <- reactiveVal(FALSE)
observeEvent(input$selectizeupdate, {
if(previousEvent() && input$selectizeupdate){
choicesReady(TRUE)
submittingData(FALSE)
} else {
choicesReady(FALSE)
}
previousEvent(input$selectizeupdate)
})
data <- reactive({
data = read.csv("https://people.sc.fsu.edu/~jburkardt/data/csv/hw_25000.csv")
if(input$log2 == TRUE){
cols <- sapply(data, is.numeric)
data[cols] <- lapply(data[cols], function(x) log2(x+1))
}
return(data)
})
mylist <- reactive({
req(data()[,1])
})
observeEvent(input$submit, {
submittingData(TRUE)
reactivePlotObject(NULL) # reset
updateSelectizeInput(
session = session,
inputId = "numbers",
choices = mylist(), options=list(maxOptions = length(mylist())),
server = TRUE
)
})
reactivePlotObject <- reactiveVal(NULL)
observeEvent(input$show_plot, {
reactivePlotObject(ggplot(data(), aes_string(x = names(data())[1], y = names(data())[2])) + geom_point())
})
output$hist <- renderPlot({
reactivePlotObject()
})
output$plotProxy <- renderUI({
if(submittingData() && !choicesReady()){
withSpinner(uiOutput("dummyid"), type = 5, color = "#0dc5c1", size = 1)
} else {
conditionalPanel(condition = "input.show_plot > 0", withSpinner(plotOutput("hist"), type = 5, color = "#0dc5c1", size = 1), style = "display: none;")
}
})
}
shinyApp(ui, server)
First 100 rows of your example data (dput(head(data, 100)) - your link might be offline some day):
structure(list(Index = 1:100, Height.Inches. = c(65.78331, 71.51521,
69.39874, 68.2166, 67.78781, 68.69784, 69.80204, 70.01472, 67.90265,
66.78236, 66.48769, 67.62333, 68.30248, 67.11656, 68.27967, 71.0916,
66.461, 68.64927, 71.23033, 67.13118, 67.83379, 68.87881, 63.48115,
68.42187, 67.62804, 67.20864, 70.84235, 67.49434, 66.53401, 65.44098,
69.5233, 65.8132, 67.8163, 70.59505, 71.80484, 69.20613, 66.80368,
67.65893, 67.80701, 64.04535, 68.57463, 65.18357, 69.65814, 67.96731,
65.98088, 68.67249, 66.88088, 67.69868, 69.82117, 69.08817, 69.91479,
67.33182, 70.26939, 69.10344, 65.38356, 70.18447, 70.40617, 66.54376,
66.36418, 67.537, 66.50418, 68.99958, 68.30355, 67.01255, 70.80592,
68.21951, 69.05914, 67.73103, 67.21568, 67.36763, 65.27033, 70.84278,
69.92442, 64.28508, 68.2452, 66.35708, 68.36275, 65.4769, 69.71947,
67.72554, 68.63941, 66.78405, 70.05147, 66.27848, 69.20198, 69.13481,
67.36436, 70.09297, 70.1766, 68.22556, 68.12932, 70.24256, 71.48752,
69.20477, 70.06306, 70.55703, 66.28644, 63.42577, 66.76711, 68.88741
), Weight.Pounds. = c(112.9925, 136.4873, 153.0269, 142.3354,
144.2971, 123.3024, 141.4947, 136.4623, 112.3723, 120.6672, 127.4516,
114.143, 125.6107, 122.4618, 116.0866, 139.9975, 129.5023, 142.9733,
137.9025, 124.0449, 141.2807, 143.5392, 97.90191, 129.5027, 141.8501,
129.7244, 142.4235, 131.5502, 108.3324, 113.8922, 103.3016, 120.7536,
125.7886, 136.2225, 140.1015, 128.7487, 141.7994, 121.2319, 131.3478,
106.7115, 124.3598, 124.8591, 139.6711, 137.3696, 106.4499, 128.7639,
145.6837, 116.819, 143.6215, 134.9325, 147.0219, 126.3285, 125.4839,
115.7084, 123.4892, 147.8926, 155.8987, 128.0742, 119.3701, 133.8148,
128.7325, 137.5453, 129.7604, 128.824, 135.3165, 109.6113, 142.4684,
132.749, 103.5275, 124.7299, 129.3137, 134.0175, 140.3969, 102.8351,
128.5214, 120.2991, 138.6036, 132.9574, 115.6233, 122.524, 134.6254,
121.8986, 155.3767, 128.9418, 129.1013, 139.4733, 140.8901, 131.5916,
121.1232, 131.5127, 136.5479, 141.4896, 140.6104, 112.1413, 133.457,
131.8001, 120.0285, 123.0972, 128.1432, 115.4759)), row.names = c(NA,
100L), class = "data.frame")

Switch outputs in R shiny radio buttons

I am working on a shiny app where I am using radioGroupButtons from ShinyWidgets. So for each button I am trying to switch to different output like table or a plot. How do I link the radio button to the outputs
library(shinyWidgets)
library(shinipsum)
library(htmlwidgets)
ui <- navbarPage(
div(
id = "section1-1",
radioGroupButtons(
inputId = "Id069",
# label = "Choose a graph :",
choices = c(
`<i class='fa fa-bar-chart'></i>` = "bar",
`<i class='fa fa-line-chart'></i>` = "line",
`<i class='fa fa-pie-chart'></i>` = "pie"
),
justified = TRUE
)
)
)
server <- function(input, output, session) {
# observe({
# x <- input$inRadioButtons
#
# # Can also set the label and select items
# updateRadioButtons(session, "inRadioButtons2",
# label = paste("radioButtons label", x),
# choices = x,
# selected = x
# )
# })
output$plot <- renderPlot({
random_ggplot()
})
}
shinyApp(ui, server)
On the server side, you can access the input ID like this:
Value = input$Id069
So, add logic like this to server side (within output$plot):
If (Value == x) {
Plot1()
} else {
Plot2()
}
You might want to look into conditional panels on the UI.

R shiny Multiple slider inputs based on checkbox inputs

I have used the below code to create checkbox from my data.I would like to create slider input for each checkbox I select from the list.For example if the checkbox has 4 variables like "sky","earth","water","fire" and if I select sky, it should dynamically open a slider input for sky and if I select water it should open up one more slider input for water. I tried conditionalPanel,but I have more than 50 variables in my checkbox,so i cannot write condition for all the 50 variables. Is there any generalized method available in shiny?
server
output$choosedigital=renderUI({
if(is.null(bk$variables))
return()
checkboxGroupInput("choosemedia", "Choose digital",
choices = bk$variables,
selected = bk$variables)
})
output$test <- renderUI({
LL <- list(rep(0,length(input$choosedigital)))
for(i in 0:(length(input$choosedigital))) {
LL[i] <- list(sliderInput(inputId = paste(input$choosedigital,i)
, label = paste(input$choosedigital,i),
min=0,max=25,value = 5))
}
return(LL)
})
You want to put your sliderInputs inside a conditionalPanel in the UI and set the condition so that when the relevant checkbox is clicked the the condition equates to TRUE.
e.g.
library(shiny)
myData = c("One", "Two", "Three")
ui <- fluidPage(
checkboxGroupInput("choosemedia", "Choose digital",
choices = myData,
selected = myData),
textOutput("myText"),
conditionalPanel(condition = "input.choosemedia.includes('One')",
sliderInput("sliderOne", "Choose your value", min=0, max=100, value=50)
),
conditionalPanel(condition = "input.choosemedia.includes('Two')",
sliderInput("sliderTwo", "Choose your other value",
min=0, max=50, value=25))
)
# Define server logic
server <- function(input, output) {
output$myText <- renderText({input$choosemedia})
}
# Run the application
shinyApp(ui = ui, server = server)
If long as you know what the content of bk$variables is you can hardcode them, otherwise you'll have to generate these on the fly.
Hope this is enough info to get you going.

Not getting graph in Shiny App in R

I am trying to create small application using Shiny. Below is the data frame for which I am trying to create.
data<-data.frame(state=c('AZ','VA','CA','AZ','VA','CA'), city=c('Phoenix','Arlington','SantaClara','Mesa','Richmond','SF'),
avg=c(10,15,16,13,14,14), date=c('01/09/2017','01/10/2017','01/11/2017','02/09/2017','02/10/2017','02/10/2017'),stringsAsFactors = FALSE)
So, I am trying to create a graph between date(x-axis) and avg(y-axis). So this graph should change based on the selection from dropdown list of State.For example, for a particular selected state, it should show cities available(in other dropdown) in that state.
Below is my code:
library(shiny)
library(ggplot2)
library(plotly)
statelist<-as.list(data$state)
citylist<-as.list(data$city)
ui <- basicPage(
# plotOutput("plot1", click = "plot_click"),
# verbatimTextOutput("info")
sidebarPanel(
selectInput("plot1", label=h3("Select State"), choices = statelist),
selectInput("plot2", label=h3("Select City"), choices = citylist)
),
plotOutput(outputId="plot")
),
server <- function(input, output, session) {
observe(
{
state <- input$plot1
updateSelectInput(session, "plot2", choices = data$city[data$state == state])
}
),
output$plot<-renderPlot({
ggplot(data[data$city == input$plot2 &
data$state == input$plot1],aes(date,avg))
+geom_line()
})
}
shinyApp(ui, server)
Dropdown is working perfectly but not getting the graph.
Thanks in advance!!
I made some minor modifications to your code:
There were some commas in places where they should not be: after the ui constructor, and after the observe constructor.
There was a comma missing in data[data$city == input$plot2 &
data$state == input$plot1,]
I edited your observe to be an observeEvent
I modified the plot to show that it actually changes, since the sample data is quite limited.
Hope this helps!
library(shiny)
library(ggplot2)
library(plotly)
data<-data.frame(state=c('AZ','VA','CA','AZ','VA','CA'), city=c('Phoenix','Arlington','SantaClara','Mesa','Richmond','SF'),
avg=c(10,15,16,13,14,14), Date=c('01/09/2017','01/10/2017','01/11/2017','02/09/2017','02/10/2017','02/10/2017'),stringsAsFactors = FALSE)
statelist<-unique(data$state)
citylist<-unique(data$city)
ui <- basicPage(
# plotOutput("plot1", click = "plot_click"),
# verbatimTextOutput("info")
sidebarPanel(
selectInput("plot1", label=h3("Select State"), choices = statelist),
selectInput("plot2", label=h3("Select City"), choices = citylist)
),
plotOutput(outputId="plot")
)
server <- function(input, output, session) {
observeEvent(input$plot1,
{
state <- input$plot1
updateSelectInput(session, "plot2", choices = data$city[data$state == state])
}
)
output$plot<-renderPlot({
data = data[data$city == input$plot2 &
data$state == input$plot1,]
ggplot(data,aes(Date,avg)) + geom_point(size=5) + ggtitle(paste0(input$plot1," - ",input$plot2 ))
})
}
shinyApp(ui, server)

Resources