Let's say that I have a shiny dashboard uses by default a vertical scroll bar because of a large plot in the right side but for some reason I do not want it there even if the plot is not displayed as a whole. I do not want to reduce the plot height as well.Can this be done?
## app.R ##
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(plotOutput("plot1", height = 850)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
The following css should do it : body {overflow-y: hidden;}
## app.R ##
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
tags$head(
tags$style(
"body {overflow-y: hidden;}"
)
),
# Boxes need to be put in a row (or column)
fluidRow(
box(plotOutput("plot1", height = 850)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
Related
Once I add an HTML document in my shiny app my graphs stop populating. I am using bs4dash but shinydashboard also has the exact same issue.
Below is my code as well as a screenshot of what is happening.
Code before i add HTML document
Ui
library(shiny)
library(bs4Dash)
library(highcharter)
library(plotly)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
box(width = 12,
plotlyOutput("plot1")
)
),
fluidRow(
box(
#width = 12,
#includeHTML("first.html")
)
)
)
)
Server
server <- function(input, output) {
a = rnorm(100)
output$plot1 = renderPlotly({
plot_ly(x = ~a, type = "histogram")
})
}
Now when i remove the hastags to display my HMTL document. My graph all of a sudden disappears.
Ui
library(shiny)
library(bs4Dash)
library(highcharter)
library(plotly)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
box(width = 12,
plotlyOutput("plot1")
)
),
fluidRow(
box(
width = 12,
includeHTML("first.html")
)
)
)
)
Server
server <- function(input, output) {
a = rnorm(100)
output$plot1 = renderPlotly({
plot_ly(x = ~a, type = "histogram")
})
}
I would like to have the graph still show. What is going wrong in the code. Thank you
I cannot reproduce your problem. I just observed that your fluidRow is the fourth parameter of dashboardPage which, however, expects a dashboardControlbar. Both, putting the fluidRow into dashboardBody or wrapping it in a call to dashboardControlbar works for me.
So either it is your first.html or indeed "just" the missing dashboardControlbar.
first.html
<span>I am an external HTML</span>
app.R
library(shiny)
library(bs4Dash)
library(highcharter)
library(plotly)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
box(width = 12,
plotlyOutput("plot1")
),
fluidRow(
box(
width = 12,
includeHTML("first.html")
)
)
)
)
ui2 <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
box(width = 12,
plotlyOutput("plot1")
)
),
dashboardControlbar(
fluidRow(
box(
width = 12,
includeHTML("first.html")
)
)
)
)
server <- function(input, output) {
a = rnorm(100)
output$plot1 = renderPlotly({
plot_ly(x = ~a, type = "histogram")
})
}
shinyApp(ui, server)
## shinyApp(ui2, server) ## works likewise
Screenshots
My shiny app looks like this:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(plotOutput("plot1", height = 250)),
box(textInput("my_text", # supposed to be a numeric input
"Text input:"),
title = "Controls",
sliderInput("slider",
"Number of observations:",
min = 1, max = 100,
value = 50 # Want it to be output$my_init
)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
# My attempt
# output$my_init <- input$my_text + 28
}
shinyApp(ui, server)
I want to set the initial value of the slider as output$my_init, a numeric variable that will be the result of operating some input variables. I tried using renderPrint, but the output is not numeric.
Thanks in advance.
I piggybacked on #stefan's comments and came up with this answer:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(plotOutput("plot1", height = 250)),
box(numericInput("my_num", "Numeric input:", value = 50),
title = "Controls",
sliderInput("slider",
"Number of observations:",
min = 1, max = 100,
value = 50 # Want it to be output$my_init
)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
# My attempt
observeEvent(input$my_num, {
updateSliderInput(inputId = "slider", value = input$my_num)
})
}
shinyApp(ui, server)
The idea is to use observeEvent() to trigger updateSliderInput() (update slider input widget) and update the value parameter of sliderInput()
I am trying to use shinyCAPTCHA package with shinydashboard, but it is not working correctly. What is the correct way to use it?
library(shiny)
library(shinydashboard)
library(shinyCAPTCHA)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(recaptchaUI("test", sitekey = "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI"),
uiOutput(outputId = "captcha"))
)
server <- function(input, output) {
result <- callModule(recaptcha, "test", secret = "6LeIxAcTAAAAAGG-vFI1TnRWxMZNFuojJ4WifJWe")
output$captcha <- renderUI({
req(result()$success)
output$plot1 <- renderPlot({
set.seed(122);histdata <- rnorm(500)
hist(histdata[seq_len(input$slider)], main = "Histrogram", xlab = "x") })
fluidRow(
box(plotOutput("plot1", height = 250)),
box(title = "Controls",sliderInput("slider", "Number of observations:", 1, 100, 50)))
})
}
shinyApp(ui, server)
This is less bad I think
library(shiny)
library(shinydashboard)
library(shinyCAPTCHA)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(recaptchaUI("test", sitekey = "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI"),
uiOutput(outputId = "captcha"))
)
server <- function(input, output) {
result <- callModule(recaptcha, "test", secret = "6LeIxAcTAAAAAGG-vFI1TnRWxMZNFuojJ4WifJWe")
output$captcha <- renderUI({
req(result()$success)
output$plot1 <- renderPlot({
set.seed(122);histdata <- rnorm(500)
req(reactive(input$slider)())
hist(histdata[seq_len(reactive(input$slider)())], main = "Histrogram", xlab = "x") })
fluidRow(
box(plotOutput("plot1", height = 250)),
box(title = "Controls",sliderInput("slider", "Number of observations:", 1, 100, 50)))
})
}
shinyApp(ui, server)
I am trying to make the sidebarPanel overlay the mainPanel inside a tabBox but using z-index doesn't seem to work. I.e. the box size shouldn't change when the button is clicked and the sidebarPanel appears, it should just overlay the mainPanel
library(shiny)
library(shinydashboard)
library(shinyjs)
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
useShinyjs(),
fluidRow(
div(id = "TimingBox",
tabBox(id = "Timing",
tabPanel("Tab 1",
sidebarLayout(
div(id = "Sidebar",
style = "z-index: 1000;",
sidebarPanel("There are currently 20 overdue here", width = 6)
),
mainPanel(plotOutput("plot1"), width = 12)
)
),
tabPanel("Tab 2"),
title = p("Status",actionLink("Link", NULL, icon = icon("plus-square-o")),actionLink("Link2", NULL, icon = icon("search"))), width = 4,
selected = "Tab 1"
)
)
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
shinyjs::hide(id = "Sidebar")
observeEvent(input$Link, {
shinyjs::toggle(id = "Sidebar")
})
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(50)]
hist(data)
})
}
shinyApp(ui, server)
For the Main Sidebar
The sidebar position is not depending on the z-index of the sidebar and/or the main panel.
So changing these values will not give you your desired behaviour.
What you can do is changing the margin-left css attribute of the main panel to 0px to achieve your desired result.
With this code you can achieve this, just simply add it to your dashboardBody
tags$style(".content-wrapper{margin-left: 0px;}")
Resulting in following complete code:
library(shiny)
library(shinydashboard)
library(shinyjs)
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
useShinyjs(),
tags$style(".content-wrapper{margin-left: 0px;}"),
fluidRow(
div(id = "TimingBox",
tabBox(id = "Timing",
tabPanel("Tab 1",
sidebarLayout(
div(id = "Sidebar",
style = "z-index: 1000;",
sidebarPanel("There are currently 20 overdue here", width = 6)
),
mainPanel(plotOutput("plot1"), width = 12)
)
),
tabPanel("Tab 2"),
title = p("Status",actionLink("Link", NULL, icon = icon("plus-square-o")),actionLink("Link2", NULL, icon = icon("search"))), width = 4,
selected = "Tab 1"
)
)
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
shinyjs::hide(id = "Sidebar")
observeEvent(input$Link, {
shinyjs::toggle(id = "Sidebar")
})
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(50)]
hist(data)
})
}
shinyApp(ui, server)
EDIT:
For the info Icons Sidebar:
The following will do what you want:
adding the following to the style paramerter of your sidebar div will get that done
position: fixed;
Even though this is a solution I would highly recommend you to checkout the shinydasboardPlus package and theire version of the tabbox sidebar/help. Maybe this would also be fine for you and it would require less manuel effort on your side https://github.com/RinteRface/shinydashboardPlus
They also have a demo hosted here: https://rinterface.com/shiny/shinydashboardPlus/
library(shiny)
library(shinydashboard)
library(shinyjs)
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody(
useShinyjs(),
fluidRow(
div(id = "TimingBox",
tabBox(id = "Timing",
tabPanel("Tab 1",
sidebarLayout(
div(id = "Sidebar",
style = "z-index: 1000;position: fixed;",
sidebarPanel("There are currently 20 overdue here", width = 6)
),
mainPanel(plotOutput("plot1"), width = 12)
)
),
tabPanel("Tab 2"),
title = p("Status",actionLink("Link", NULL, icon = icon("plus-square-o")),actionLink("Link2", NULL, icon = icon("search"))), width = 4,
selected = "Tab 1"
)
)
)
)
ui <- dashboardPage(header, sidebar, body)
server <- function(input, output) {
shinyjs::hide(id = "Sidebar")
observeEvent(input$Link, {
shinyjs::toggle(id = "Sidebar")
})
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(50)]
hist(data)
})
}
shinyApp(ui, server)
I'm using R shiny Dashboard for data visualization in my case i wanted to insert user input into filtering data frame in r
library(shiny)
library(shinydashboard)
ui <-
dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(
sidebarMenu(
)
),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "",
sliderInput("slider", "Number of Breaks:", 1, 180, 50)
),
box(
selectInput('BILLING_CENTRE', 'Select Billing Center', names(dfList))
)
)
)
)
server <-
function(input, output) {
d <- read.csv('Events_for_Jan_suspensions.csv')
dfList <- split(d, d$BILLING_CENTRE)
abc <- reactive({input$BILLING_CENTRE})
if (abc == "AD"){
histdata <- dfList$AD$SU_TO_OK_DURATION
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
}
shinyApp(ui, server)