I am trying to a multi tab app, I want the the second tab's page layout to be conditional on an input from the first panel. Basically if the value in the first panel is 1 I want the second panel to display 1 set of file inputs if the user puts in the value 2 in the first panel then I want the second panel to display 2 file inputs. Currently my code displays both conditions, and I am unsure why. See the reproducible code below.
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",accept = c("text/csv","text/comma-separated-values",".csv"), multiple = F),
p("Click the button to check the data was read in correctly")
),
fixedRow(
column(12,
verbatimTextOutput("errorText")
)
)
)
)
),
conditionalPanel(condition = "input.n_values == 2",
fixedPage(theme = "flatly",
fixedRow(
column(2,"First Column",
fileInput("File1", "Choose a CSV files",accept = c("text/csv","text/comma-separated-values",".csv"), multiple = F),
p("Click the button to check the data was read in correctly")
),
column(2,"Second Column",
fileInput("File2", "Choose a CSV files",accept = c("text/csv","text/comma-separated-values",".csv"), multiple = F),
p("Click the button to check the data was read in correctly")
),
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.')
)
})
}
shinyApp(ui, server)
That's because you have verbatimTextOutput("errorText") twice in your UI. You can't do that in Shiny. An output must be included at one place only.
Related
I am working on an App where the user needs to walk through many choices to get to where he/she wants to go with data analysis. The App needs to easily "funnel" the user through the myriad choices without confusing, without leading into dead ends, etc. For example, funneling a user from general to more specific choices:
Funnel 1: Very general choices (first and 2nd images image below: Tab 1 and Tab 2)
Funnel 2: Less general choices (first image below: in sidebar panel)(2nd image: in sub-tabs)
Funnel 3: Most specific choices (first image below: radio buttons along top of main panel)(2nd image: in sidebar panel)
First image:
Second image:
My question is, is it possible to create something like the sub-panels I drew in the 2nd image, to provide an easy funnel for user choices (albeit prettier than my drawing)? If not, in Shiny what are the other options for efficiently funneling a user through choices, if any? Where I'm heading is in the first image where the user goes from Tabs - sidebar - radio buttons across the top of the main panel.
Reproducible code for first image:
library(shiny)
library(shinyjs)
ui <-
pageWithSidebar(
headerPanel("Test"),
sidebarPanel(
useShinyjs(),
fluidRow(helpText(h5(strong("Base Input Panel")),align="center")),
conditionalPanel(
condition="input.tabselected==1",
h5("Selections for Tab 1:")
),
conditionalPanel(
condition="input.tabselected==2",
h5("Selections for Tab 2:")
)
), # close sidebar panel
mainPanel(
useShinyjs(),
tabsetPanel(
tabPanel("Tab 1", value=1,helpText("Tab 1 outputs")),
conditionalPanel(condition = "input.tabselected==1",
fluidRow(helpText("Tab 1 things happen here")),
),
tabPanel("Tab 2", value=2,
fluidRow(
radioButtons(
inputId = 'mainPanelBtnTab2',
label = h5(strong(helpText("Functions to access:"))),
choices = c('Function 1','Function 2','Function 3'),
selected = 'Function 1',
inline = TRUE
) # close radio buttons
), # close fluid row
conditionalPanel(condition = "input.tabselected==2",
fluidRow(helpText("Tab 2 things happen here")),
conditionalPanel(condition = "input.mainPanelBtnTab2 == 'Function 1'",
helpText("You pressed radio button 1")),
conditionalPanel(condition = "input.mainPanelBtnTab2 == 'Function 2'",
helpText("You pressed radio button 2")),
conditionalPanel(condition = "input.mainPanelBtnTab2 == 'Function 3'",
helpText("You pressed radio button 3"))
) # close conditional panel
), # close tab panel
id = "tabselected"
) # close tabsetPanel
) # close mainPanel
) # close pageWithSidebar
server <- function(input,output,session)({})
shinyApp(ui, server)
You can nest a tabsetPanel() inside an existing tabPanel().
library(shiny)
shinyApp(
fluidPage(
sidebarLayout(
sidebarPanel(
"here is your sidebar",
uiOutput("tab_controls"),
uiOutput("subtab_controls")
),
mainPanel(
tabsetPanel(
tabPanel(
"Tab 1", br(),
tabsetPanel(
tabPanel("Function 1", "Here's the content for Tab 1, Function 1, with a `br()` between parents and sub-tab"),
tabPanel("Function 2", "Here's the content for Tab 1, Function 2, with a `br()` between parents and sub-tab"),
id = "subtab_1"
)
),
tabPanel(
"Tab 2",
tabsetPanel(
tabPanel("Function 1", "Here's the content for Tab 2, Function 1, with no space between tab levels"),
tabPanel("Function 2", "Here's the content for Tab 2, Function 2, with no space between tab levels"),
id = "subtab_2"
)
),
tabPanel("Tab 3", "Here's some orphaned content without sub-tabs"),
id = "parent_tabs"
)
)
)
),
function(input, output, session) {
output$tab_controls <- renderUI({
choices = if (input$parent_tabs == "Tab 1") {
c("choices", "for", "tab 1")
} else if (input$parent_tabs == "Tab 2") {
c("tab 2", "settings")
}
if (length(choices)) {
radioButtons(
"tab_controls",
"Controls",
choices = choices
)
}
})
output$subtab_controls <- renderUI({
if (input$parent_tabs == "Tab 2" & input$subtab_2 == "Function 1") {
radioButtons(
"subtab_controls",
"Additional controls for Tab 2, Function 1",
choices = letters[1:5]
)
} else if (input$parent_tabs == "Tab 2" & input$subtab_2 == "Function 2") {
selectInput(
"subtab_controls",
"Different input for Tab 2, Function 2",
choices = letters[6:10]
)
}
})
}
)
Here I've got three tabs at the top level, Tab 1-3. Inside Tab 1 and Tab 2, there are tabsetPanels that each have two tabs for Functions 1-2.
Also I showed two approaches (there are others, like update____Input functions) to changing the controls in the sidebar depending on which tab is selected. You should specify each tab set with tabsetPanel(..., id = "something"). Then you can check input$something's value, which will be the title of one of its tabs.
Here is a minimum example. I am trying to modularize an existing app to separate different analysis problems. Each problem is intended to have a sidebar panel for inputs and a main panel for outputs. I am having two problems with setting up the siderbar panel for inputs. I will have two buttons that are exchanged after the first is selected. This action is in the module server code that requires reading in the selected analysis (tab label in the navbar) and then acting on the value read. I get errors for this problem: Warning: Error in ==: comparison (1) is possible only for atomic and list types
44: [/appsdata/home/wk211a/Projects/vrat4/minexample.R#61]
1: runApp
The second problem is that I cannot get the simple renderText message to display in the first tab.
Here is the code:
##### Test Example
##### Setup VRAT App
ContCurrentSideBarPanelUI <- function(id){
ns <- NS(id)
tagList(
tabsetPanel(
id = "sbpcontin",
tabPanel(
"Setup",
value = "setup_Cont_Curr",
textOutput(ns("result"))
),
tabPanel(
"Verification",
value = "verify_Cont_Curr"
),
tabPanel(
"Process",
value = "process_Cont_Curr"
),
tabPanel(
"Design",
value = "req_Cont_Curr"
),
tabPanel(
"Risk Analysis",
value = "risk_Cont_Curr",
),
tabPanel(
"Guardbanding",
value = "gb_Cont_Curr"
),
tabPanel(
"Sampling",
value = "sample_Cont_Curr"
),
tabPanel(
"Decon",
value = "decon_Cont_Curr"
)
)
)
}
ContCurrentSideBarPanelServer <- function(id,appTabs,Maincount){
moduleServer(
id,
function(input,output,session){
observe({
output$result <- renderText({
paste0("Here I am ", 63)
})
})
observe({
if (appTabs == "cont_Data" ) {
showElement(id = "goButton")
hideElement(id = "goButton3")
}
})
x <- 93
return(x)
}
)
}
VRATui <- shinyUI(
### Start Navbar Page
navbarPage(
title = "Test Tool",
selected = "Introduction",
fluid=TRUE,
### Start App Tab panel
tabsetPanel(id = "appTabs",
type = "pills",
### Start the tab panel for the Data Screen
tabPanel(
value = "cont_Data",
title = "Continuous Data",
### Start the Continuous sidebar layout
sidebarLayout(
### Start the Continuous sidebar panel
sidebarPanel(
id = "cndsp",
width = 3,
style = "overflow-y:scroll; max-height: 80vh",
h4("Analysis of Current Data"),
hr(style="border-color: darkblue;"),
conditionalPanel(
condition = "input.appTabs == 'cont_Data' && input.Maincont == 'currentCont'",
### Submit setup for analysis
actionButton(inputId = "goButton", label = "Start Current Analysis", width = '100%'),
actionButton(inputId = "goButton3", label = "Update Current Analysis", width = '100%'),
### Sidebar Panel Tabs
ContCurrentSideBarPanelUI("ContCurrentSideBarPanel")
),
### End Continuous Data Analysis sidebar panel
),
mainPanel()
### End the sidebar layout
),
### End the Data tab panel
)
)
### End the app tabPanelSet
)
### End the navbarPage
)
VRATserver <- shinyServer(function(input, output, session) {
test <- ContCurrentSideBarPanelServer(id = "ContCurrentSideBarPanel",
reactive(input$appTabs),
Maincount = reactive(input$Maincount))
})
shinyApp(
ui = VRATui,
server = VRATserver
)
It turned out to be easy. I was not passing the outer parameter as reactive correctly. It should be reactive({...}) not reactive(...). Once corrected, then the module responded to appTabs() correctly and the if statement completed without error. When this worked, the text was correctly entered into the sidebar tab.
I'm writing a Shiny app with fluidRows and I want to create a dynamic number of columns in the app. I can make columns appear and disappear correctly, but I don't know how to also make them resize accordingly. The desired outcome is that all columns have width 4 if there are 3 of them and width 6 if there are 2. The number of possible columns is 2, 3, or 4 so I don't need to account for more variability than that.
I know that I can probably do it by passing the entire column set through renderUI. However, that would require me to define the contents of the columns in server.R and I'd rather avoid that.
See below for a minimal code example of my app:
library(shiny)
ui <- fluidPage(
titlePanel("Dynamic Columns"),
sidebarLayout(
sidebarPanel(
selectInput("column_count", "Number of Columns", 2:4, 2),
submitButton("Go")
),
mainPanel(
fluidRow(
column(3, "This is column 1"),
column(3, "This is column 2"),
conditionalPanel(
condition = "input.column_count >= 3",
column(3, "This is column 3")
),
conditionalPanel(
condition = "input.column_count == 4",
column(3, "This is column 4")
)
)
)
)
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
One way might be to alter the css classes using javascript. I wrote a short js script that calculates the width using the selected value (i.e., 2, 3, 4) and the maximum bootstrap.js columns (i.e., 12): 12 / value, and then updates the class with the new width: col-sm-*. I explicitly named which columns should be resized by adding the class target-column. (You can use any name you like. Make sure it is updated in the js function.). The event is trigged by the submit button.
Here's your example with the javascript. (I wrapped the app in tagList).
library(shiny)
ui <- tagList(
fluidPage(
titlePanel("Dynamic Columns"),
sidebarLayout(
sidebarPanel(
selectInput("column_count", "Number of Columns", 2:4, 2),
submitButton("Go")
),
mainPanel(
fluidRow(
column(3, "This is column 1", class = "target-column"),
column(3, "This is column 2", class = "target-column"),
conditionalPanel(
condition = "input.column_count >= 3",
column(3, class = "target-column", "This is column 3")
),
conditionalPanel(
condition = "input.column_count == 4",
column(3, class = "target-column", "This is column 4")
)
)
)
),
tags$script(
type = "text/javascript",
"
const btn = document.querySelector('button[type=submit]');
const input = document.getElementById('column_count');
btn.addEventListener('click', function(event) {
// calculate new width
w = 12 / input.options[input.selectedIndex].value;
console.log('new width', w);
// update classes
const columns = document.querySelectorAll('.target-column');
columns.forEach(function(column) {
column.className = 'col-sm-' + w + ' target-column';
});
})
"
)
)
)
server <- function(input, output) {}
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!
This is my first Shiny App, as part of my Coursera Data Science Specialisation. I am trying to create a Tab for documentation but the output of the main tab displays in both, the MainApp tab and the Documentation.
I want no output in the "Documentation" tab
Any help? Thanks!
This is the ui.R code:
shinyUI(
pageWithSidebar(
headerPanel (" Six Sigma Control Charts"),
tabsetPanel(
tabPanel("MainApp",
sidebarPanel(
h5 ("Control Charts are six sigma tools that track process statistics over time to detect the presence of special causes of variation. There are different types of charts according to the data type that you are analysing."),
selectInput("DataType", "Please select Data Type",
choices = c("Continuous", "Attribute")),
conditionalPanel(condition = "input.DataType == 'Continuous'",
selectInput("Groups", "Data collected in groups?",
choices = c("Yes", "No"))),
conditionalPanel(condition = "input.DataType == 'Attribute'",
selectInput("Counting", "What are you counting?",
choices = c("Defective items", "Defects per unit"))),
conditionalPanel(condition = "input.Groups == 'Yes' & input.DataType == 'Continuous' ",
textInput ("SubgroupSize", "Enter sub group size",1 ) )
) ),
tabPanel("Documentation",
h5 ("This Shiny App helps you to familiarise with Six Sigma Control Charts."),
h5 ("The different types of graphs are produced according to the type of data that you want to analyse"),
h5 ("Make a choice according to the data type to explore the various Six Sigma graphs")
)
),
mainPanel (
plotOutput ("ControlChart"),
textOutput("Explanation"),
br(100),
br()
)
)
)
It is not possible with the pageWithSidebar function. This function is deprecated anyway. Try to wrap a fluidPage in a navbarPage:
# Define UI
ui <- navbarPage("App Title",
tabPanel("Plot",
fluidPage(
sidebarLayout(
# Sidebar with a slider input
sidebarPanel(
sliderInput("obs",
"Number of observations:",
min = 0,
max = 1000,
value = 500)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
),
tabPanel("Summary",
tags$br("Some text"))
)
# Server logic
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs))
})
}
# Complete app with UI and server components
shinyApp(ui, server)