Related
I am trying to create an app that will show you results depending on a selectInput and the changes are controlled by actionButtons.
When you launch the app, you have to select a choice: Data 1 or Data 2. Once you have selected your choice (e.g. Data 1), you have to click the actionButton "submit type of data". Next, you go to the second tab, choose a column and then click "submit".
The output will be: one table, one text and one plot.
Then, if you go back to the first tab and select "Data 2", everything that you have generated is still there (as it is expected, since you didn't click any button).
However, I would like to remove everything that is in the mainPanel if I change my first selectInput as you could see it when you launch the app for the first time.
The idea is that since you have changed your first choice, you will have to do the same steps again (click everything again).
I would like to preserve and control the updates with actionButtons as I have in my code (since I am working with really long datasets and I don't want to depend on the speed of loading things that I don't want until I click the button). Nevertheless, I cannot think a way to remove everything from mainPanel if I change the choice of the first selectInput.
Does anybody have an idea how I can achieve this?
Thanks in advance
Code:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
library(datasets)
ui <- fluidPage(
sidebarPanel(
tabsetPanel(id="histogram",
tabPanel("Selection",
useShinyFeedback(),
selectInput(inputId = "type", label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")),
conditionalPanel(
condition = "input.type == 'data2'",
div(style = "position:absolute;right:2.5em;",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"))
)
),
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check")
)
),
tabPanel("Pick the column",
br(),
selectizeInput(inputId = "list_columns", label = "Choose the column:", choices=character(0)),
actionButton(
inputId = "button2",
label = "Submit")
))
),
mainPanel(
dataTableOutput("table"),
textOutput("text"),
plotOutput("myplot")
)
)
server <- function(input, output, session) {
observeEvent(input$type,{
feedbackWarning(inputId = "type",
show = ("data2" %in% input$type),
text ="This data is... Please, be careful..."
)
})
mydata <- reactive({
if(input$type == "data1"){
mtcars
}else{
iris
}
}) %>% bindEvent(input$button2)
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$button, {
updateSelectizeInput(
session = session,
inputId = "list_columns",
choices = colnames(trees), options=list(maxOptions = length(colnames(trees))),
server = TRUE
)
})
output$table <- renderDataTable({
req(input$button2)
mydata()
})
output$text <- renderText({
req(input$button2)
input$list_columns
})
output$myplot <- renderPlot({
req(input$button2, input$button)
hist(trees[,input$list_columns])
})
}
if (interactive())
shinyApp(ui, server)
Here is an example using a reset button - using the selectInput you'll end up with a circular reference:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
library(datasets)
ui <- fluidPage(sidebarPanel(tabsetPanel(
id = "histogram",
tabPanel(
"Selection",
useShinyFeedback(),
selectInput(
inputId = "type",
label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")
),
conditionalPanel(
condition = "input.type == 'data2'",
div(
style = "position:absolute;right:2.5em;",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle")
)
)
),
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check")
),
actionButton(
inputId = "reset",
label = "Reset",
icon = icon("xmark")
)
),
tabPanel(
"Pick the column",
br(),
selectizeInput(
inputId = "list_columns",
label = "Choose the column:",
choices = character(0)
),
actionButton(inputId = "button2",
label = "Submit")
)
)),
mainPanel(
dataTableOutput("table"),
textOutput("text"),
plotOutput("myplot")
))
server <- function(input, output, session) {
observeEvent(input$type, {
feedbackWarning(
inputId = "type",
show = ("data2" %in% input$type),
text = "This data is... Please, be careful..."
)
})
mydata <- reactiveVal(NULL)
observe({
if (input$type == "data1") {
mydata(mtcars)
} else if (input$type == "data2") {
mydata(iris)
} else {
mydata(data.frame())
}
}) %>% bindEvent(input$button2)
observeEvent(input$reset, {
mydata(data.frame())
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$button, {
updateSelectizeInput(
session = session,
inputId = "list_columns",
choices = colnames(trees),
options = list(maxOptions = length(colnames(trees))),
server = TRUE
)
})
output$table <- renderDataTable({
req(input$button2)
mydata()
})
output$text <- renderText({
req(input$button2)
input$list_columns
})
output$myplot <- renderPlot({
req(input$button2, input$button)
hist(trees[, input$list_columns])
})
}
shinyApp(ui, server)
I am creating a shiny app where depending on your selectInput, you will see an extra actionButton or not. In order to get that, this extra button has to be inside a conditionalPanel.
I want to have both actionButtons aligned, the regular one on the left and the extra, on the right. Thanks to this post I managed to move it to the right, but they are not aligned as you can see in the attached image.
Code:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
ui <- fluidPage(
sidebarPanel(
useShinyFeedback(),
selectInput(inputId = "type", label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")),
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check")
),
conditionalPanel(
condition = "input.type == 'data2'",
div(style = "position:absolute;right:1em;",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"))
)
)
),
mainPanel(
dataTableOutput("table")
)
)
server <- function(input, output, session) {
observeEvent(input$button, {
if(input$type == "data2"){
show_alert(
title = "Are you sure?",
text = HTML("This data is....<br>Please, be careful with..."),
type = "warning",
html = TRUE
)
}else{
show_alert(
title = "OK",
text = "You don't have to do anything",
type = "success"
)
}
})
observeEvent(input$type,{
feedbackWarning(inputId = "type",
show = ("data2" %in% input$type),
text ="This data is... Please, be careful..."
)
})
mydata <- reactive({
if(input$type == "data1"){
mtcars
}else{
iris
}
}) %>% bindEvent(input$button)
output$table <- renderDataTable(mydata())
}
if (interactive())
shinyApp(ui, server)
I also tried what they answered in:
1- This post, but it doesn't work for me because I am not working with columns.
conditionalPanel(
condition = "input.type == 'data2'",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"),
style = 'margin-top:25px'
)
)
2- These two from this post:
conditionalPanel(
condition = "input.type == 'data2'",
div(style="display:inline-block",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"),
style="float:right")
)
)
conditionalPanel(
condition = "input.type == 'data2'",
div(style = "display:inline-block; float:right",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"))
)
)
3- And this option (but I think it depends on another actionButton and it doesn't work for me).
conditionalPanel(
condition = "input.type == 'data2'",
div(style = "display:inline-block",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"))
)
)
Does anybody know how to have both actionButtons aligned?
Thanks in advance
I found the solution by chance.
The order of the conditionalPanel has to be moved before the regular actionButton and instead of writing 1em, it would be 2.5em to have the button and the selectInput justified.
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
ui <- fluidPage(
sidebarPanel(
useShinyFeedback(),
selectInput(inputId = "type", label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")),
conditionalPanel(
condition = "input.type == 'data2'",
div(style = "position:absolute;right:2.5em;",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"))
)
),
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check")
),
),
mainPanel(
dataTableOutput("table")
)
)
server <- function(input, output, session) {
observeEvent(input$button, {
if(input$type == "data2"){
show_alert(
title = "Are you sure?",
text = HTML("This data is....<br>Please, be careful with..."),
type = "warning",
html = TRUE
)
}else{
show_alert(
title = "OK",
text = "You don't have to do anything",
type = "success"
)
}
})
observeEvent(input$type,{
feedbackWarning(inputId = "type",
show = ("data2" %in% input$type),
text ="This data is... Please, be careful..."
)
})
mydata <- reactive({
if(input$type == "data1"){
mtcars
}else{
iris
}
}) %>% bindEvent(input$button)
output$table <- renderDataTable(mydata())
}
if (interactive())
shinyApp(ui, server)
shinyApp(ui, server)
Here is an approach using a column() construct:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
ui <- fluidPage(
useShinyFeedback(),
sidebarPanel(
selectInput(
inputId = "type",
label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")
),
fluidRow(
column(4,
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check"),
width = "100%"
)
),
column(4,
conditionalPanel(
condition = "input.type == 'data2'",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"),
width = "100%"
)
),
offset = 4
)
)
),
mainPanel(dataTableOutput("table"))
)
server <- function(input, output, session) {
observeEvent(input$button, {
if (input$type == "data2") {
show_alert(
title = "Are you sure?",
text = HTML("This data is....<br>Please, be careful with..."),
type = "warning",
html = TRUE
)
} else{
show_alert(title = "OK",
text = "You don't have to do anything",
type = "success")
}
})
observeEvent(input$type, {
feedbackWarning(
inputId = "type",
show = ("data2" %in% input$type),
text = "This data is... Please, be careful..."
)
})
mydata <- reactive({
if (input$type == "data1") {
mtcars
} else{
iris
}
}) %>% bindEvent(input$button)
output$table <- renderDataTable(mydata())
}
if (interactive())
shinyApp(ui, server)
And another one using splitLayout:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
ui <- fluidPage(
useShinyFeedback(),
sidebarPanel(
selectInput(
inputId = "type",
label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")
),
splitLayout(cellWidths = c("45%", "10%", "calc(45% - 8px)"), actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check"),
width = "100%"
),
div(),
conditionalPanel(
condition = "input.type == 'data2'",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"),
width = "100%"
)
))
),
mainPanel(dataTableOutput("table"))
)
server <- function(input, output, session) {
observeEvent(input$button, {
if (input$type == "data2") {
show_alert(
title = "Are you sure?",
text = HTML("This data is....<br>Please, be careful with..."),
type = "warning",
html = TRUE
)
} else{
show_alert(title = "OK",
text = "You don't have to do anything",
type = "success")
}
})
observeEvent(input$type, {
feedbackWarning(
inputId = "type",
show = ("data2" %in% input$type),
text = "This data is... Please, be careful..."
)
})
mydata <- reactive({
if (input$type == "data1") {
mtcars
} else{
iris
}
}) %>% bindEvent(input$button)
output$table <- renderDataTable(mydata())
}
if (interactive())
shinyApp(ui, server)
You can set the attribute align in column() to either left or right as you wish:
library(shiny)
library(shinyWidgets)
library(shinyFeedback)
library(DT)
ui <- fluidPage(
useShinyFeedback(),
sidebarPanel(
selectInput(
inputId = "type",
label = "Select your data",
choices = c("Data 1" = "data1",
"Data 2" = "data2")
),
fluidRow(
column(
width = 6,
align = "left",
actionButton(
inputId = "button",
label = "Submit type of data",
icon = icon("check"),
width = "100%"
)
),
column(
width = 6,
align = "right",
conditionalPanel(
condition = "input.type == 'data2'",
actionButton(
inputId = "button_more_info_data2",
label = "More info",
icon = icon("info-circle"),
width = "100%"
)
)
)
)
),
mainPanel(dataTableOutput("table"))
)
server <- function(input, output, session) {
observeEvent(input$button, {
if (input$type == "data2") {
show_alert(
title = "Are you sure?",
text = HTML("This data is....<br>Please, be careful with..."),
type = "warning",
html = TRUE
)
} else{
show_alert(title = "OK",
text = "You don't have to do anything",
type = "success")
}
})
observeEvent(input$type, {
feedbackWarning(
inputId = "type",
show = ("data2" %in% input$type),
text = "This data is... Please, be careful..."
)
})
mydata <- reactive({
if (input$type == "data1") {
mtcars
} else{
iris
}
}) %>% bindEvent(input$button)
output$table <- renderDataTable(mydata())
}
if (interactive())
shinyApp(ui, server)
I would like to create a dynamic app that depending on an input pops out other inputs or not. In the code below I want to pop out the checkboxInput with label x when the selectInput with label mdl is "First model". When I run the app and select the First model from the list the other checkboxInput does not appear. I know the condition has to be in javascript but I don't know that language. However I think that one of the conditions is right. Any suggestions? i have tried both codes shown below.
library(shiny)
ui <- fluidPage(
selectInput(inputId = "mdl", label = "Model", choices = list("First model",
"Second model", "Third model"),
conditionalPanel(
condition = "input.mdl == 'First model'",
checkboxInput(inputId = "x", label = "Length")
)
),
)
server <- function(input, output){
}
shinyApp(ui = ui, server = server)
library(shiny)
ui <- fluidPage(
selectInput(inputId = "mdl", label = "Model", choices = list("First model",
"Second model", "Third model"),
conditionalPanel(
condition = "input.mdl == First model",
checkboxInput(inputId = "x", label = "Length")
)
),
)
server <- function(input, output){
}
shinyApp(ui = ui, server = server)
This code gives me one tab. I would like to be able to add more tabs to it to make some plots, use the aggregate function may be. I tired to add a second tabPanel( object inside my tabsetPanel( but did not work.
I will be obliged if someone could help me with this
library(shiny)
library(dplyr)
ui <- fluidPage(
tabsetPanel(
tabPanel("Table", fluid = TRUE,
sidebarLayout(position = "left",
sidebarPanel("sidebar panel",
selectInput(inputId = "table",
label = "Choose a Supplier",
"Names"),
actionButton(inputId = "btn",label="Update")
),
mainPanel("main panel",
tableOutput("myTable")
)))
))
server <- function(input, output,session)
{
GlassSupplier <- c('Supplier 1','Supplier 2','Supplier 1','Supplier 4','Supplier 2')
WindowType <- c('Wood','Vinyl','Aluminum','Aluminum','Vinyl')
BreakageRate <- c(7.22,6.33,3.63,2,6)
df<- data.frame(GlassSupplier,WindowType,BreakageRate)
data <- eventReactive(input$btn, {
req(input$table)
df %>% dplyr::filter(GlassSupplier %in% input$table) %>%
group_by(WindowType) %>%
dplyr::summarise(BrkRate = mean(BreakageRate))
})
#Update SelectInput Dynamically
observe({
updateSelectInput(session, "table", choices = df$GlassSupplier)
})
output$myTable = renderTable({
data()
})
}
shinyApp(ui,server)
Think of tabsetPanel as any other slider/button, you can insert it inside the sidebar, in the main panel, or before the sidebarLayout.
code for ui:
u <- shinyUI(fluidPage(
titlePanel("title panel"),
sidebarLayout(position = "left",
sidebarPanel("sidebar panel",
selectInput(inputId = "table",
label = "Choose a Supplier",
"Names"),
actionButton(inputId = "btn",label="See Table"),
checkboxInput("donum1", "Make #1 plot", value = T),
checkboxInput("donum2", "Make #2 plot", value = F),
checkboxInput("donum3", "Make #3 plot", value = F),
checkboxInput("donum4", "Make #4 plot", value = F),
sliderInput("wt1","Weight 1",min=1,max=10,value=1),
sliderInput("wt2","Weight 2",min=1,max=10,value=1),
sliderInput("wt3","Weight 3",min=1,max=10,value=1),
sliderInput("wt4","Weight 4",min=1,max=10,value=1)
),
mainPanel("main panel",
tabsetPanel(
tabPanel("Plot", column(6,plotOutput(outputId="plotgraph", width="500px",height="400px"))),
tabPanel('Table', tableOutput("myTable")))
))))
I am trying to create a shiny app with multiple tabs. Each tab is to have its own sidebar. I haven't been able to get this to work. Any help on what is wrong would be appreciated.
Below is the code
ui <- fluidPage(
titlePanel("Hi"),
sidebarLayout(position = "left",
sidebarPanel(
conditionalPanel(condition = "input.tabs1==1",
selectizeInput('invar',"Reg in", choices = varnames, multiple = TRUE)),
conditionalPanel(condition = "input.tabs1==2",
selectizeInput('outvar',"Reg out", choices = predictors, multiple = FALSE)),
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("input",value=1,plotOutput("Input"),
tabPanel("output",value=2,plotOutput("Output")
))))
))
First of all, check your code again. You made following mistakes:
one tabPanel is nested inside the other one
there's an extra comma at the end of the second conditionalPanel(), so you pass an empty element to sidebarPanel()
If I correct your mistakes and create a mock example, it works perfectly fine as is. So there isn't really a problem here:
ui <- fluidPage(
titlePanel("Hi"),
sidebarLayout(position = "left",
sidebarPanel(
conditionalPanel(condition = "input.tabs1==1",
selectizeInput('invar',"Reg in", choices = letters[1:3], multiple = TRUE)),
conditionalPanel(condition = "input.tabs1==2",
selectizeInput('outvar',"Reg out", choices = letters[4:6], multiple = FALSE))
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("input",value=1,plotOutput("Input")),
tabPanel("output",value=2,plotOutput("Output"))
)
)
))
server <- function(input, output, session){
output$Input <- renderPlot(plot(1))
output$Output <- renderPlot(plot(2))
}
shinyApp(ui, server)
You could do this as well by using renderUI:
ui <- fluidPage(
titlePanel("Hi"),
sidebarLayout(position = "left",
sidebarPanel(
uiOutput("mysidebar")
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("input",value=1,plotOutput("Input")),
tabPanel("output",value=2,plotOutput("Output")
)))
))
server <- function(input, output, session){
output$mysidebar <- renderUI({
if(input$tabs1 == 1){
selectizeInput('invar',"Reg in", choices = letters[1:3])
} else if(input$tabs1 == 2){
selectizeInput('outvar',"Reg out", choices = letters[4:6])
}
})
}
shinyApp(ui,server)
I do this in a very different but effective way.
shinyApp(
shinyUI(
fluidPage(
uiOutput('mainpage')
)
),
shinyServer(function(input, output, session) {
panel <- reactiveValues(side = NULL)
output$mainpage <- renderUI({
sidebarLayout(position = "left",
sidebarPanel(
uiOutput(panel$side)
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("input",value=1,plotOutput("Input")),
tabPanel("output",value=2,plotOutput("Output"))
)
)
})
output$sideinput <- renderUI({
tagList(
selectizeInput('invar',"Reg in", choices = varnames, multiple = TRUE))
)
})
output$sideoutput <- renderUI({
tagList(
selectizeInput('outvar',"Reg out", choices = predictors, multiple =FALSE)
)
})
observeEvent(input$tabs1,{
panel$side <- switch(input$tabs1,
1 = 'sideinput',
2 = 'sideoutput')
})
basically I am using observers as my conditionals and assigning the value of the desired panel to the variable name assigned to that panel position