Hello everyone I'm trying to write a function in Shiny R.
I have checkboxgroupinput like this:
checkboxGroupInput("quality", "Columns in quality to show:",
choices = numbers, selected = numbers, width = '50%' ), width =2)
I want a histogram to appear when at least one box is selected otherwise it shows helptex("please select at least one").
How can I do this?
library(shiny)
ui <- fluidPage(
br(),
checkboxGroupInput(
"quality", "Columns in quality to show:",
choices = c("A", "B", "C"), selected = c("A", "B", "C"), width = "50%"
),
br(),
conditionalPanel(
condition = "input.quality.length === 0",
helpText("Select at least one column")
),
conditionalPanel(
condition = "input.quality.length !== 0",
plotOutput("histo")
)
)
server <- function(input, output, session){
output[["histo"]] <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = 11)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
}
shinyApp(ui, server)
Related
I'm trying to mimic this specific shiny app. https://columbia.shinyapps.io/yingli/
I haven't found similar apps with access to the code.
I have Leonardo DiCaprio gif in the background, but I would like to know how to add tabs the same way as the app below, and if you click on the right directional key, it will go to other tabs, within the tab.
if (interactive()) {
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
tags$h2("Add a shiny app background image"),
setBackgroundImage(
src = "https://blog.hubspot.com/hubfs/Smiling%20Leo%20Perfect%20GIF.gif"
),
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput(outputId = "distPlot")
)
)
)
server <- function(input, output, session) {
# 2. Its output type is a plot
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
}
shinyApp(ui, server)
}
For completeness, here's a example using the awesome fullPage library mentioned in the comments:
# Dependencies install
# install.packages("remotes")
# remotes::install_github("RinteRface/fullPage")
library(shiny)
library(fullPage)
options <- list(
sectionsColor = c('#f2f2e2', '#f2f2f2', '#f2f2f2'),
parallax = TRUE
)
ui <- fullPage(
menu = c("Full Page" = "tab1","Sections" = "tab2","Image" = "tab3"),
opts = options,
fullSection(
center = TRUE,
menu = "tab1",
tags$h1("fullPage.js meets Shiny")
),
fullSection(
menu = "tab2",
fullRow(
fullColumn(
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30)
),
fullColumn(
plotOutput(outputId = "distPlot")
)
)
),
fullSectionImage(
menu = "tab3",
img = "https://blog.hubspot.com/hubfs/Smiling%20Leo%20Perfect%20GIF.gif"
)
)
server <- function(input, output){
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
}
shinyApp(ui, server)
Although the fullpage.js library that it is used allow some configuration to use left/right keys to navigate, the shiny wrapper library above doesn't seem to expose that setting - I could only disable/enable the keyboard, but not choose direction.
I am having problems using conditional statements in Shiny. I want the user select number of variable. If choose 1 variable then plot chart of 1 variable (ex density plot), if choose 2 variable then plot chart of 2 variables (ex scatter plot). I have tried a few ways, but the output is not as my expected. How can i use if else statement in Shiny server? Tks
UI
df <- mtcars
ui <- fluidPage(
h1("My first app",
style = 'color: green;
font-style: italic'),
hr(),
fluidRow(
sidebarPanel(
radioButtons(inputId = "number",
label = "Select number of variable",
choices = c("1 variable" = 1,
"2 variable" = 2)),
selectInput(inputId = "x",
label = "Variable 1",
choices = names(df)),
conditionalPanel(
condition = "input.number == 2",
selectInput(inputId = "y",
label = "Variable 2",
choices = names(df))
)
),
column(8, plotOutput("plot"))
),
hr(),
plotOutput("plot") )
Server
server <- function(input, output, session){
observeEvent(input$x,
{updateSelectInput(session,
inputId = "y",
label = "Variable 2",
choices = names(df)[names(df) != input$x])
})
data <- reactive({
if(input$number == 1){
data <- df %>%
select(input$x)
} else {
data <- df %>%
select(input$x, input$y)
}
})
output$plot <- renderPlot({
if(input$number == 1){
ggplot(data = data(),
x = get(input$x))+
geom_density()
} else {
ggplot(data = data,
x = get(input$x),
y = get(input$y)) +
geom_point()
}
})
}
shinyApp(ui = ui, server = server)
You can try the following code -
plotOutput("plot") was mentioned twice, removed it to include it only once.
We don't need to check for conditions while creating the dataset in reactive, handle it in the plot code itself.
Use .data to refer column names in ggplot code.
library(shiny)
library(ggplot2)
df <- mtcars
ui <- fluidPage(
h1("My first app",
style = 'color: green;
font-style: italic'),
hr(),
fluidRow(
sidebarPanel(
radioButtons(inputId = "number",
label = "Select number of variable",
choices = c("1 variable" = 1,
"2 variable" = 2)),
selectInput(inputId = "x",
label = "Variable 1",
choices = names(df)),
conditionalPanel(
condition = "input.number == 2",
selectInput(inputId = "y",
label = "Variable 2",
choices = names(df))
)
),
column(8, plotOutput("plot"))
)
)
server <- function(input, output, session){
data <- reactive({
df
})
observeEvent(input$x,
{updateSelectInput(session,
inputId = "y",
label = "Variable 2",
choices = names(df)[names(df) != input$x])
})
output$plot <- renderPlot({
if(input$number == 1){
plot <- ggplot(data = data(), aes(x = .data[[input$x]])) + geom_density()
} else {
plot <- ggplot(data = data(),
aes(x = .data[[input$x]], y = .data[[input$y]])) +
geom_point()
}
plot
})
}
shinyApp(ui = ui, server = server)
You could use aes_string.
Another very important point is never to use the same output twice in UI:
df <- mtcars
library(ggplot2)
library(dplyr)
ui <- fluidPage(
h1("My first app",
style = 'color: green;
font-style: italic'),
hr(),
fluidRow(
sidebarPanel(
radioButtons(inputId = "number",
label = "Select number of variable",
choices = c("1 variable" = 1,
"2 variable" = 2)),
selectInput(inputId = "x",
label = "Variable 1",
choices = names(df)),
conditionalPanel(
condition = "input.number == 2",
selectInput(inputId = "y",
label = "Variable 2",
choices = names(df))
)
),
column(8, plotOutput("plot"))
),
hr()
# Never use output twice : the UI won't work!
#plotOutput("plot")
)
server <- function(input, output, session){
observeEvent(input$x,
{updateSelectInput(session,
inputId = "y",
label = "Variable 2",
choices = names(df)[names(df) != input$x])
})
data <- reactive({
if(input$number == 1){
data <- df %>%
select(input$x)
} else {
data <- df %>%
select(input$x, input$y)
}
})
output$plot <- renderPlot({
cat(input$x)
if(input$number == 1){
ggplot(data = data())+
geom_density(aes_string(x=input$x))
} else {
ggplot(data = data()) +
geom_point(aes_string(x=input$x,y=input$y))
}
})
}
shinyApp(ui = ui, server = server)
I want to add a burger menu in the navbar to toggle a sidebar in a shiny app.
This might get you started:
library(shiny)
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
conditionalPanel(condition = "input.toggleSidebarPanel % 2 == 0", sidebarPanel(
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30)
)),
mainPanel(actionButton("toggleSidebarPanel", "", icon = icon("bars")),
plotOutput(outputId = "distPlot")
)
)
)
server <- function(input, output, session) {
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
}
shinyApp(ui, server)
I want to give the user option to select which plots/tables he/she wants to see at the end of an analysis.
All the plots are produced from one dataset and include time series plots, boxplots, histograms etc.
The questions I stumbled upon are
Do I use one or multiple plotOutput("Plot",....) element? So far I have been arranging plots in one figure so one plotOutput was sufficient
Do I use the predefined height, as in plotOutput("Plot",height = "1800px")?
If the number of figures varies this creates empty space, I would like to avoid it.
How to add Tables with results?
Any comments would be very appreciated, Mac
You can wrap you plots in conditionalPanel's to deselect them.
For this you will need 1. multiple plotOutput's.
2. When everything is wrapped in a fluidRow there won't be any empty space.
3. See the following example and: http://shiny.rstudio.com/reference/shiny/0.14/tableOutput.html
library(shiny)
library(shinydashboard)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(title = "Plot selection"),
dashboardSidebar(
materialSwitch(inputId="switch1", label = "Show plot 1", value = TRUE, status = "primary"),
materialSwitch(inputId="switch2", label = "Show plot 2", value = TRUE, status = "primary"),
materialSwitch(inputId="switch3", label = "Show plot 3", value = TRUE, status = "primary"),
materialSwitch(inputId="switch4", label = "Show plot 4", value = TRUE, status = "primary")
),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
conditionalPanel(condition = "input.switch1", box(plotOutput("plot1", height = 250))),
conditionalPanel(condition = "input.switch2", box(plotOutput("plot2", height = 250))),
conditionalPanel(condition = "input.switch3", box(plotOutput("plot3", height = 250))),
conditionalPanel(condition = "input.switch4", box(plotOutput("plot4", height = 250))),
column(12,
dataTableOutput('table')
)
)
)
)
server <- function(input, output) {
df <- data.frame(col1 = rnorm(500), col2 = rnorm(500), col3 = rnorm(500), col4 = rnorm(500))
output$plot1 <- renderPlot({
plot(df$col1, col="red", main="Plot 1")
})
output$plot2 <- renderPlot({
plot(df$col2, col="green", main="Plot 2")
})
output$plot3 <- renderPlot({
plot(df$col3, col="blue", main="Plot 3")
})
output$plot4 <- renderPlot({
plot(df$col4, col="black", main="Plot 4")
})
output$table <- renderDataTable(df)
}
shinyApp(ui, server)
Edit ----------------------------------------
Here is a pure shiny version:
library(shiny)
ui <- fluidPage(
titlePanel("Plot selection"),
sidebarLayout(
sidebarPanel(width = 2,
checkboxInput(inputId="switch1", label = "Show plot 1", value = TRUE),
checkboxInput(inputId="switch2", label = "Show plot 2", value = TRUE),
checkboxInput(inputId="switch3", label = "Show plot 3", value = TRUE),
checkboxInput(inputId="switch4", label = "Show plot 4", value = TRUE)
),
mainPanel(
fluidRow(
conditionalPanel(condition = "input.switch1", plotOutput("plot1", height = 250)),
conditionalPanel(condition = "input.switch2", plotOutput("plot2", height = 250)),
conditionalPanel(condition = "input.switch3", plotOutput("plot3", height = 250)),
conditionalPanel(condition = "input.switch4", plotOutput("plot4", height = 250)),
column(12,
dataTableOutput('table')
)
)
)
)
)
server <- function(input, output) {
df <- data.frame(col1 = rnorm(500), col2 = rnorm(500), col3 = rnorm(500), col4 = rnorm(500))
output$plot1 <- renderPlot({
plot(df$col1, col="red", main="Plot 1")
})
output$plot2 <- renderPlot({
plot(df$col2, col="green", main="Plot 2")
})
output$plot3 <- renderPlot({
plot(df$col3, col="blue", main="Plot 3")
})
output$plot4 <- renderPlot({
plot(df$col4, col="black", main="Plot 4")
})
output$table <- renderDataTable(df)
}
# shinyApp(ui, server)
shinyApp(ui = ui, server = server)
For further information see:
https://rstudio.github.io/shinydashboard/get_started.html
https://dreamrs.github.io/shinyWidgets/reference/materialSwitch.html
I am having an weird issue when using conditional panels.
I have something similar to this
shinyUI(bootstrapPage(
selectInput(inputId = "graphT",
label = "Type of Graph :",
choices = c("x","y"),
selected = "x"),
conditionalPanel(
condition = "input.graphT == 'x'",
plotOutput(outputId = "plot1")),
conditionalPanel(
condition = "input.graphT == 'y'",
splitLayout(
cellWidths = c("50%", "50%"),
plotOutput(outputId = "plot1"),
plotOutput(outputId = "plot2")
))
))
If I remove either of the condition panels, the other renders when I select the correct option. However if I keep both conditional panels nothing shows, I don't get any error or message, it's like I am not sending any input. What gives?
The problem is that you have two outputs with the same id plot1. If you change in this chunk outputId to plot3
conditionalPanel(
condition = "input.graphT == 'x'",
plotOutput(outputId = "plot1")),
and render the third plot on the server side it will work.
Example:
library(shiny)
ui <- shinyUI(bootstrapPage(
selectInput(inputId = "graphT",
label = "Type of Graph :",
choices = c("x","y"),
selected = "x"),
conditionalPanel(
condition = "input.graphT == 'x'",
plotOutput(outputId = "plot3")),
conditionalPanel(
condition = "input.graphT == 'y'",
splitLayout(
cellWidths = c("50%", "50%"),
plotOutput(outputId = "plot1"),
plotOutput(outputId = "plot2")
))
))
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(1)
})
output$plot2 <- renderPlot({
plot(1:10)
})
output$plot3 <- renderPlot({
plot(1:100)
})
}
shinyApp(ui, server)