Here's the most basic 3 slide carousel implemented using shinydashboardPlus
The default behaviour is to show the previous/next slide chevrons. However, I can't seem to get them to appear. Why is this?
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
ui <- fluidPage(
titlePanel("Carousel Demo"),
carousel(indicators = TRUE,
id = "mycarousel",
carouselItem(
tags$img(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=Slide+1")
),
carouselItem(
tags$img(src = "https://placehold.it/900x500/bbbbbb/ffffff&text=Slide+2")
),
carouselItem(
tags$img(src = "https://placehold.it/900x500/ff0000/ffffff&text=Slide+3")
)
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
It seems you have to use caroussel from within a dashboardPagePlus to get its default layout.
Set disable = TRUE to hide the header, and width = 0 to hide the sidebar, if you don't need them:
ui <- dashboardPagePlus(
header = dashboardHeaderPlus( disable = TRUE ),
sidebar = dashboardSidebar( width = 0 ),
body = dashboardBody(
carousel(indicators = TRUE,
id = "mycarousel",
carouselItem(
tags$img(src = "https://placehold.it/900x500/3c8dbc/ffffff&text=Slide+1")
),
carouselItem(
tags$img(src = "https://placehold.it/900x500/bbbbbb/ffffff&text=Slide+2")
),
carouselItem(
tags$img(src = "https://placehold.it/900x500/ff0000/ffffff&text=Slide+3")
)
)
)
)
Related
In my shinydashboardPlus app, I use fluidRow/column to specify my layout. Sometimes, I have one or several textInput / selectInput and an actionButton in one row. Since the input elements do have a label, they are vertically larger than the button, which does not look very nice. For example:
Is there an easy way to move the actionButton a little below so that it is in line with, for example, the "local" element?
Here is a minimal example:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
ui <- shinydashboardPlus::dashboardPage(
header=shinydashboardPlus::dashboardHeader(title = "Align Example"),
sidebar=shinydashboardPlus::dashboardSidebar(
shinydashboard::sidebarMenu(id = "tabs",
shinydashboard::menuItem(
"Welcome", tabName = "welcome"
)
)
),
body=shinydashboard::dashboardBody(
shinydashboard::tabItems(
shinydashboard::tabItem(tabName="welcome",
shiny::fluidRow(
shinydashboardPlus::box(
status="black", solidHeader = TRUE, width=12, closable = FALSE,
title="Welcome!",
shiny::column(4,
shiny::textInput("username", label="User Name:")
),
shiny::column(4,
shiny::passwordInput("passwd", label="Password:")
),
shiny::column(2,
shiny::selectInput(inputId="dbmode", "Modus:",
choices = c("production", "test", "local"),
selected = "local"
)
),
shiny::column(2,
shiny::actionButton("dbconnect", "Connect!")
)
)
)
)
)
)
)
server <- function(input, output, session) {
}
shiny::shinyApp(ui, server)
With the help of SelectorGadget and then searching SO for "margin-bottom", I found this post, which led me to
shiny::column(2,
shiny::actionButton(ns("dbconnect"), "Connect!"),
style = "margin-top:25px;" ## <-- !
)
Not sure if this is good practice, but I am happy for now.
The easiest way I can think of is to ad a br() before the action button:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
ui <- shinydashboardPlus::dashboardPage(
header=shinydashboardPlus::dashboardHeader(title = "Align Example"),
sidebar=shinydashboardPlus::dashboardSidebar(
shinydashboard::sidebarMenu(id = "tabs",
shinydashboard::menuItem(
"Welcome", tabName = "welcome"
)
)
),
body=shinydashboard::dashboardBody(
shinydashboard::tabItems(
shinydashboard::tabItem(tabName="welcome",
shiny::fluidRow(
shinydashboardPlus::box(
status="black", solidHeader = TRUE, width=12, closable = FALSE,
title="Welcome!",
shiny::column(4,
shiny::textInput("username", label="User Name:")
),
shiny::column(4,
shiny::passwordInput("passwd", label="Password:")
),
shiny::column(2,
shiny::selectInput(inputId="dbmode", "Modus:",
choices = c("production", "test", "local"),
selected = "local"
)
),
shiny::column(2,
br(),
shiny::actionButton("dbconnect", "Connect!")
)
)
)
)
)
)
)
server <- function(input, output, session) {
}
shiny::shinyApp(ui, server)
I would require an action button icon on the top right corner of the shiny dashboard box. The below code appends the icons 'refresh' and 'plus' adjacent to the 'Title1'. However, I would require the icons to be placed at the right side end of the header bar (Similar to the positions of minimize, restore and close button in windows application).
library(shiny)
library(shinydashboard)
body <- dashboardBody(
fluidRow(
box(
title = p("Title 1",
actionButton("titleBtId", "", icon = icon("refresh"),
class = "btn-xs", title = "Update"),
actionButton('titleBtid2', '', icon = icon('plus'),
class='btn-xs', title = 'update')
),
width = 4, solidHeader = TRUE, status = "warning",
uiOutput("boxContentUI2")
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Row layout"),
dashboardSidebar(),
body
)
server = function(input, output, session) {
output$boxContentUI2 <- renderUI({
input$titleBtId
pre(paste(sample(LETTERS,10), collapse = ", "))
})
}
shinyApp(ui = ui, server = server)
Add a style declaration with absolute positioning to your action buttons.
library(shiny)
library(shinydashboard)
body <- dashboardBody(
fluidRow(
box(
title = p("Title 1",
actionButton("titleBtId", "", icon = icon("refresh"),
class = "btn-xs", title = "Update", style = "position: absolute; right: 40px"),
actionButton('titleBtid2', '', icon = icon('plus'),
class = 'btn-xs', title = 'update', style = "position: absolute; right: 10px")
),
width = 4, solidHeader = TRUE, status = "warning",
uiOutput("boxContentUI2")
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Row layout"),
dashboardSidebar(),
body
)
server = function(input, output, session) {
output$boxContentUI2 <- renderUI({
input$titleBtId
pre(paste(sample(LETTERS,10), collapse = ", "))
})
}
shinyApp(ui = ui, server = server)
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) { }
)
}
Given below the code i used for displying selectizeInput and absolutePanel. selectizeInput is not getting merged with the page background. it is displaying above the absolutePanel. please help me to fix.
ui.r
library(shinydashboard)
shinyUI(
fluidPage(
dashboardPage(skin = c("blue"),
dashboardHeader(title = "R Tools"
),
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
),
dashboardBody(
box(
title = "Tools", status = "primary", solidHeader = TRUE,
collapsible = TRUE,width = 4,
uiOutput("showtxttruevalue"),
uiOutput("showddllalternate")
),
absolutePanel(
bottom = 20, right = 60,top=200, width = "auto",
draggable = TRUE,
wellPanel(
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
aa")
), style = "opacity: 0.9"
)
)
))
server.r
library(shiny)
library(ggplot2)
library(googleVis)
shinyServer(function(input, output, session) {
output$showtxttruevalue <- renderUI({
numericInput(inputId="txttruevalue", label="TrueValue", value = 0)
})
output$showddllalternate <- renderUI({
selectizeInput("ddllalternate", "Alternate:",c('unequal','less','greater'), selected='<>')
})
})
To fix it, use the 'left' parameter while positioning the absolutePanel(). Use the following to position it.
absolutePanel(
left = 500, bottom = 20, right = 60,top=200, width = "auto",
draggable = TRUE,
wellPanel(
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
aa")
), style = "opacity: 0.9"