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"))
)
)
))
Related
I have an R shiny app with different download buttons as illustrated in the code below. The issue is that the position of the download button within fluidRow is not automatically aligned with the positions of other input elements like dateInput below.
ui <- dashboardPage(
title = "Test Dashboard", # this is the name of the tab in Chrome browserr
dashboardHeader(title = "Web Portal"),
dashboardSidebar(
sidebarMenu(
menuItem('Retail', tabName = "retail", icon = icon("th"),
menuItem('Dashboard', tabName = 'retail_dashboard'))
)
),
dashboardBody(
tabItem(tabName = "retail_dashboard",
tabsetPanel(type = "tabs",
tabPanel("Dashboard",
h3("Test."),
fluidRow(column(2,
dateInput("idx_muni_tot_ret_start_dt", label = "Start Date:", value = Sys.Date()-10)), # 1yr ago
column(2,
dateInput("idx_muni_tot_ret_end_dt", label = "End Date:", value = Sys.Date())),
column(2,
downloadButton("download_idx_muni_TR_data","Download Data"))
)
)
)
)
)
)
server <- function(input, output, session) {
# code...
}
cat("\nLaunching 'shinyApp' ....")
shinyApp(ui, server)
I found similar questions here How do I align downloadButton and ActionButton in R Shiny app? and here Change download button position in a tab panel in shiny app but they don't seem to answer my questions. I also attach a screenshot with the current button position as well as the expected one.
A workaround is to simulate a label on top of the download button and add 5px of margin-bottom.
column(
width = 2,
div(tags$label(), style = "margin-bottom: 5px"),
div(downloadButton("download_idx_muni_TR_data", "Download Data"))
)
A bit of css does the trick:
ui <- dashboardPage(
title = "Test Dashboard",
dashboardHeader(title = "Web Portal"),
dashboardSidebar(
),
dashboardBody(
h3("Test."),
fluidRow(column(2,
dateInput("idx_muni_tot_ret_start_dt",
label = "Start Date:", value = Sys.Date() - 10)),
column(2,
dateInput("idx_muni_tot_ret_end_dt",
label = "End Date:", value = Sys.Date())),
column(2,
div(style = "margin-bottom:15px",
downloadButton("download_idx_muni_TR_data","Download Data")))
, style = "display:flex;align-items:end")
)
)
Update
If you want to add a selectInput you need yet some new css tweaks to get the input on the same line:
ui <- dashboardPage(
title = "Test Dashboard",
dashboardHeader(title = "Web Portal"),
dashboardSidebar(),
dashboardBody(
h3("Test."),
fluidRow(column(2,
dateInput("idx_muni_tot_ret_start_dt",
label = "Start Date:", value = Sys.Date() - 10)),
column(2,
dateInput("idx_muni_tot_ret_end_dt",
label = "End Date:", value = Sys.Date())),
column(2,
tagAppendAttributes(selectInput("slc", "Select", LETTERS), style="margin-bottom:10px")),
column(2,
div(style = "margin-bottom:15px",
downloadButton("download_idx_muni_TR_data","Download Data"))),
style = "display:flex;align-items:end")
)
)
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"
)
I have a Shiny App that takes a text input and shows it on the main panel (I used this answer to build it):
ui.r:
library(shiny)
shinyUI(fluidPage(
titlePanel("This is a test"),
sidebarLayout(
sidebarPanel(
textInput("text1", "Enter the text", ""),
actionButton("goButton", "Go")
),
mainPanel(
h3(textOutput("text1", container = span))
)
)
)
)
server.r:
shinyServer(function(input, output) {
cap <- eventReactive(input$goButton, {
input$text1
})
output$text1 <- renderText({
cap()
})
})
It worked great until I decided to add a Tabset panel, and show the input on one of the tabs. I modified mainPanel() in ui.r as:
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("t1"),
tabPanel("t2",
tabPanel("t3"), h3(textOutput("text1", container = span)),
)
)
After this change, I am getting an error when launching an app:
ERROR: cannot coerce type 'closure' to vector of type 'character'
Is there something I am missing?
You have to put the content within the tab within the call to tabPanel. Ex:
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel("t1"),
tabPanel("t2"),
tabPanel("t3", h3(textOutput("text1", container = span)))
)
)
Thus, server.R is unchanged from you question, and ui.R becomes:
library(shiny)
shinyUI(
fluidPage(
titlePanel("This is a test"),
sidebarLayout(
sidebarPanel(
textInput("text1", "Enter the text", ""),
actionButton("goButton", "Go")
),
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel("t1"),
tabPanel("t2"),
tabPanel("t3", h3(textOutput("text1", container = span)))
)
)
)
)
)
Consider the example below
ui.R:
library(shiny)
library(shinyjs)
shinyUI(
tabPanel("VIEW",
tabsetPanel(id="viewic",
tabPanel("view1",
fluidRow( column(2,
actionButton("button1", "BUTTON1")),
column(2,
actionButton("button2", "BUTTON2"))
))
tabPanel(" View2"))),
fluidRow(
uiOutput("ui1")
),
fluidRow(
uiOutput("ui2")
))
Server:
library(shiny)
library(shinyjs)
shinyServer(function(input, output,session){
observeEvent(
input$button1,
output$ui1 <- renderUI({isolate({
column(3,
selectInput("selectview1",
label = "Select Id",
choices = c("1","2","3")
))})}))
observeEvent(
input$button2,
output$ui2 <- renderUI({isolate({
column(3,
selectInput("selectview2",
label = "Select Id",
choices = c("4","5","6")
))})}))
})
How to reset the session,ie; when I press button1 the selectinput with id selectview1 appears and when I press the button2 the selectInput with id selectview2 defined inside it appears but the selectinput that appeared firstly when the button1 was clicked is also being displayed along with it and vice versa.I tried reset and toggle but it didn't worked properly.
EDIT: use conditionalPanel on your selectInputs. So something to the effect of:
conditionalPanel(condition = 'input.button1 % 2 > 0',
uiOutput("ui1")
)
This checks whether or not the value of your actionButton is even and only displays it when it is odd. So assuming the button starts at a 0 value, it will display after 1, 3, 5, 7... clicks.
I think this should work. Can you try it out?
If you just want to hide a button depending on a click, look into conditionalPanel() and wrap your button code (ui side) in that function.
http://shiny.rstudio.com/reference/shiny/latest/conditionalPanel.html
ui.R
library(shiny)
library(shinyjs)
shinyUI(
fluidPage(
tabPanel("VIEW",
tabsetPanel(id="viewic",
tabPanel("view1",
fluidRow( column(2,
actionButton("button1", "BUTTON1")),
column(2,
actionButton("button2", "BUTTON2"))
)),
tabPanel(" View2"))),
fluidRow(
uiOutput("ui1")
),
fluidRow(
uiOutput("ui2")
)))
server.R
library(shiny)
library(shinyjs)
shinyServer(function(input, output,session){
observeEvent(
input$button1,
output$ui1 <- renderUI({isolate({
output$ui2<-renderUI(
isolate({
dataTableOutput(NULL)
} ) )
column(3,
selectInput("selectview1",
label = "Select Id",
choices = c("1","2","3")
))})}))
observeEvent(
input$button2,
output$ui2 <- renderUI({isolate({
output$ui1<-renderUI(
isolate({
dataTableOutput(NULL)
} ) )
column(3,
selectInput("selectview2",
label = "Select Id",
choices = c("4","5","6")
))})}))
})
This code worked.
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)