I am in the process of creating a shiny app for a process at work and am struggling to figure something out on the UI side of the app. I would like to display a data table next to a sidebar menu containing options for the app. The issue is that when I do so, the data table is pushed down below the sidebar panel instead of beside it (see the original data tab).
I found a work around as seen in the suggested tab, but that comes with its own issues. I need to be able to lock the column headers while scrolling through the app and when the data table is inside the box element, I am unable to find a way to do so.
Here is the code to a simplified version of the app.
library(shiny)
library(lubridate)
library(tidyverse)
library(DT)
library(shinydashboard)
library(shinythemes)
library(sortable)
library(reactlog)
ui<- dashboardPage(
#this gives you the name displayed on the tab
dashboardHeader(title = "HHS Resin Purchasing 0.99"),
#this gives you your sidebar (page) options
dashboardSidebar(
sidebarMenu(
menuItem("Original Data", tabName = "original"),
menuItem("Suggested", tabName = "suggested")
)
),
#this is the body of the webpages
dashboardBody(
#this gives you the body options that are displayed on every page
sidebarPanel(width = 2,
h2("Menu Options"),
h4(strong("Upload Data:")),
fileInput("file", "Data", buttonLabel = "Upload..."),
textInput("delim", "Delimiter (leave blank to guess)", ""),
numericInput("skip", "Rows to skip", 0, min = 0),
h4(strong("User Options:")),
selectInput("plant", "Select a Plant", choices =
c("All")),
dateInput("latest_date", "Select the latest W_LEAD date in the data",
value = Sys.Date()),
numericInput("avg_multiple", "Multiple of Daily Useage for Cuttoff",21, min = 1, max = 50),
h4(strong("Download Options:")),
actionButton("complete_orders", "Analysis for plant orders complete"),
actionButton("complete_checks", "Mid month check complete"),
downloadButton("downloadData1", label = "Download Suggested Orders...", class = "btn-block"),
downloadButton("downloadData2", label = "Download Flags...", class = "btn-block"),
downloadButton("downloadData3", label = "Download Full Suggested Orders Data...", class = "btn-block")
),
#This is the actual data that fills those page options listed above
tabItems(
tabItem(tabName = "original",
DT::dataTableOutput(outputId = "preview1")
),
tabItem(tabName = "suggested",
box(title = "Suggested Orders",width = 9, status = "primary", height = "auto",
solidHeader = T, dataTableOutput("preview2"), style = "max-height:800px; overflow-y: scroll;overflow-x: scroll;")
)
)
)
)
server <- function(input, output) {
output$preview1 <- renderDataTable({
DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20))
})
output$preview2 <- renderDataTable({
DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20))
})
}
shinyApp(ui, server)
Help in fixing either of the issues outlined above would be very appreciated! Thanks in advance.
I think using the column() function will support your first question of the datatable moving under the sidebar sidebarPanel. Please see example below.
I think the second request of freezing the row header in the datatable can be resolved with the advice found at Freezing header and first column using data.table in Shiny
library(shiny)
library(lubridate)
library(tidyverse)
library(DT)
library(shinydashboard)
library(shinythemes)
library(sortable)
library(reactlog)
ui<- dashboardPage(
#this gives you the name displayed on the tab
dashboardHeader(title = "HHS Resin Purchasing 0.99"),
#this gives you your sidebar (page) options
dashboardSidebar(
sidebarMenu(
menuItem("Original Data", tabName = "original"),
menuItem("Suggested", tabName = "suggested")
)
),
#this is the body of the webpages
dashboardBody(
#this gives you the body options that are displayed on every page
fluidRow(
column(width = 2,
sidebarPanel(width = 2,
h2("Menu Options"),
h4(strong("Upload Data:")),
fileInput("file", "Data", buttonLabel = "Upload..."),
textInput("delim", "Delimiter (leave blank to guess)", ""),
numericInput("skip", "Rows to skip", 0, min = 0),
h4(strong("User Options:")),
selectInput("plant", "Select a Plant", choices =
c("All")),
dateInput("latest_date", "Select the latest W_LEAD date in the data",
value = Sys.Date()),
numericInput("avg_multiple", "Multiple of Daily Useage for Cuttoff",21, min = 1, max = 50),
h4(strong("Download Options:")),
actionButton("complete_orders", "Analysis for plant orders complete"),
actionButton("complete_checks", "Mid month check complete"),
downloadButton("downloadData1", label = "Download Suggested Orders...", class = "btn-block"),
downloadButton("downloadData2", label = "Download Flags...", class = "btn-block"),
downloadButton("downloadData3", label = "Download Full Suggested Orders Data...", class = "btn-block")
)
),
#This is the actual data that fills those page options listed above
column(width = 6,
tabItems(
tabItem(
tabName = "original",
DT::dataTableOutput("preview1",
options = list(dom = 't',
scrollX = TRUE,
paging=FALSE,
fixedHeader=TRUE,
fixedColumns = list(leftColumns = 1, rightColumns = 0)))
),
tabItem(tabName = "suggested",
box(title = "Suggested Orders",width = 9, status = "primary", height = "auto",
solidHeader = T, dataTableOutput("preview2"), style = "max-height:800px; overflow-y: scroll;overflow-x: scroll;")
)
)
)
)
)
)
server <- function(input, output) {
output$preview1 <- renderDataTable({
DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20)))
})
output$preview2 <- renderDataTable({
DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20)))
})
}
shinyApp(ui, server)
Related
Help! For the life of me, I can't get values to populate from the server to the infoBox in the UI.
I've tried to define the infoboxes from the server section, but the infoboxes will only appear if I construct them in the UI (as shown below).
The goal is to populate the boxes with filtered data based on user inputs, but I've abandoned this at this stage because I can't even pass a value from the server to the UI infobox here:
infoBox("Participants Trained",
value = renderText("AYval"), # tried every combo here
width = 12,color = "blue", # tried width = NULL
icon = icon("fa-solid fa-people-group"), fill = F)
A value shows when I hardcode a value in "value = ", but none of the render options, renderText, verbatimText, output$AYval, valueTextbox, listen(),react() will get a value that is hard-coded in the server side to show up in this infobox.
To get the dashboard to display boxes, I'm using header = tagList(useShinydashboard()). My guess is this useShinydashboard() is the culprit.
I thought this comment might be relevant:
Your code using lapply and the navbarPage doesn't generate the UI in
the proper namespace, since when using the navbarPage construct your
modules are "one level deeper".
The script:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
#library(shinyjs)
side_width <- 5
#completing the ui part with dashboardPage
ui <- navbarPage(fluid = TRUE,
theme = shinythemes::shinytheme("flatly"),
collapsible = TRUE,
header = tagList(
useShinydashboard()
),
tabPanel("START"),
tabPanel("Home Dashboard",
value = "Tab1",
# useShinyjs(),
fluidRow(
column(4,
# Selection Input ---------------------------------------------------------
selectInput(inputId = "AY","Academic Year",
multiple = T,
choices = unique(INDGEN$AcademicYear),
selected = unique(INDGEN$AcademicYear)
)),
column(4,
selectInput(inputId = "State","Select State",
choices = c("State","States"))),
column(4,
selectInput(inputId = "Program","Select Program",
choices = c("Program","Programs")))
),
fluidRow(column(12,
box(width = 4,
infoBox("Who?",
width = 12,color = "blue",
fill = F)
),
box(width = 4,
infoBox("Where?", width = 12,color = "blue",
fill = F)
),
box(width = 4,
infoBox("What?", width = 12,color = "blue",
fill = F))
)),
# UI Box R1 ---------------------------------------------------------------
fluidRow(column(12,
box(width = 4,
# uiOutput(infoBoxOutput("BOX1",width = NULL)),
infoBox("Participants Trained", value =
renderText("AYval"),
width = 12,color = "blue",
icon = icon("fa-solid fa-people-group"), fill = F)
),box(width = 4,
infoBox("Training Sites", nrow(data), width = 12,color = "blue",
icon = icon("fa-solid fa-school"), fill = F)
),box(width = 4,
infoBox("Training Programs Offered", nrow(data), width = 12,color = "blue",
icon = icon("fa-solid fa-book-open-reader"), fill = F))
)),
server <- function(input, output,session) {
output$AYval <- renderText({
textInput(13)
})
output$BOX1 <- renderInfoBox({
infoBox(title = "Participants Trained",
value = 13,
width = NULL,color = "blue",
icon = icon("fa-solid fa-people-group"), fill = T)
})
}#Server End
shinyApp(ui = ui,server = server,options = list(height = 1440))
Notice the "participant trained" box is empty. That's because that value isn't hard-coded. The rest are.
Here's a small reproducible example of how to change the value contents dynamically:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
data(iris)
ui <- navbarPage(
fluid = TRUE,
theme = shinythemes::shinytheme("flatly"),
collapsible = TRUE,
header = tagList(
useShinydashboard()
),
tabPanel("START"),
tabPanel(
title = "Home Dashboard",
value = "Tab1",
selectInput("column",
label = "Select a column",
choices = c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
),
box(
width = 4,
infoBoxOutput("test")
)
)
)
server <- function(input, output, session) {
iris_sum <- reactive({
sum(iris[input$column])
})
output$test <- shinydashboard::renderInfoBox({
infoBox(
title = "Where?",
value = iris_sum(),
width = 12,
color = "blue",
fill = F
)
})
}
shinyApp(ui, server)
I'm creating a table that has 88 columns, so naturally I'd require a scrollbar, I'd also like to highlight some column variables depending on their values, however my issue is that no horizontal scrollbar appears. This is the code:
library(DT)
library(shiny)
library(shinydashboard)
library(dashboardthemes)
library(shinyjs)
data <- read.csv("somedata.csv", check.names = FALSE)
options(DT.options = list(pageLength = 5), scrollX = TRUE)
ui <- dashboardPage(
dashboardHeader(title = "Table Summary"),
dashboardSidebar(collapsed = FALSE,
sidebarMenu(
id = "tabs",
menuItem(text = "Tab 1",
tabName = "t1",
icon = icon('trophy'),
selected = TRUE
)
)
),
dashboardBody(
shinyjs::useShinyjs(),
tabItems(
tabItem(
tabName = "t1",
#we wan to create 3 separate pages on this tab
tabsetPanel(
id = "t1Selected", #returns value of current page we're on,
type = "tabs",
tabPanel(
title = "totals",
id = "tab_totals",
fluidRow(
column(width = 6, align = "right", DT::dataTableOutput("table"))
#DT::dataTableOutput("table")
),
fluidRow(
column(
width = 3, align = "left", checkboxInput("bt1", "Test for this?", TRUE)
),
column(
width = 3, align = "left",numericInput("bt1C", "Choice", 0, min = -100, max = 100)
),
column(
width = 3, align = "left", checkboxInput("bt2", "Test for this?", TRUE)
),
column(
width = 3, align = "left",numericInput("bt2C", "Choice", 0, min = -100, max = 100)
),
)
)
)
)
)
)
)
server <- function(input, output, session) {
observe({
shinyjs::enable("bt1C")
if(input$bt1 == 0){
shinyjs::disable("bt1C")
}
})
output$table <- DT::renderDataTable({
datatable(data) %>% formatStyle('Message_ratio', backgroundColor = styleEqual(c(0, 9.57), c('gray', 'yellow')))
})
}
shinyApp(ui, server)
I have the global setting for DT.options saying that scrollX should be on, but no horizontal taskbar comes up....
If it matters, I'm using windows.
Any suggestions would be helpful.
Before anyone recommends this link: How to make the horizontal scrollbar visible in DT::datatable
I've already tried what theyre saying, did not seem to help.
Using mtcars as example this works for me to get a horizontal scroll bar.
library(DT)
library(shiny)
library(shinydashboard)
library(dashboardthemes)
library(shinyjs)
data <- mtcars
ui <- dashboardPage(
dashboardHeader(title = "Table Summary"),
dashboardSidebar(collapsed = FALSE,
sidebarMenu(
id = "tabs",
menuItem(text = "Tab 1",
tabName = "t1",
icon = icon('trophy'),
selected = TRUE
)
)
),
dashboardBody(
shinyjs::useShinyjs(),
tabItems(
tabItem(
tabName = "t1",
#we wan to create 3 separate pages on this tab
tabsetPanel(
id = "t1Selected", #returns value of current page we're on,
type = "tabs",
tabPanel(
title = "totals",
id = "tab_totals",
fluidRow(
column(width = 6, align = "right", DT::dataTableOutput("table"))
#DT::dataTableOutput("table")
),
fluidRow(
column(
width = 3, align = "left", checkboxInput("bt1", "Test for this?", TRUE)
),
column(
width = 3, align = "left",numericInput("bt1C", "Choice", 0, min = -100, max = 100)
),
column(
width = 3, align = "left", checkboxInput("bt2", "Test for this?", TRUE)
),
column(
width = 3, align = "left",numericInput("bt2C", "Choice", 0, min = -100, max = 100)
),
)
)
)
)
)
)
)
server <- function(input, output, session) {
observe({
shinyjs::enable("bt1C")
if(input$bt1 == 0){
shinyjs::disable("bt1C")
}
})
output$table <- DT::renderDataTable({
datatable(data, options = list(scrollX = TRUE)) %>%
formatStyle('mpg', backgroundColor = styleEqual(c(0, 9.57), c('gray', 'yellow')))
})
}
shinyApp(ui, server)
I have a reproducible example below where only the first tabPanel is working, however when I switch to another panel, I don't get any renders (the toggle becomes un-interactable also). I have looked into conditionalPanel however I see them getting done without the use of mainPanel I was wondering if it possible to have tabs where each tab has its own mainPanel , so I can see a different sidebar and an output contained within different tabs. Any help is welcome!
options(scipen = 99999) #converts the sci numbers to their regular format
library(shiny)
library(shinyjs)
library(shinyWidgets)
library(shinyalert)
library(esquisse)
library(DT)
library(dplyr)
#library(devtools)
#library(remotes)
#remotes::install_github("dreamRs/esquisse")
library(hrbrthemes)
library(ggthemes)
library(ggplot2)
library(svglite)
ui <- fluidPage(
shinyjs::useShinyjs(), # enables javascript/jQuery enhanchments
# Create Right Side Text
navbarPage(
title= div(HTML("G<em>T</em>")),
#General reports
tabPanel("General Reports",
shinyWidgets::materialSwitch(inputId = "toggleSidebar", label = "Toggle Panel: ",
value = TRUE, status = "warning"),
sidebarLayout(
# radio/action buttons
sidebarPanel(
id = "Sidebar",
shinyWidgets::prettyRadioButtons(
inputId = "controller",
label = "Choose:",
choices = c("About"= 1,
"iris"= 2),
icon= icon("check"),
selected = 1,
status = "success",
animation="smooth"
),
br(),
br(),
a(actionButton(inputId = "admin_email", label = "Contact",
icon = icon("envelope", lib = "font-awesome")),
href="mailto:xyz#email.us")
),
#panel where output is shown from server
mainPanel(
id = "main_panel",
tabsetPanel(
id = "hidden_tabs",
type = "hidden",
tabPanelBody(
"panel1", "Text coming soon."
),
tabPanelBody(
"panel2",
tabsetPanel(
tabPanel("Data", DT::DTOutput('panel2_data')),
tabPanel(
"DIY Plot",
esquisse::esquisse_ui(
id = "esquisse2",
header = FALSE,
container = esquisseContainer(
width = "100%", height = "760px", fixed = FALSE
),
controls = c("labs", "parameters", "appearance", "filters", "code")
)
)
)
)
)
)
)
),
# monthly reports
tabPanel("Extra General Reports",
shinyWidgets::materialSwitch(inputId = "toggleSidebar", label = "Toggle Panel: ",
value = TRUE, status = "warning"),
sidebarLayout(
# radio/action buttons
sidebarPanel(
id = "Sidebar",
shinyWidgets::prettyRadioButtons(
inputId = "controller",
label = "Choose:",
choices = c("About"= 3,
"mtcars"= 4),
icon= icon("check"),
selected = 3,
status = "success",
animation="smooth"
),
br(),
br(),
a(actionButton(inputId = "admin_email", label = "Contact",
icon = icon("envelope", lib = "font-awesome")),
href="mailto:xyz#email.us")
),
#panel where output is shown from server
mainPanel(
id = "main_panel",
tabsetPanel(
id = "hidden_tabs",
type = "hidden",
tabPanelBody(
"panel3", "Text coming soon."
),
tabPanelBody(
"panel4",
tabsetPanel(
tabPanel("Data", DT::DTOutput('panel4_data')),
tabPanel(
"DIY Plot",
esquisse::esquisse_ui(
id = "esquisse4",
header = FALSE,
container = esquisseContainer(
width = "100%", height = "760px", fixed = FALSE
),
controls = c("labs", "parameters", "appearance", "filters", "code")
)
)
)
)
)
)
)
),
#resizes the navbar tabs/button
tags$head(tags$style(HTML('.navbar-brand {width: 270px; font-size:35px; text-align:left;
font-family: "serif";')))
)
)
server <- function(input, output, session) {
# this event hides the side panel when toggled on/off
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
if(!isTRUE(input$toggleSidebar)) {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
} else {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
}
})
# here we put all the data
data_sets <- list(df1 = data.frame(),
df2 = iris,
df3 = data.frame(),
df4 = mtcars)
# store current dataset in reactive so we can work with plot panels
data_to_use <- reactiveValues(name = "df", data = data.frame())
# modules only need to be called it once but individually for esquisse
esquisse::esquisse_server(id = "esquisse2", data_rv = data_to_use)
esquisse::esquisse_server(id = "esquisse4", data_rv = data_to_use)
observeEvent(input$controller, {
# skip first panel since it is used to display navigation
updateTabsetPanel(session, inputId= "hidden_tabs", selected = paste0("panel", input$controller))
# enswure value is avilable throught selected tabSet
req(input$controller)
# get current data and df name
data_to_use$data <- data_sets[[as.numeric(input$controller)]]
data_to_use$name <- names(data_sets[as.numeric(input$controller)])
# update table and sum. Use server = FALSE to get full table
output[[paste0('panel', input$controller, '_data')]] <- DT::renderDT(server = FALSE, {
DT::datatable(data_to_use$data,
filter = 'top',
extensions = 'Buttons')})
})
}
#runs the app
shinyApp(ui= ui, server= server)
You have two radioButtons, one for each sidebar, but both of them have the inputId = "controller". Same with inputId = "toggleSidebar". InputIds need to be unique in shiny!
I suggest you either use a single sidebar for the entire app, or since both tabs are essentially identical you can also use modules.
I'm just starting using R and Shiny App and I'm a bit confused about how to achieve what I'm trying to do. I want to change the UI of my Shiny App. As a C# developer, I work with HTML/CSS, AdminLTE and so on. I can't find a proper documentation how to change the UI in a Shiny App.
What I want to achieve in the UI is something like the following image:
First, I removed the sidebar. Now, my problem is to box the UI. In the header, I want to add a dropdown menu with few options. Then, I want in the middle of the page to have a panel with 2 column: in the first column first row I desire to see the graph generate by R, then same text around it to explain the graph.
On top of that, I want to change the style for example of tabs or buttons.
After 2 days of work, I wrote this code but it is very far from what I want to achieve.
library(shiny)
library(shinydashboard)
# Define UI for application that draws a histogram
ui <- navbarPage(
"Test",
tabPanel(
"Introduction",
titlePanel(
div(
windowTitle = "Test window"
)
),
div(class = "my-class",
h3("LAI287 basal insulin study"),
p("Lorem ipsum dolor sit amet..."),
p("Lorem ipsum dolor sit amet..."),
actionButton(
inputId = "btnStart",
label = "Start analysis",
className = "btn-primary"
)
)
),
tabPanel(
"Attribute specification"
),
tabPanel(
dropdownMenu(type = "notifications",
notificationItem(
text = "5 new users today",
icon("users")
),
notificationItem(
text = "12 items delivered",
icon("truck"),
status = "success"
),
notificationItem(
text = "Server load at 86%",
icon = icon("exclamation-triangle"),
status = "warning"
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
The result of this code is in the following screenshot. The only dropdown I found was for messages or notifications.
I know AdminLTE quite well but I don't understand how to write the code for Shiny App. Do you have any idea or suggestion how I can implement this UI? Is there any good tutorial I can read?
Update
I found some documentation on RStudio Shiny dashboard. First, I don't understand the difference between dashboardPage and navbarPage. Can I add a navbarPage to a dashboardPage?
From the documentation, I added this code:
box(
title = "Histogram", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot3", height = 250)
),
box(
title = "Inputs", status = "warning", solidHeader = TRUE,
"Box content here", br(), "More box content",
sliderInput("slider", "Slider input:", 1, 100, 50),
textInput("text", "Text input:")
)
and I expect something like
but my result is like that (thanks Jan for the menu)
I saw on the other page of the documentation that it is possible to add
dashboardPage(skin = "blue")
but in my case I don't have a dashboardPage.
Are you aware of the navbarMenu function? You can add menu items to the navbarPage with it:
navbarPage("App Title",
tabPanel("Plot"),
navbarMenu("More",
tabPanel("Summary"),
"----",
"Section header",
tabPanel("Table")
)
)
Layouting can be done with fluid layouts, e.g.
fluidRow(
column(width = 4,
"4"
),
column(width = 3, offset = 2,
"3 offset 2"
)
See the layout guide for the necessary details.
If you are familiar with AdminLTE then I strongly recommend using bs4Dash. It is a very robust package that allows for the use of boxes and other features that are regularly a part of AdminLTE (including Bootstrap 4). But the core of the language is still Shiny, so you may need to work through a few basic examples before attempting anything with greater complexity.
You can change colors, font-sizes, etc. in bs4Dash by following the instructions on this page.
For a demo of what is possible, see here.
I've provided a very basic example at the bottom of this answer.
Otherwise adding a dropdown navigation in bs4Dash is a bit tricky, and will require a combination of Javascript, CSS, and HTML. Luckily, you can modify all of these things.
Good luck!
library(shiny)
library(bs4Dash)
ui <- dashboardPage(
header = dashboardHeader(
leftUi = tagList(
dropdownMenu(
badgeStatus = "info",
type = "notifications",
notificationItem(
inputId = "notice1",
text = "Put text here!",
status = "danger"
)
),
dropdownMenu(
badgeStatus = "info",
type = "tasks",
taskItem(
inputId = "notice2",
text = "My progress",
color = "orange",
value = 10
)
)
)
),
dashboardSidebar(disable = T),
body = dashboardBody(
fluidRow(
column(width = 8,
box(width = NULL, title = "Old Faithful Geyser Data",
collapsible = F,
wellPanel( sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)),
plotOutput("distPlot")
),
box(width = NULL, title = NULL, collapsible = F,
fluidRow(
column(width = 5,
tags$img(src = "https://i.stack.imgur.com/EslMF.png", width = '100%')
),
column(width = 7,
tags$h4("Card Title"),
tags$p("Some text here")
)
)
)
),
column(width = 4,
box(width = NULL, title = "Header", status = "info", collapsible = F),
box(width = NULL, title = "Header", status = "success", collapsible = F),
box(width = NULL, title = "Header", status = "secondary", collapsible = F)
)
)
),
controlbar = dashboardControlbar(
collapsed = FALSE,
div(class = "p-3", skinSelector()),
pinned = TRUE
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui = ui, server = server)
In the given R shiny script below, I am trying to use a conditional panel with Picker Input shiny widget. There are three options in pickerInput, upon selection of "times" option, I wish to create new pickerInputs using a conditional panel, the following is possible using selectInput, but I need the same for Picker Input. Thanks and please help.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Picket",titleWidth = 290),
dashboardSidebar(width = 0),
dashboardBody(
tabsetPanel(type = "tab",
tabPanel("Overview", value = 1,
box(
column(1,
dropdown(
pickerInput(inputId = "resources",
label = "",
choices = c("cases",
"activities",
"times"),
choicesOpt = list(icon = c("fa fa-bars",
"fa fa-bars",
"fa fa-safari")),
options = list(`icon-base` = "")),
circle = FALSE, status = "primary", icon = icon("list", lib = "glyphicon"), width = "300px"
),
conditionalPanel(
condition = "input.Position == 'times' ",
dropdown(
pickerInput(inputId = "Id072",
label = "Select/deselect all options",
choices = c("A","Check-out", "b","c","d","e","f")
)))))),
id= "tabselected"
)
))
server <- function(input, output) {
}
shinyApp(ui, server)
Shouldnt this condition = "input.Position == 'times' ", be condition = "input.resources == 'times' ",?