Is there a way to display the box with the available dates a little lower than the default position after clicking a dateRangeInput()? I have an issue in my original app which I do not know why happens and therefore I cannot recreate it.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = tags$body(class="skin-blue sidebar-mini control-sidebar-open", dashboardPagePlus(
tags$head(
tags$style(
HTML(
".control-sidebar-tabs {display:none;}"
)
)
),
header = dashboardHeaderPlus(
enable_rightsidebar = TRUE,
rightSidebarIcon = "gears"
),
sidebar = dashboardSidebar(),
body = dashboardBody(
),
rightsidebar = rightSidebar(
background = "dark",
uiOutput("sel"),
uiOutput("dr")
),
title = "Right Sidebar"
)),
server = function(input, output) {
output$dr <- renderUI({
dateRangeInput("range_date", "Enter Date Range", start = "2001-01-01",
end = "2010-12-31" , format = "yyyy-mm")
})
output$sel<-renderUI({
selectInput("variable", "Variable:",
c("Cylinders" = "cyl",
"Transmission" = "am",
"Gears" = "gear"))
})
}
)
Related
I'm using the shinyBS package in a shiny app and I'm struggle with adjusting the height of the panel ! I have tried to put the height=100% in bsCollapse and bsCollapsePanel but it did not work !
library(shiny)
library(shinythemes)
library(shinyjs)
library(collapsibleTree)
library(shinyBS)
library(shinycssloaders)
ui <- fluidPage(
theme = shinytheme("flatly"),
useShinyjs(),
navbarPage(HTML("MyApp"),
tabPanel("Home",
bsCollapse(id = "output_data_all", multiple = TRUE,open = "Data",
bsCollapsePanel("Data", style = "info",
selectInput(inputId = 'Ind1',
label = 'Select Container',
choices = c(),
selected = NULL),
br(),br(),
withSpinner(collapsibleTreeOutput("t1"),type=5),
br(),br()
))
)
)
)
Server <- function(input, output,session){
output$t1 <- renderCollapsibleTree({
})
}
You can enclose the contents of the panel in a div with style = "height: 70vh" (adjust 70 as you want - this means 70% of the viewport height):
ui <- fluidPage(
theme = shinytheme("flatly"),
useShinyjs(),
navbarPage(
HTML("MyApp"),
tabPanel("Home",
bsCollapse(id = "output_data_all", multiple = TRUE,open = "Data",
bsCollapsePanel("Data", style = "info",
div(
style = "height: 70vh",
selectInput(inputId = 'Ind1',
label = 'Select Container',
choices = c(),
selected = NULL),
br(),br(),
withSpinner(collapsibleTreeOutput("t1"),type=5),
br(),br()
)
)
)
)
)
)
How can I select multiple items in selectInput() when selectize=F?
library(shiny)
library(shinydashboard)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
uiOutput("box1")
),
title = "DashboardPage"
),
server = function(input, output) {
output$box1<-renderUI({
box(
selectInput(inputId = "in", label = "Choose", choices = c('Short','A very short sentence.'),
selectize = F,multiple=T, size = 5, width = "150px")
)
})
}
)
What you have is allowing multiple selections.
You may see it more clearly if you add this (even if it's temporary)
Add verbatimTextOutput(outputId = "res") after the uiOutput("box1") (don't forget to add a comma) and add output$res <- renderPrint({input$`in`}) after output$box1 in server
library(shiny)
library(shinydashboard)
shinyApp(
ui = dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
uiOutput("box1"), # comma added here
verbatimTextOutput(outputId = "res") # this is added
),
title = "DashboardPage"
),
server = function(input, output) {
output$box1 <- renderUI({
box(
selectInput(inputId = "in", label = "Choose", choices = c('Short','A very short sentence.'),
selectize = F,multiple=T, size = 5, width = "150px")
)# ends the box
}) # ends output$box1
output$res <- renderPrint({input$`in`}) # this is added here - since 'in' is a keyword I would suggest a different id...
} # ends server call
) # ends shinyApp
I have the shinydashboard below in which I have 3 tabPanels. In the 1st tabPanel "Resource Allocation" I want the left and right sidebar open by default. In the 2nd and 3rd tabpanels ("Time Series","Longitudinal View") I want only left sidebar and the right sidebar not just hidden but to not be able to open at all by pushing the "gears" icon above it which should be removed. And in the fourth panel "User Guide" I want no sidebar and no choise to open one of them at all.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
shinyApp(
ui = dashboardPage(
options = list(sidebarExpandOnHover = TRUE),
header = dashboardHeader(
titleWidth = "0px"
),
sidebar = dashboardSidebar(minified = TRUE, collapsed = F),
body = dashboardBody(
useShinyjs(),#tags$head(tags$script(src="format_number.js")),
tags$script("document.getElementsByClassName('sidebar-toggle')[0].style.visibility = 'hidden';"),
tabsetPanel(
tabPanel("Resource Allocation"),
tabPanel("Time Series"),
tabPanel("Longitudinal View"),
tabPanel("User Guide")
)
),
controlbar = dashboardControlbar(collapsed = F),
title = "DashboardPage"
),
server = function(input, output) { }
)
I have a solution for the left sidebar. I am sure you can spend sometime and figure out the solution for the right sidebar. Please note that this requires some more work to fine tune to your needs. Try this
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyjs)
library(DT)
ui <- shinydashboardPlus::dashboardPage(
options = list(sidebarExpandOnHover = TRUE),
shinydashboardPlus::dashboardHeader(
#titleWidth = "0px"
),
shinydashboardPlus::dashboardSidebar( disable = TRUE ,
sidebarMenu(
selectInput(
"countries", label = "Select Countries",
choices = c("B", "C", "A"), selected = "A",
multiple = TRUE
))
),# minified = TRUE, collapsed = F),
controlbar = shinydashboardPlus::dashboardControlbar(id = "controlbar", collapsed = F,
skin = "dark",
controlbarMenu(
id = "menu",
controlbarItem(
"Tab 1",
"Welcome to tab 1"
),
controlbarItem(
"Tab 2",
"Welcome to tab 2"
)
)
),
shinydashboard::dashboardBody(
useShinyjs(),
tabsetPanel( id="tabset",
tabPanel("Resource Allocation", value="tab1", plotOutput("plot")),
tabPanel("Time Series", value="tab2", plotOutput("plot2")),
tabPanel("Longitudinal View", value="tab3", DTOutput("ir")),
tabPanel("User Guide", value="tab4", DTOutput("mt"))
)
),
# controlbar = dashboardControlbar(collapsed = F),
title = "DashboardPage"
)
server <- function(input, output) {
output$plot <- renderPlot(plot(cars))
output$plot2 <- renderPlot(plot(pressure))
output$mt <- renderDT(mtcars)
output$ir <- renderDT(iris)
observeEvent(input[["tabset"]], {
if(input[["tabset"]] == "tab4"){
addClass(selector = "body", class = "sidebar-collapse")
updateControlbar("controlbar")
}else{
removeClass(selector = "body", class = "sidebar-collapse")
}
})
}
shinyApp(ui, server)
have anyone seen something that we can call horizontalProgress in Shiny? I found function verticalProgress which is almost perfect for my, unfortunately I need to transposition it. Maybe how to help my? Maybe using CSS?
if (interactive()) {
library(shiny)
library(shinydashboard)
shinyApp(
ui = dashboardPagePlus(
header = dashboardHeaderPlus(
enable_rightsidebar = TRUE,
rightSidebarIcon = "gears"
),
sidebar = dashboardSidebar(),
body = dashboardBody(
verticalProgress(
value = 20,
status = "danger",
size = "xs",
height = "60%"
)
),
rightsidebar = rightSidebar(),
title = "Right Sidebar"
),
server = function(input, output) { }
)
}
You can use transform in the style :
div(style="display: inline-block; transform: rotate(10deg);",verticalProgress(
value = 20,
status = "danger",
size = "xs",
height = "60%"
))
Alternatively you can use shinyWidgets library which has progressBar
if (interactive()) {
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
shinyApp(
ui = dashboardPagePlus(
header = dashboardHeaderPlus(
enable_rightsidebar = TRUE,
rightSidebarIcon = "gears"
),
sidebar = dashboardSidebar(),
body = dashboardBody(
column(2,
progressBar(id = "pb6", value = 20, status = "danger", size = "xs")
)
),
rightsidebar = rightSidebar(),
title = "Right Sidebar"
),
server = function(input, output) { }
)
}
I'm using the dropdownButton function from this link drop-down checkbox input in shiny that is in shinyWidgets, with a slight modification so that the text is black.
I want the dropdownButton to look like the selectInput drop down I have above it as much as possible. I got them to line up in the sidebar with column(1,) function, but I also want the width of the dropdownButton to be the same width as the selectInput.
I also got the width of the dropdown choices to be the same width of the selectInput above it with width=200, but I want the dropdown button to also be the same size.
Can someone help me modify the dropDownButton function or my UI so that this is the case?
library(shiny)
library(shinydashboard)
dropdownButton2 <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {
status <- match.arg(status)
# dropdown button content
html_ul <- list(
class = "dropdown-menu",
style = if (!is.null(width))
paste0("width: ", validateCssUnit(width), ";"),
lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;color:black")
)
# dropdown button apparence
html_button <- list(
class = paste0("btn btn-", status," dropdown-toggle"),
type = "button",
` data-toggle` = "dropdown"
)
html_button <- c(html_button, list(label))
html_button <- c(html_button, list(tags$span(class = "caret")))
# final result
tags$div(
class = "dropdown",
do.call(tags$button, html_button),
do.call(tags$ul, html_ul),
tags$script(
"$('.dropdown-menu').click(function(e) {
e.stopPropagation();
});")
)
}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(width = 325,
selectInput('month',label='Filter 1:',choices= month.name,multiple = FALSE,selected = "March"),
br(),
column(1,
h5(strong(("Filter 2:"))),
dropdownButton2(
label = "Filter 2:", status = "default", width = 200,#circle = FALSE,
checkboxGroupInput(inputId = "check1", label = "Choose", choices = c("A","B","C"))
)
)),
dashboardBody()
)
server <- function(input, output){
}
shinyApp(ui = ui, server = server)
You can do so by adding the css tag tags$style(type = 'text/css', ".btn-default{width: 275px;}") in your ui code as below:
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(width = 325,
selectInput('month',label='Filter 1:',choices= month.name,multiple = FALSE,selected = "March"),
br(),
column(1,
h5(strong(("Filter 2:"))),
tags$style(type = 'text/css', ".btn-default{width: 275px;}"),
dropdownButton2(
label = "Filter 2:", status = "default", width = 200,#circle = FALSE,
checkboxGroupInput(inputId = "check1", label = "Choose", choices = c("A","B","C"))
)
)),
dashboardBody()
)
On adding the tag you get something like this:
[EDIT]:
I later realized that the caret was not right aligned as in the case of selectInput hence to align that I further added couple of css tags as follows:
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(width = 325,
selectInput('month',label='Filter 1:',choices= month.name,multiple = FALSE,selected = "March"),
br(),
column(1,
h5(strong(("Filter 2:"))),
tags$style(type = 'text/css', ".btn-default{width: 275px;}"),
tags$style(type = 'text/css', ".btn .caret{position: relative;}"),
tags$style(type = 'text/css', ".caret{top: 45%; right:-35%}"),
dropdownButton2(
label = "Filter 2:", status = "default", width = 200,#circle = FALSE,
checkboxGroupInput(inputId = "check1", label = "Choose", choices = c("A","B","C"))
)
)),
dashboardBody()
)
The additional tags resulted the caret to be aligned as follows: