Conditional Main Panel in Shiny - r

I'm building a Shiny App where I want the Main Panel to be dynamic, such that when one drop down menu is chosen a new plot is created. I understand how to do it where the plots are on top of each other (which sucks because I have table underneath that and the User will have to scroll down). What would be great is if the Main Panel Graph just 'switches'. I'm not sure if ConditinalPanel would work here? Or even a Switch statement? Here is my UI.
source("DATA CLEANING.R")
salespeople <- sort(unique(salesdatav3$SALESPERSON))
# Define UI for application that draws a histogram
ui <- fluidPage(theme = shinytheme("united"),
# Application title
titlePanel("Pounds_New"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
pickerInput("slsp", "SalesPerson", choices = salespeople, selected =NULL, options = list(`actions-box` = TRUE), multiple = T),
pickerInput("stats", "Summary Stats", choices = as.vector(c("Positive/Negative Count", "Histogram", "Plot Pounds by Time", "Top Ten Positive Trending",
"Top Ten Negative Trending")), selected = NULL, multiple = F, list(`actions-box` = TRUE))
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("sidebarplot"),
# conditionalPanel(
# condition = "input.stats == 'Histogram'",
# plotOutput("histt"),
# conditionalPanel(
# condition = "input.slsp",
DT::dataTableOutput("data_table"),
plotOutput("plot_pounds")
)
)
)

Yes, you can certainly have conditional panels in the mainPanel plotting area. Your code was quite close to being workable (just one or two errant parentheses). Below is revised code with and dummy plots to show how it works. You'll obviously have to update with what you actually want for plots. The basic structure should be quite clear. In the UI, just include your conditionalPanels in the mainPanel items, and then specify your plots separately in the server.
UI:
library(shiny)
library(shinythemes)
library(shinyWidgets)
ui <- fluidPage(theme = shinytheme("united"),
# Application title
titlePanel("Pounds_New"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
pickerInput("slsp", "SalesPerson", choices = c("a","b","c","d"), selected =NULL, options = list(`actions-box` = TRUE), multiple = T),
pickerInput("stats", "Summary Stats", choices = as.vector(c("Positive/Negative Count", "Histogram", "Plot Pounds by Time", "Top Ten Positive Trending",
"Top Ten Negative Trending")), selected = NULL, multiple = F, list(`actions-box` = TRUE))
),
# Show a plot of the generated distribution
mainPanel(
conditionalPanel(
condition = "input.stats == 'Positive/Negative Count'",
plotOutput("sidebarplot")
),
conditionalPanel(
condition = "input.stats == 'Histogram'",
plotOutput("histt")
),
conditionalPanel(
condition = "input.slsp",
# DT::dataTableOutput("data_table"),
plotOutput("plot_pounds")
)
)
)
)
Server:
server <- function(input, output) {
output$sidebarplot <- renderPlot({
hist(rnorm(50),10)
})
output$histt <- renderPlot({
hist(runif(50),10)
})
output$plot_pounds <- renderPlot({
hist(rbeta(50,1,5),10)
})
}
shinyApp(ui, server)

Related

R shiny: create variable in eventReactive that is used inside the defined function

