Taking the example from the shinyBS website, I would like to add a boxdropdown menu with an element which - when clicked/hovered over - should display some information. I followed the example but somehow the info is not displayed.
library(shiny)
library(shinyBS)
library(shinydashboardPlus)
shinyApp(
ui =
fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
bsTooltip("bins", "The wait times will be broken into this many equally spaced bins",
"right", options = list(container = "body"))
),
mainPanel(
box(
title = "Plot",
plotOutput("distPlot"),
solidHeader = T,
dropdownMenu = boxDropdown(
boxDropdownItem(id = "showDescription", "Description", icon = icon("info-circle")),
icon = icon("bars")
)
)
)
)
),
server =
function(input, output, session) {
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')
})
addPopover(session, "showDescription", "Data", content = paste0("blablabla"), trigger = 'click')
}
)
Related
I'm trying to mimic this specific shiny app. https://columbia.shinyapps.io/yingli/
I haven't found similar apps with access to the code.
I have Leonardo DiCaprio gif in the background, but I would like to know how to add tabs the same way as the app below, and if you click on the right directional key, it will go to other tabs, within the tab.
if (interactive()) {
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
tags$h2("Add a shiny app background image"),
setBackgroundImage(
src = "https://blog.hubspot.com/hubfs/Smiling%20Leo%20Perfect%20GIF.gif"
),
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput(outputId = "distPlot")
)
)
)
server <- function(input, output, session) {
# 2. Its output type is a plot
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
}
shinyApp(ui, server)
}
For completeness, here's a example using the awesome fullPage library mentioned in the comments:
# Dependencies install
# install.packages("remotes")
# remotes::install_github("RinteRface/fullPage")
library(shiny)
library(fullPage)
options <- list(
sectionsColor = c('#f2f2e2', '#f2f2f2', '#f2f2f2'),
parallax = TRUE
)
ui <- fullPage(
menu = c("Full Page" = "tab1","Sections" = "tab2","Image" = "tab3"),
opts = options,
fullSection(
center = TRUE,
menu = "tab1",
tags$h1("fullPage.js meets Shiny")
),
fullSection(
menu = "tab2",
fullRow(
fullColumn(
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30)
),
fullColumn(
plotOutput(outputId = "distPlot")
)
)
),
fullSectionImage(
menu = "tab3",
img = "https://blog.hubspot.com/hubfs/Smiling%20Leo%20Perfect%20GIF.gif"
)
)
server <- function(input, output){
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
}
shinyApp(ui, server)
Although the fullpage.js library that it is used allow some configuration to use left/right keys to navigate, the shiny wrapper library above doesn't seem to expose that setting - I could only disable/enable the keyboard, but not choose direction.
I have a shiny app with fileInput.
I created a reset button to clear the file from the fileInput. I know the file is cached in the shiny memory, but I just want to reset the FileInput object to look like how it originally did before I uploaded the file, when I press the reset button.
I googled a bit and found most people get around this problem using shinyjs, but shinyjs does not work in the R package I am creating so I am trying to find a work around.
I insert a executable code below!
library(shiny)
library(shinythemes)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
fileInput(inputId = "ABC", label = "Input File", multiple = FALSE, accept = NULL,
width = "20%", buttonLabel = "Browse...",
placeholder = "You didn't choose any files to test, so select beside"),
sidebarLayout(
sidebarPanel(h4("Select the best the number of bins"),
br(),
br(),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("reset", "Reset"),
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output,session) {
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')
})
observeEvent(input$reset, {
updateSliderInput(session,"bins",value = 1)
})
}
shinyApp(ui = ui, server = server)
One way would be to use fileInput dynamically from server side, so when the reset button is clicked you can reload the input.
library(shiny)
library(shinythemes)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
uiOutput('file'),
sidebarLayout(
sidebarPanel(h4("Select the best the number of bins"),
br(),
br(),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("reset", "Reset"),
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output,session) {
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')
})
output$file <- renderUI({
fileInput(inputId = "ABC", label = "Input File", multiple = FALSE, accept = NULL,
width = "20%", buttonLabel = "Browse...",
placeholder = "You didn't choose any files to test, so select beside")
})
observeEvent(input$reset, {
updateSliderInput(session,"bins",value = 1)
output$file <- renderUI({
fileInput(inputId = "ABC", label = "Input File", multiple = FALSE, accept = NULL,
width = "20%", buttonLabel = "Browse...",
placeholder = "You didn't choose any files to test, so select beside")
})
})
}
shinyApp(ui = ui, server = server)
I want to add a burger menu in the navbar to toggle a sidebar in a shiny app.
This might get you started:
library(shiny)
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
conditionalPanel(condition = "input.toggleSidebarPanel % 2 == 0", sidebarPanel(
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30)
)),
mainPanel(actionButton("toggleSidebarPanel", "", icon = icon("bars")),
plotOutput(outputId = "distPlot")
)
)
)
server <- function(input, output, session) {
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
}
shinyApp(ui, server)
How to make a menutem badge to align differently than default?
in the shinyUI.:
menuItem("Test", tabName = "test", icon = icon("line-chart"),badgeLabel = "2nd", badgeColor = "green")
Full example:
library(shiny)
library(shinydashboard)
# Default shiny
ui <- dashboardPage(
dashboardHeader(title = "Example"),
dashboardSidebar(
sidebarMenu(
menuItem("Test", tabName = "test", icon = icon("line-chart"),
badgeLabel = "2nd", badgeColor = "green")
)),
dashboardBody(
tabItems(
tabItem(tabName = "test",
box(title = "How-to",status = "primary",solidHeader = TRUE,collapsible=TRUE, width = 8,
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
# Show a plot of the generated distribution
plotOutput("distPlot")
)
)
)))
# 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)
In the browser inspecting it shows the following code/:
<small class="badge pull-right bg-green">2nd</small>
test pic
I need:
<small class="badge center-block bg-green">2nd</small>
desired pic
Any idea?
You can use css as follows:
tags$style(type = 'text/css',".badge{min-width: 200px;}")
In your code it would come something like this:
library(shiny)
library(shinydashboard)
# Default shiny
ui <- dashboardPage(
dashboardHeader(title = "Example"),
dashboardSidebar(
##The added css
tags$style(type = 'text/css',".badge{min-width: 200px;}"),
sidebarMenu(
menuItem("Test", tabName = "test", icon = icon("line-chart"),
badgeLabel = "2nd", badgeColor = "green")
)),
dashboardBody(
tabItems(
tabItem(tabName = "test",
box(title = "How-to",status = "primary",solidHeader = TRUE,collapsible=TRUE, width = 8,
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
# Show a plot of the generated distribution
plotOutput("distPlot")
)
)
)))
# 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)
You get something like this:
Hope it helps!
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
includeCSS(path = "AdminLTE.css"), #added
includeCSS(path = "shinydashboard.css"), #added
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
box(plotOutput("distPlot"), solidHeader = T, collapsible = T, title = "collapsible box not collapsing", status = "primary")
)
)
)
# 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)
This result is
In the above image the collpasible box is not getting collapsed when clicked on mininize button.
I have added the addtional AdminLTE.css and shinydashboard.css file in working directory, but still problem persists.
To use a collapsible box within shiny only. We need to add the required javascript. Just after adding css we add this file as well.
includeCSS(path = "AdminLTE.css"), #added
includeCSS(path = "shinydashboard.css"), #added
#add this file and collapsible nature should work.
includeScript(path = "app.js"), #
If you don't have a restriction to use shinydashboard, just create a dash board page without the header and the sidebar. It will enable all the features of shinydashboard and it will looks like a basic shiny app. In the code below the box collapse/uncollapse when you click on the minimize/maximize button.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(disable = TRUE),
dashboardSidebar(disable = TRUE),
dashboardBody(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30)
),
# Show a plot of the generated distribution
mainPanel(
box(plotOutput("distPlot"), solidHeader = T, collapsible = T,
title = "collapsible box not collapsing", status = "primary")
)
)
)
)
# 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)