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 need to show "fileinput"/file upload option when a particular tabpanel is selected.
Ex. There are 3 tabpanels like A,B and C
When tab B is selected the "fileinput" option should appear and when A or C is selected, the "fileinput" option should be hidden from the sidebarpanel.
I tried the below but not working. Can anyone help? Thanks...
sidebarPanel(
conditionalPanel(condition = "input$id == 'B'", fileInput("file", "Choose xlsx file", accept = ".xlsx"))
mainPanel(
tabsetPanel(
tabPanel("A", value = 'A', DT::dataTableOutput("Table A")),
tabPanel("B", value = 'B', DT::dataTableOutput("Table B")),
tabPanel("C", value = 'C', DT::dataTableOutput("Table C")),
id ="tabselected"
)
)
You need to use the appropriate ID of the tabsetPanel in the condition with a . instead of $. Try this
library(readxl)
runApp(list(
ui = shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel(
conditionalPanel(condition = "input.tabselected == 'tab2'",
fileInput("file", "Choose xlsx file", accept = ".xlsx")),
selectInput(
inputId = 'selected.indicator',
label = 'Select an option: ',
choices = colnames(mtcars)
)
),
mainPanel(
tabsetPanel(
tabPanel("A", value = 'tab1', DTOutput("t1")),
tabPanel("B", value = 'tab2', DTOutput("t2")),
tabPanel("C", value = 'tab3', DTOutput("t3")),
id ="tabselected"
)
)
)
)
),
server = function(input, output, session) {
output$t1 <- renderDT(cars)
output$t3 <- renderDT(mtcars)
mydata <- reactive({
req(input$file)
inFile <- input$file
df <- read_excel(inFile$datapath)
})
output$t2 <- renderDT({
req(mydata())
mydata()
})
}
))
I have a Shiny app where my dynamically generated UI won't display properly once I change a selectInput value.
Here, you can choose between two data frames. When you click the button, it generates a selectInput (whose values are the column names of the data frame) and checkboxInput UI (the unique values of the column you've selected). That's good and all but once I change the data frame I want to view, the selectInput values populate "accordingly" with the column names of the new data frame. However, the checkboxInput no longer displays.
ui <- fluidPage(
fluidRow(
column(4,
uiOutput("projectSelection"),
uiOutput("addCol")
)
),
fluidRow(
tags$div(id="rowLabel")
)
)
server <- function(input, output, session) {
Project.ID <- c("Test Project 1", "Test Project 1", "Test Project 1", "Test Project 1")
Project.ID2 <- c("Test Project 2", "Test Project 2", "Test Project 2", "Test Project 2")
Author.ID <- c("1234", "5234", "3253", "5325")
Fav.Color <- c("Blue", "Red", "Blue", "Green")
Author.Name <- c("Bob", "Jenny", "Bob", "Alice")
output$projectSelection <- renderUI(
selectInput("projectSelection",
"Project Name:",
c("Project1", "Project2"),
selectize=TRUE)
)
# update datatable
project <- reactive({
if(input$projectSelection == "Project1"){
projectDT <- data.frame(Project.ID, Author.ID, Author.Name)
}
if(input$projectSelection == "Project2"){
projectDT <- data.frame(Project.ID2, Author.Name, Fav.Color)
}
return(projectDT)
})
#Button to add comparison column
output$addCol <- renderUI({
input$projectSelection #re-render once projectSelection changes?
if(is.null(input$projectSelection)) return()
actionButton('addCol', strong("Add UI"), icon=icon("plus", class=NULL, lib="font-awesome"))
})
observeEvent({input$addCol},{
insertUI(
selector = "#rowLabel",
where = "beforeEnd",
ui = div(
fluidRow(
column(4,
uiOutput(paste0("showMeta",input$addCol)),
uiOutput(paste0("showVal",input$addCol)),
br()
)
)
)
)
})
#Output creations
lapply(1:10, function(idx){
#comparison dropdowns
output[[paste0("showMeta",idx)]] <- renderUI({
input$projectSelection
selectInput(inputId = paste0("metalab",idx),
label = "Column Label:",
choices = c(unique(as.vector(colnames(project())))),
selectize = TRUE,
selected = input[[paste0("metalab",idx)]]
)
})
output[[paste0("showVal",idx)]] <- renderUI({
req(input$addCol >= idx)
input$projectSelection
if(!is.null(input[[paste0("metalab", idx)]])){
checkboxGroupInput(paste0("metaval",idx),
"Column Value:",
choices = unique(as.vector(unlist(project()[[input[[paste0("metalab",idx)]]]]))),
selected = input[[paste0("metaval",idx)]]
)
}
})
})
# observe({input$projectSelection},
# {
# lapply(1:10, function(idx){
# updateSelectInput(session, paste0("metalab",idx),
# label = "Column Label:",
# choices = c(unique(as.vector(colnames(project()))))
# )
# })
# })
}
shinyApp(ui=ui, server = server)
I'm not sure if there's a referencing issue somewhere along the line but I'd like for the checkboxInput UI to display with the appropriate values (for the selected column). I've thought about trying to have it re-render once input$projectSelection changes but that doesn't seem to do anything. I also tried putting an observe for it so the dynamically generated UI updates when input$projectSelection changes but I haven't been successful with that either.
I'd appreciate any and all help! Thanks!
Your checkbox only updated when you click the ADD button.
I've changed its code to make the dynamic checkbox according to the selectinput of the column names, I believe the functionality remains the same
ui <- fluidPage(
fluidRow(
column(4,
uiOutput("projectSelection"),
uiOutput("addSelect"),
uiOutput("checkbox")
)
),
fluidRow(
tags$div(id="rowLabel")
)
)
server <- function(input, output, session) {
Project.ID <- c("Test Project 1", "Test Project 1", "Test Project 1",
"Test Project 1")
Project.ID2 <- c("Test Project 2", "Test Project 2", "Test Project
2", "Test Project 2")
Author.ID <- c("1234", "5234", "3253", "5325")
Fav.Color <- c("Blue", "Red", "Blue", "Green")
Author.Name <- c("Bob", "Jenny", "Bob", "Alice")
output$projectSelection <- renderUI(
tagList(
selectInput("projectSelection",
"Project Name:",
c("Project1", "Project2"),
selectize=TRUE),
actionButton('addCol', strong("Add UI"), icon=icon("plus",
class=NULL, lib="font-awesome"))
)
)
# update datatable
project <- reactive({
if(input$projectSelection == "Project1"){
projectDT <- data.frame(Project.ID, Author.ID, Author.Name)
}
if(input$projectSelection == "Project2"){
projectDT <- data.frame(Project.ID2, Author.Name, Fav.Color)
}
return(projectDT)
})
observeEvent(input$addCol,{
output$addSelect <- renderUI({
selectInput("abc","Column Names", choices =
c(unique(as.vector(colnames(project())))))
})
output$checkbox <- renderUI({
checkboxGroupInput("cde", "Column Value", choices = project()
[,input$abc] )
})
})
}
shinyApp(ui=ui, server = server)
I have come across unusual behavior with the conditional panel in R shiny. I want to have multiple file inputs that the user can upload depending on how many files they want. The below is reducible code. This issue is if the condition is greater than 1 I cannot populate all the files with csv files?? I can for second but not the first
library('shiny')
library('shinythemes')
## adding the conditional statements
ui =
navbarPage("Page Title",
tabPanel("Panel 1",
sidebarPanel(
## Add Name,
## Number of surveys analysising
numericInput("n_values", "Number of columns in next panel:", 1, min = 1, max = 2)
),
mainPanel(
tags$div(
h2("Home Page")
)
)
),
tabPanel("Panel 2",
conditionalPanel(condition = "input.n_values == 1",
fixedPage(theme = "flatly",
fixedRow(
column(2,"First Column",
fileInput("File1", "Choose a CSV files", multiple = F),
p("Click the button to check the data was read in correctly")
),
fixedRow(
column(12,
verbatimTextOutput("errorText1")
)
)
)
)
),
conditionalPanel(condition = "input.n_values == 2",
fixedPage(theme = "flatly",
fixedRow(
column(2,"First Column",
fileInput("File1", "Choose a CSV files", multiple = F),
p("Click the button to check the data was read in correctly")
),
column(2,"Second Column",
fileInput("File2", "Choose a CSV files", multiple = F),
p("Click the button to check the data was read in correctly")
),
fixedRow(
column(12,
verbatimTextOutput("errorText2")
)
)
)
)
)
)
)
server = function(input, output,session) {
## Call the error message function and print
output$errorText1 <- renderText({
validate(
if (input$n_values == 1) {
need(!is.null(input$File1)
, 'You need to input the files before we can validate the data. Please select all the necessary files.')
}
)
validate("allgravy")
})
output$errorText2 <- renderText({
validate(
if (input$n_values == 2) {
need(!is.null(input$File1) & !is.null(input$File2)
, 'You need to input the files before we can validate the data. Please select all the necessary files.')
}
)
validate("allgravy")
})
}
shinyApp(ui, server)
when the condition "number of columns is 2" I can not upload files in the first column, is this a coding issue?
The code works when not in a conditionalPanel, see below for a reproducible example
ui =
navbarPage("Page Title",
tabPanel("Panel 1",
sidebarPanel(
## Add Name,
## Number of surveys analysising
numericInput("n_surveys", "Number of surveys analysing:", 2, min = 1, max = 10)
),
mainPanel(
tags$div(
h2("Home Page")
)
)
),
tabPanel("Panel 2",
fixedPage(theme = "flatly",
fixedRow(
column(2,h4("First Column"),
fileInput("File1", "Choose a CSV files", multiple = F),
actionButton("CheckData", "Validate Input"),
p("Click the button to check the data was read in correctly")
),
column(2,h4("Second Column"),
fileInput("File2", "Choose a CSV files", multiple = F)
),
fixedRow(
column(12,
verbatimTextOutput("errorText")
)
)
)
)
)
)
server = function(input, output,session) {
## Call the error message function and print
output$errorText <- renderText({
validate(
need(!is.null(input$File1)
, 'You need to input the files before we can validate the data. Please select all the necessary files.')
)
validate("seems allgood")
})
}
shinyApp(ui, server)
Chairs
The issue is that you are using the same element twice; you are using the line fileInput("File1", "Choose a CSV files", multiple = F) twice in your code and that is not allowed (I think it has to do with this).
You can solve this by only using the element once, and changing your conditions. For example like this:
library('shiny')
library('shinythemes')
## adding the conditional statements
ui =
navbarPage("Page Title",
tabPanel("Panel 1",
sidebarPanel(
## Add Name,
## Number of surveys analysising
numericInput("n_values", "Number of columns in next panel:", 1, min = 1, max = 2)
),
mainPanel(
tags$div(
h2("Home Page")
)
)
),
tabPanel("Panel 2",
conditionalPanel(condition = "input.n_values == 1 | input.n_values == 2",
fixedPage(theme = "flatly",
fixedRow(
column(2,"First Column",
fileInput("File1", "Choose a CSV files", multiple = F),
p("Click the button to check the data was read in correctly")
),
conditionalPanel(condition = "input.n_values == 2",
column(2,"Second Column",
fileInput("File2", "Choose a CSV files", multiple = F),
p("Click the button to check the data was read in correctly")
)
)
),
fixedRow(
column(12,
verbatimTextOutput("errorText2")
)
)
)
)
)
)
)
server = function(input, output,session) {
## Call the error message function and print
output$errorText1 <- renderText({
validate(
if (input$n_values == 1) {
need(!is.null(input$File1)
, 'You need to input the files before we can validate the data. Please select all the necessary files.')
}
)
validate("allgravy")
})
output$errorText2 <- renderText({
validate(
if (input$n_values == 2) {
need(!is.null(input$File1) & !is.null(input$File2)
, 'You need to input the files before we can validate the data. Please select all the necessary files.')
}
)
validate("allgravy")
})
}
shinyApp(ui, server)
I did not really look at formatting or lay-out, this code is just to illustrate a working example. Hope this helps!
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