I want to create a shny app that creates a interactive treemap.
The treemap should contain up to three layers, depending on user's choice.
The user can specify one, two or three layers, choosing from a dropdown list for each layer.
Hitting an actioButton, the map should be produced.
The ui part
ui <- fluidPage(
# Application title
navbarPage("Ist-Analyse Biodiversitätsmonitoring in Deutschland",
#####
tabPanel("Treemap", fluid = T,
sidebarLayout(
sidebarPanel(
radioButtons(inputId = "status",
label = "Programm - Status",
choices = c("Alle" = "Alle",
"laufend" = "laufend",
"in Erprobung" = "in Erprobung",
"in Entwicklung" = "in Entwicklung",
"beendet" = "beendet"),
selected = c("Alle")
),
br(),
selectInput(inputId = "level1",
label = "Ebene 1",
choices = Auswahl$Titel[Auswahl$use_treemaps == 1],
selected = Auswahl$Titel[Auswahl$use_treemaps == 1][1]),
br(),
selectInput(inputId = "level2",
label = "Ebene 2",
choices = Auswahl$Titel[Auswahl$use_treemaps == 1],
selected = c(''),
br(),
selectInput(inputId = "level3",
label = "Ebene 3",
choices = c('',
Auswahl$Titel[Auswahl$use_treemaps == 1]),
selected = c('')),
actionButton(inputId = "submit",
label = "Los!",
icon = icon("table")
)
),
mainPanel(
d3tree3Output(outputId = "treemap",
width = "100%",
height = "400px"),
)
)
)
)
)
The server part
server <- function(input, output) {
### determine, how many levels to drill down
## therefore, I bind together the selected levels (1 to 4) in tab "Treemap"
treemap_reactive <- eventReactive(input$submit, {
#####
drill_levels<- c(input$level1,
input$level2,
input$level3)
## then, depending on lenght(drill_levels), the treemaps
## are composed to the defined level of depth
drill_levels<- drill_levels[-c(which(drill_levels=''))]
treemap<-treemap(groups.1,
index=drill_levels,
vSize="value",
type="index",
na.rm=T,
draw=F)
d3tree3(treemap,
rootname = c("Treemap")
)
}
)
output$treemap <- renderD3tree3({
treemap_reactive()
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
The group.1 datatset is the dataset containing the information to be visualized.
If I start the app, choose my levels (either one, two or tree) and hit the actionButton
I get an error "can't find object 'drill_levels'"
However, if I run the code with pre-defining 'drill_levels' in the R global envronment, the code works exactly as I expected.
So the problem seems to be that the variable 'drill_levels' is not created inside the eventReactive() function.
Does someone have an idea how to solve the issue?

Using withSpinner with an interactive uiOutput in R Shiny

I have recently written a Shiny app that takes user data input, does some analysis on it, and then displays the results, including graphs. These graphs take a while to render, so I am using withSpinner to inform the users that Shiny is busy and to be patient and wait for the graphs to appear. The graphs are displayed within boxes that have titles informing the users what the graphs show.
What gets displayed to the users depends on the data they provide to the app (how many items of data are provided in their input file) and also which options they choose from within the app (using checkboxes).
The withSpinner function works well for the graphs when wrapped around plotOutput and called from within ui (see line 38 of the example code below).
However, to use this approach for all graphs would require me to know how many items of data the users are likely to provide and then want to view. I would like to just automatically produce a graph, with a spinner, for each data item, without knowing how many there are in advance.
Placing withSpinner within the server doesn’t work at all (lines 58-65), which makes sense. However, if I use it in the ui around the uiOutput object for all of the boxes and graphs (line 29), the spinner only shows until the boxes are rendered – the graphs then appear about a minute later…
Please can you help me to work out how to get the spinners to show until the graphs are rendered? Thank you for any help you can give!
library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinycssloaders)
library(survival)
ui <- dashboardPage(
skin = "blue",
dashboardHeader(title = "My App"),
dashboardSidebar(
sidebarMenu(
useShinyjs(),
id = "tabs",
menuItem("User Choice", tabName = "uChoice", icon = icon("sliders-h"))
)
),
dashboardBody(
id = "dashboardBody",
tabItems(
tabItem(
tabName = "uChoice",
h2("You have a choice"),
# Check boxes to select choice
fluidRow(
uiOutput("userChoiceCheckbox")
),
fluidRow(
# Only show the data graphs that the user has chosen to look at
withSpinner(uiOutput('chosenGraphs'), type=4)
# this spinner only shows until the box containing the graph is rendered
),
fluidRow(
# Always show lung graph
box(
title = paste("Here's the lung graph"),
width = 12,
height="50px",
withSpinner(plotOutput("lungGraph"), type=4)
# This spinner shows until the graph is plotted
)
)
)
)
)
)
server <- function(input, output, session) {
output$userChoiceCheckbox <- renderUI({
column(6, checkboxGroupInput(inputId = "choices", label = "Which graph(s) would you like to view?", choices = c("Lung", "PBC")))
})
output$chosenGraphs <- renderUI({
lapply(input$choices, function(x) {
box(
title = paste("Graph for", x,"cancer"),
width = 12,
renderPlot({
withSpinner(
# This spinner doesn't seem to work at all
plotOutput({
Sys.sleep(2)
plot(survfit(Surv(time, status) ~ 1, data = eval(as.symbol(tolower(x)))),
xlab = "Days",
ylab = "Overall survival probability")
})
)
})
)
})
})
output$lungGraph <- renderPlot(
plot(survfit(Surv(time, status) ~ 1, data = lung),
xlab = "Days",
ylab = "Overall survival probability")
)
}
shinyApp(ui, server)
In case you didn't find an answer, I couldn't add a single spinner per plot but the whole renderUI region can be wrapped by withSpinner() if you add it after the lapply().
In your case it would be something like this:
output$chosenGraphs <- renderUI({
lapply(input$choices, function(x) {
box(
title = paste("Graph for", x,"cancer"),
width = 12,
renderPlot({
plotOutput({
Sys.sleep(2)
plot(survfit(Surv(time, status) ~ 1, data = eval(as.symbol(tolower(x)))),
xlab = "Days",
ylab = "Overall survival probability")
})
})
)
}) %>% withSpinner()
})

how to create plotly line chart in shinyapp with multiple level variable

Hi im trying to plot simple chart using plotly in the Shiny app. It is a line chart with Frequency variable on the X-Axis and a Metric on y-axis. i'm expecting two lines in the charts as i'm calling in a variable that has two levels in the UI. i'm getting the chart when i have one input from the groupcheckbox, but the goes blank when i select two options. i dont know what i'm doing wrong here, I'm not getting any error notifications.thanks for your inputs in advance
pasting the code with data here.
library(shiny)
library(plotly)
library(readxl)
prod<-c("BrandB", "BrandA", "BrandB", "BrandA", "BrandB", "BrandA","BrandB","BrandA","BrandB","BrandA","BrandB","BrandA","BrandB","BrandA","BrandB","BrandA")
Freq<-c("W7","W7","W8","W8","W9","W9","W10","W10","W10","W10","W7","W7","W8","W8","W9","W9")
Metric1<-c(0.515,0.444,0.518,0.446,0.529,0.405,0.497,0.376,0.505,0.494,0.515,0.444,0.518,0.446,0.529,0.405)
Cut<-c("RBs","RBs","RBs","RBs","RBs","RBs","Total","Total","RBs","RBs","Total","Total","Total","Total","Total","Total")
DF<-data.frame(prod,Freq,Metric1,Cut)
str(DF)
DF$Brand<-as.factor(DF$prod)
DF$Wave<-factor(DF$Freq,levels=c("W7","W8","W9","W10"))
#View(DF)
ui <- fluidPage(
# useShinydashboard(),
titlePanel("Dassy"),
fluidRow(
column(3,
checkboxGroupInput(inputId = "Prod",
label = "Choose Fill For the Chart",
choices = c("BrandA" = "BrandA","BrandB" = "BrandB"),
selected = "BrandA"
)),
column(3,
selectInput(inputId = "Cut",
label = "Choose Fill For the Chart",
choices = c("Total" = "Total","RBs" = "RBs"),
selected = "Total")
),actionButton("go_button", "GO !")
),
mainPanel(
plotlyOutput("distPlot"))
)
server <- function(input, output) {
observeEvent(input$go_button,{
output$distPlot <- renderPlotly({
DF1 <- reactive({
DF%>%filter(Cut == input$Cut & prod == input$Prod)
}
)
p1<-plot_ly(DF1(),x=~Freq, y=~Metric1, color = ~prod, width=1200, height=300)%>% add_lines(line = list(shape = "spline"))
p1<-p1%>%layout(yaxis=list(tickformat ="%"))
})
#observe Event
})
}
#??plot_ly()
shinyApp(ui = ui, server = server)
With single option selected line graph generated
With two option selected blank chart gets generated

Removing UI drop-down element dynamically in R Shiny

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)

Adding an "ALL" option to dynamic selectInputs

I'm trying to add an ALL option in both of my dynamically linked selectInput widgets, which filters through to a graph in my main panel. Basically, I want the user to select a Service, e.g. Online or Mail-Order, or all services, and similarly with the Prof.Los column, I want the user to select either Profit or Loss, or a sum of both.
I'm not sure how to add this extra option when the two Inputs are dynamically linked. So my question is, how can I include an option to filter my data by ALL variables in both drop-down menus?
My library and data:
library("shiny")
library("plotly")
library("tidyverse")
library("dplyr")
data <- data.frame(Services = c("Online","Online","Online","Online","Online","Online","Online","Online","Online", "Online","Online","Online","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Mail-order","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop","Shop"),
Month = c("2013-01-01","2013-02-01","2013-03-01","2013-04-01","2013-05-01","2013-06-01","2013-07-01","2013-08-01","2013-09-01","2013-10-01","2013-11-01","2013-12-01","2013-01-01","2013-02-01","2013-03-01","2013-04-01","2013-05-01","2013-06-01","2013-07-01","2013-08-01","2013-09-01","2013-10-01","2013-11-01","2013-12-01","2013-01-01","2013-02-01","2013-03-01","2013-04-01","2013-05-01","2013-06-01","2013-07-01","2013-08-01","2013-09-01","2013-10-01","2013-11-01","2013-12-01"),
Sales = c(40,50,20,30,40,50,200,100,250,100, 120,130,40,80,20,30,30,50,400,100,150,100,75,50,100,50,700,30,40,50,100,120,220,100,75,150),
Prof.Los = c("Profit","Loss","Profit","Profit","Loss","Loss","Loss","Profit","Profit","Loss","Loss","Profit","Profit","Loss","Profit","Loss","Profit","Loss","Loss","Loss","Profit","Loss","Loss","Profit","Profit","Profit","Loss","Loss","Loss","Profit","Profit","Loss","Loss","Loss","Profit","Loss"))
My code:
UI
ui <- fluidPage(
# App title ----
titlePanel(h1("Analyser tool")),
# Sidebar layout with input and output definitions ----
sidebarLayout(
sidebarPanel(
# Input: Select service type ----
uiOutput("services"),
uiOutput("rev")
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Tabset w/ plot, summary, and table ----
tabsetPanel(type = "tabs",
tabPanel("Bar Chart", plotlyOutput("Plot", height = "450px"))
)
)
))
Server
server <- function(input, output) {
# Service analyser reactive dataset
output$services = renderUI({
selectInput("services",
"Select services:",
choices = unique(data$Services))
})
ServiceSub <- reactive({
data %>%
filter(Services == input$services)
})
output$rev = renderUI({
selectInput(inputId = "rev",
label = "Profit/loss",
choices = unique(ServiceSub()[,"Prof.Los"]),
selected = unique(ServiceSub()[,"Prof.Los"]))
})
RevSub <- reactive({
req(input$services)
filter(ServiceSub(), Prof.Los %in% input$rev)
})
output$Plot = renderPlotly({
# plotly code
plot_ly(RevSub(), x = ~Month, y = ~Sales, type = "bar")
})
}
# Create Shiny app ----
shinyApp(ui, server)
You can use pickerInput from {shinyWidgets}.
I ran your code, with the following adjustments:
pickerInput("services",
"Select services:",
choices = unique(data$Services),
multiple = TRUE,
selected = NULL,
options = list(
title = "Services",
#"max-options" = 1,
`actions-box` = TRUE,
`deselect-all-text` = "Remove"
))
pickerInput(inputId = "rev",
label = "Profit/loss",
choices = unique(ServiceSub()[,"Prof.Los"]),
selected = unique(ServiceSub()[,"Prof.Los"]),
multiple = TRUE,
options = list(
title = "Profit/loss",
#"max-options" = 1,
`actions-box` = TRUE,
`deselect-all-text` = "Remove"
))

Resources