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)
Related
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.
Hoping someone can help!
I am trying to create an R shiny app that will allow me to upload a file as well as display plots in different tabs. My code for the file upload works when I don't introduce the tabs - not sure why this would affect anything.
I also can't seem to get my ggplot to display either, although the code works outside the shiny app.
Here is my current code (I know I have widgets that don't do anything yet...):
ui <- fluidPage(
# Application title
titlePanel(h1("Title", align = "center")),
# Upload file
fileInput("upload", "Data file:", buttonLabel = "Select File", multiple = FALSE),
tableOutput("files"),
hr(),
# Tabs for Display Options
tabsetPanel(
tabPanel("Table 1", tableOutput("table")),
tabPanel("Plot1", plotOutput("distPlot")),
tabPanel("Table 2", tableOutput("table")),
tabPanel("Plot 2",plotOutput("distPlot")),
tabPanel("Summary", verbatimTextOutput("summary"))
),
# Sidebar with interactive widgets
sidebarLayout(
sidebarPanel(
# Radio Buttons for Data Normalization
radioButtons("radio", label = h3("Pick:"),
choices = list("1" = 1, "1" = 2), selected = 1),
hr(),
# Checkbox for whether outliers should be included
checkboxInput("outliers", "Show outliers", FALSE)
),
mainPanel(
h1("test...")
)
)
)
# Server
server <- function(input, output) {
# You can access the value of the widget with input$file
output$files <- renderTable(input$upload)
# Distribution Plots
output$distPlot <- renderPlot({
p <- ggplot(data=dat, aes(column1)) + geom_density(aes(y = ..count..), fill = "lightgray")
print(p)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Dat is just a data frame with 104 values in each of 2 columns (one named "column1"). Not sure how to share that here, but can be anything really as long as I can get it to display.
Thanks!!
I am building a Shiny application using the navbarPage() type. I have three tabs - the initial tab has a textInput() box that has default text defined. The mainPanel() of that page has a histogram and a table. On page load those update and reflect the proper information when the application is launched based on that default text.
The second tab is supposed to present a wordcloud based on that default text. When I switch over to that tab there is an error - if I go back to the first tab and enter new text and hit the actionButton - the wordcloud will update, but it won't do so until I perform that action.
Is there a way to have the actionButton() or some sort of submit happen when the page loads so the tab with the wordcloud can update? Or maybe I just need to make a variable global or something. I'm not sure. I've spent quite a bit of time on this and have hit a wall. Any help would be greatly appreciated.
Code for the UI:
tabPanel("Word Cloud Diagram",
fluidRow(
sidebarPanel(
width = 3,
h5("The sentence input:"),
wellPanel(span(h5(textOutput(
'sent'
)), style = "color:red")),
sliderInput(
"maxWC",
h5("Maximum Number of Words:"),
min = 10,
max = 100,
value = 50
),
br(),
#actionButton("update", "Update Word Cloud"),
hr(),
helpText(h5("Help Instruction:")),
helpText(
"Please have a try to make the prediction by using
the dashboard on right side. Specifically, you can:"
),
helpText("1. Type your sentence in the text field", style =
"color:#428ee8"),
helpText(
"2. The value will be passed to the model while you are typing.",
style = "color:#428ee8"
),
helpText("3. Obtain the instant predictions below.", style =
"color:#428ee8"),
hr(),
helpText(h5("Note:")),
helpText(
"The App will be initialized at the first load.
After",
code("100% loading"),
", you will see the prediction
for the default sentence example \"Nice to meet you\"
on the right side."
)
),
mainPanel(
h3("Word Cloud Diagram"),
hr(),
h5(
"A",
code("word cloud"),
"or data cloud is a data display which uses font size and/
or color to indicate numerical values like frequency of words. Please click",
code("Update Word Cloud"),
"button and",
code("Slide Input"),
"in the side bar to update the plot for relevant prediction."
),
plotOutput("wordCloud"),
# wordcloud
br()
)
)),
Code for the server:
wordcloud_rep <- repeatable(wordcloud)
output$wordCloud <- renderPlot({
v <- terms()
wordcloud_rep(
v[, 2],
v[, 1],
max.words = input$maxWC,
scale = c(5, 1.5),
colors = brewer.pal(4, "Dark2")
)
})
Also, I am using a single file application "app.R" - not sure if this is useful information or not. Again, on the first tab, default text is presented on the first page load, I just want this to extend to the wordcloud on page load so the plot is shown immediately without having to enter and submit new text. Thanks!
Here is an example that should be close to what you want. The trick is to use a submitButton. The wordcloud will have a default plot based on initial input, but will change when you change the text and press the submit button.
library(shiny)
library(wordcloud)
ui <- shinyUI(fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
textInput("text", "Input Text", "Random text random text random is no yes"),
submitButton("Submit")
),
mainPanel(
tabsetPanel(
tabPanel("Tab1",
plotOutput("hist"),
tableOutput("hist_table")),
tabPanel("Tab2",
plotOutput("wordcloud"))
)
)
)
))
server <- shinyServer(function(input, output) {
observe({
word_list = strsplit(input$text, " ")
word_table = as.data.frame(table(word_list))
output$hist = renderPlot({
barplot(table(word_list))
})
output$hist_table = renderTable({
word_table
})
output$wordcloud = renderPlot({
wordcloud(word_table[,1], word_table[,2])
})
})
})
shinyApp(ui = ui, server = server)
Since the use of submitButton() is generally discouraged in favour of the more versatile actionButton() (see here for function documentation), here is a version of the answer above that uses a combination of actionButton() and eventReactive() with ignoreNULL = FALSE so that the plots show up upon launching the app.
library(shiny)
library(wordcloud)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textInput("text", "Input Text", "Random text random text random is no yes"),
actionButton("submit", "Submit")
),
mainPanel(
tabsetPanel(
tabPanel(
"Tab1",
plotOutput("hist"),
tableOutput("hist_table")
),
tabPanel(
"Tab2",
plotOutput("wordcloud")
)
)
)
)
)
server <- shinyServer(function(input, output) {
word_list <- eventReactive(input$submit,{
strsplit(input$text, " ")
},
ignoreNULL = FALSE
)
word_table <- reactive(
as.data.frame(table(word_list()))
)
output$hist <- renderPlot({
barplot(table(word_list()))
})
output$hist_table <- renderTable({
word_table()
})
output$wordcloud <- renderPlot({
wordcloud(word_table()[, 1], word_table()[, 2])
})
})
shinyApp(ui = ui, server = server)
The solution to making the action button run on the first load is a simple one. Just add an ifelse statement.
Original:
eventReactive(input$submit, ...
New:
eventReactive(ifelse(input$submit == 0, 1, input$submit), ...
Yes, it's just that easy!
In my R shiny application, I would like to have one button to submit one set of inputs (which affect one portion of the output) and another one to submit the remaining inputs (which affect a different portion of the output). The code in the widgets example of the Shiny tutorial uses a submitButton but it seems like all the inputs are delivered when that single button is pressed? Thanks in advance for your help.
Here is an example showing actionButtons controlling reactive components:
library(shiny)
runApp(list(
ui = fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
tags$form(
numericInput('n', 'Number of obs', 100)
, br()
, actionButton("button1", "Action 1")
)
, tags$form(
textInput("text", "enter some text", value= "some text")
, br()
, actionButton("button2", "Action 2")
)
),
mainPanel(
plotOutput('plot')
, textOutput("stext")
)
)
),
server = function(input, output) {
output$plot <- renderPlot({
input$button1
hist(runif(isolate(input$n)))
})
output$stext <- renderText({
input$button2
isolate(input$text )
})
}
)
)
I am trying to make a reactive UI with sliders that drop in and out via a dropdown in shiny. I have a server with reactiveUI sliders (server.R):
library(shiny)
shinyServer(function(input, output) {
output$slider1 <- reactiveUI(function() {
sliderInput("s1", "slide 1", min = 1, max = 100, value = 1)
})
output$slider2 <- reactiveUI(function() {
sliderInput("s2", "slide 2", min = 1, max = 100, value = 1)
})
})
I can run the server fine with the following code (ui.R):
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Hello Shiny!"),
sidebarPanel(
selectInput("dataset", "number of buckets:",
choices = c(1,2,3)),
conditionalPanel(
condition = "input.dataset==2",
uiOutput("slider1"),uiOutput("slider2")),
conditionalPanel(
condition = "input.dataset==1",
sliderInput("s1", "slide 1", min = 1, max = 100, value = 1)
)
),
mainPanel(
)
))
but if I try to make both conditionalPanels call uiOutput, the server freezes:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Hello Shiny!"),
sidebarPanel(
selectInput("dataset", "number of buckets:",
choices = c(1,2,3)),
conditionalPanel(
condition = "input.dataset==2",
uiOutput("slider1"),uiOutput("slider2")),
conditionalPanel(
condition = "input.dataset==1",
uiOutput("slider1")
)
),
mainPanel(
)
))
I have played around with this, and found that it happens anytime that use the same condition variable and multiple uiOutput calls. Any suggestions? Thanks.
See the comment from #Joe for the answer.
Basically, outputIDs and inputIDs have to be unique; two UI elements with the same IDs on the same page emits and error. This is a limitation of the reactivity in shiny.
The work around from #Jim is to create multiple elements for each output or input used by the client, e.g.
output$slider2_1 <- ...
output$slider2_2 <- ...