Need to use same input for multiple outputs in Shiny - r

I'm trying to code an app with tabs in Shiny that makes reference to the same input from a text box.
Input:
column(2, textInput(inputId = "sh1", label = "Stakeholder #1's name"))
Output:
tabPanel("#1 vs #2",
fluidRow(
column(3),
column(2, textOutput(outputId = "sh1o")),
column(2, "vs"),
column(2, textOutput(outputId = "sh2o"))
),
tabPanel("#1 vs #3",
fluidRow(
column(3),
column(2, textOutput(outputId = "sh1o")),
column(2, "vs"),
column(2, textOutput(outputId = "sh3o"))
),
Rendering:
output$sh1o <- renderText(input$sh1)
As I have learn, Shiny wont allow an input to be used more than once.
Is there any way to make this work?
Can the same input get assigned to a temp variable and then to the output?

Shiny allows input to be used as many times as you want, but you can't use the same outputId for output elements. You could rename your textOutput outputIds by adding the name of the tab first to make them unique.
Here's an example:
library(shiny)
ui<-shinyUI(pageWithSidebar(
headerPanel("Test"),
sidebarPanel(textInput(inputId = "sh1", label = "Stakeholder #1's name")),
mainPanel(
tabsetPanel(
tabPanel("#1 vs #2",
fluidRow(
column(3),
column(2, textOutput(outputId = "tab1_sh1o")),
column(2, "vs"),
column(2, textOutput(outputId = "tab1_sh2o"))
)),
tabPanel("#1 vs #3",
fluidRow(
column(3),
column(2, textOutput(outputId = "tab2_sh1o")),
column(2, "vs"),
column(2, textOutput(outputId = "tab2_sh3o"))
)
)
))))
server <- function(input,output,session){
output$tab1_sh1o <- renderText(input$sh1)
output$tab1_sh2o <- renderText(input$sh1)
output$tab2_sh1o <- renderText(input$sh1)
output$tab2_sh3o <- renderText(input$sh1)
}
shinyApp(ui,server)

Related

How to hide sidebarPanel of a Shiny app for a particular tab

My Shiny app has a universal sidebarPanel. I want to hide it for one particular tab, i.e. whenever the used would navigate to that tab the sidebarPanel would collapse. The code I am trying is as follows-
The UI-
library(shiny)
shinyUI(fluidPage (
theme = shinytheme("superhero"),
headerPanel("COVID-19 Data Visualizer"),
sidebarPanel(
width = 2,
selectInput(
"countries",
label = "Select Countries",
choices =
c("B", "C", "A"),
selected = c("A"),
multiple = T
),
submitButton(text = "View")
),
mainPanel (h1(""),
tabsetPanel(
tabPanel(
"Global Status",
div(id="Main"),
plotlyOutput("figG"),
br(),
plotlyOutput("global_time"),
br(),
plotlyOutput("global_cfr"),
br(),
plotlyOutput("global_p"),
br(),
plotlyOutput("global_recov_dead")
),
tabPanel(
"Comparative Charts",
plotlyOutput("fig_confirm"),
br(),
plotlyOutput("fig_dead"),
br(),
plotlyOutput("fig_recov")
),
tabPanel(
"Ratio Analysis",
plotlyOutput("fig_confirm_S"),
br(),
plotlyOutput("fig_confirm_D"),
br(),
plotlyOutput("fig_Ratio"),
br(),
plotlyOutput("fig_cfr_print")
)
))
))
The server part-
server <- function(input, output) {
observeEvent(input$tabs == "Global Status", {
shinyjs::hide(id = "Main")
})
}
I don't really want to use the navbarPage and want single sidebarPanel for all the inputs.
A screenshot of the output I am getting-
Thanks in advance.
Here is an example:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
sidebarLayout(
sidebarPanel(
id="sidebar",
selectInput(
"countries", label = "Select Countries",
choices = c("B", "C", "A"), selected = "A",
multiple = TRUE
)
),
mainPanel(
tabsetPanel(
tabPanel(
"Global status",
sliderInput("s1", "slider 1", 0, 100, 20)
),
tabPanel(
"Comparative charts",
sliderInput("s2", "slider 2", 0, 100, 50)
),
tabPanel(
"Ratio analysis",
sliderInput("s3", "slider 3", 0, 100, 80)
),
id = "tabset"
),
id="main"
)
)
)
server <- function(input, output){
observeEvent(input[["tabset"]], {
if(input[["tabset"]] == "Comparative charts"){
hideElement(selector = "#sidebar")
removeCssClass("main", "col-sm-8")
addCssClass("main", "col-sm-12")
}else{
showElement(selector = "#sidebar")
removeCssClass("main", "col-sm-12")
addCssClass("main", "col-sm-8")
}
})
}
shinyApp(ui = ui, server = server)

Shiny navbarPage combined with fluidRow

I'm having some trouble with setting out the layout of my shiny app. After trying a couple of different options the one to work the best for me was the navbarPage. Although, I managed to solve the majority of my problems(with the help of stackoverflow) I'm stuck in one.
Basically, I have a table that has many columns and it ends up always larger than the wellPanel that contains the table.
Below is some code to illustrate the problem:
require(shiny)
require(shinythemes)
side_width <- 5
sidebar_panel <-
sidebarPanel(
width = side_width,
radioButtons("Radio1",
label = h4("Radio label 1"),
choices = list("Europe" = "EU",
"USA" = "US"),
selected = "EU"),
hr()
br()
radioButtons("Radio 2",
label = h4("Radio label 2"),
choices = list("Annual" = 1, "Monthly" = 12),
selected = 1)
)
main_panel <- mainPanel(
width = 12 - side_width,
wellPanel(
h5(helpText("Figure 1: ..."))
),
wellPanel(
h5(helpText("Table 1: ..."))
),
wellPanel(
h5(helpText("Table 2: ..."))
),
wellPanel(
fluidRow(
column(12,
h5(helpText("Table 3: ..."))
)
)
)
)
# user interface
ui <- shiny::navbarPage("testing shiny",
tabPanel("Tab1",
sidebarLayout(
sidebarPanel = sidebar_panel,
mainPanel = main_panel,
position = "left")
),
tabPanel("Tab2",
verbatimTextOutput("summary")
),
tags$style(type="text/css", "body {padding-top: 70px;}"),
theme=shinytheme("cosmo"),
position ="fixed-top"
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
When you run the code you will see the current layout. All would be fine if it wasn't for that massive wide table 3 which half of it is always out of the wellPanel.
My question is is it possible to extend the wellPanel to the left so it occupies the entire width of the layout?
Any pointers are highly appreciated.
Cheers
The fluidRow and column functions don't do anything inside the wellPanel/mainPanel - you want to put this particular wellPanel as its own fluidRow separate from the sidebar layout.
Additionally, if your table is being made in the DT package, you can add scrollX=TRUE to the render options so that it'll add a scroll bar if the table is too big to fit.
require(shiny)
require(shinythemes)
side_width <- 5
# user interface
ui <- navbarPage(
"testing shiny",
tabPanel("Tab1",
sidebarLayout(position = "left",
sidebarPanel(width = side_width,
radioButtons("Radio1",
label = h4("Radio label 1"),
choices = list("Europe" = "EU",
"USA" = "US"),
selected = "EU"),
hr(),
br(),
radioButtons("Radio 2",
label = h4("Radio label 2"),
choices = list("Annual" = 1, "Monthly" = 12),
selected = 1)),
mainPanel(
width = 12 - side_width,
wellPanel(
h5(helpText("Figure 1: ..."))
),
wellPanel(
h5(helpText("Table 1: ..."))
),
wellPanel(
h5(helpText("Table 2: ..."))
)
)
),
fluidRow(
column(12,
wellPanel(
h5(helpText("Table 3: ..."))
)
)
)
),
tabPanel("Tab2",
verbatimTextOutput("summary")),
tags$style(type = "text/css", "body {padding-top: 70px;}"),
theme = shinytheme("cosmo"),
position = "fixed-top"
)

Text output with a label or non-editable text input

I'm a Shiny newbie and I have probably a simple question, but I swear I spent half day reading solutions here and can't find anything close to what I need.
Imaging you have a database with employees ID, name, last name, age.
I need to have in my app a text input that allows the user to enter the ID and to see on the same row the name, last name and age.
The problem I face is that textInput will have a label (say "ID").
All the three other fields, that I need to be on the same row, won't have a label.
So what I would need is either a way to add a label to the three textOutput elements or to display them as textInput with a default value that has to change/behave like an output as soon as a user enters a new ID. But how?
This is my sample code:
library(shiny)
u <- fluidPage(
titlePanel("Simple Selectable Reactive Function"),
sidebarLayout(
sidebarPanel(),
mainPanel(
h2("Results"),
fluidRow(column(2,
textInput("input_ID", label = "Cusip 1",
value = "123")),
column(2,
textOutput(outputId = "output_name")),
column(2,
textOutput(outputId = "output_lastname")),
column(2,
textOutput(outputId = "output_age"))
)
)
)
)
s <- function(input,output){
output$output_name <- renderText(
{ # here is where I will check in a database
paste("Sample Name")
})
output$output_lastname <- renderText(
{ # here is where I will check in a database
paste("Sample Last Name")
})
output$output_age <- renderText(
{ # here is where I will check in a database
paste("Sample Age")
})
}
shinyApp(ui=u,server=s)
Perhaps I have to use different widgets?
Thank you
I updated the code to change the label using an textInput as suggested in the comment. Perhaps it helps to understand exactly what you are looking for.
library(dplyr)
library(shiny)
library(shinyjs)
u <- fluidPage(
titlePanel("Simple Selectable Reactive Function"),
sidebarLayout(
sidebarPanel(),
mainPanel(
h2("Results"),
fluidRow(
column(2, textInput("input_ID", label = "Cusip 1",value = "123")),
column(2, textInput("output_name", label = "Firstname") %>% disabled()),
column(2, textInput("output_lastname", label = "Lastname") %>% disabled()),
column(2, textInput("output_age", label = "Age") %>% disabled())))))
s <- function(input,output, session){
observe({
id <- input$input_ID
set.seed(id)
df <- list(firstname = sample(LETTERS, 1), lastname = sample(LETTERS, 1), age = sample(1:100, 1))
updateTextInput(session, inputId = "output_name", label = df[["firstname"]])
updateTextInput(session, inputId = "output_lastname", label = df[["lastname"]])
updateTextInput(session, inputId = "output_age", label = df[["age"]])
})
}
shinyApp(ui=u,server=s)
How I create label for my UI is simply adding a h3 tag above each textoutput:
library(shiny)
u <- fluidPage(
titlePanel("Simple Selectable Reactive Function"),
sidebarLayout(
sidebarPanel(),
mainPanel(
h2("Results"),
fluidRow(column(2,
textInput("input_ID", label = "Cusip 1",
value = "123")),
column(2,
h3("First Name: "),
textOutput(outputId = "output_name")),
column(2,
h3("Last Name: "),
textOutput(outputId = "output_lastname")),
column(2,
h3("Age: ),
textOutput(outputId = "output_age"))
)
)
)
)

How to create a fixed headerpanel with input shiny

So I have a datatable that scrolls in my shiny app. But I would like to place some input fields that stay static above it as it does. Right now the input fields are on the same fluidPage so they scroll up and away as the user scrolls down.
ui = fluidPage(
fluidRow(
column(3,
selectInput("category1", "Event Type:",
c(event_type),selected = "Music")),
column(3,
selectInput("category2", "Event Type:",
c(event_type),selected = "Music")),
column(3,
selectInput("city", "City:",
city_array,selected = "Gettysburg")),
fluidRow(
column(12,
DT::dataTableOutput('table')
),
fluidPage(
column(3,
selectInput("city", "City:",
city_array,selected = "Gettysburg"))
)
)
))

Hide any tabpanel in shiny

I have a tabsetPanel() and I try to hide one tabPanel() if choice is two and checkbox is on. I tried the following code to do that, however it does not work.
ui
shinyUI(
fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(5,
radioButtons("radio", label = h5("Data uploaded"),
choices = list("Aff" = 1, "Cod" = 2,
"Ill" = 3),selected = 1)
)),
checkboxInput("checkbox", "cheb", value = F)
),
mainPanel(
tabsetPanel(
tabPanel("Plot", "plot1"),
conditionalPanel(
condition = "input.radio !=2 && input.checkbox == false",
tabPanel("Summary", "summary1")
),
tabPanel("Table", "table1")
)
)
)
)
)
server
shinyServer(function(input,output,session){
})
How can I hide a tabPanel()?
You could do it with renderUI():
Create the tabpanels() in a list within the renderUI()
and conditionally add the third one:
if(input$radio == 2 & !input$checkbox)
and then return the whole tabsetPanel() with do.call(tabsetPanel, panels).
ui <- shinyUI(
fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(5,
radioButtons("radio", label = h5("Data uploaded"),
choices = list("Aff" = 1, "Cod" = 2,
"Ill" = 3),selected = 1)
)),
checkboxInput("checkbox", "cheb", value = F)
),
mainPanel(
uiOutput("summary")
)
)
)
)
server <- shinyServer(function(input,output,session){
output$summary <- renderUI({
panels <- list(
tabPanel("Plot", "plot1"),
tabPanel("Table", "table1")
)
if(input$radio == 2 & !input$checkbox) panels[[3]] <- tabPanel("Summary", "summary1")
do.call(tabsetPanel, panels)
})
})
shinyApp(ui, server)

Resources