I am looking for hover-over ('popover') user instructions when the cursor is placed over an icon. No modal, just a hover-over popup. I've messed around with tooltips, etc., but the text is tiny and not formattable. Package shinyBS may offer a nice solution. However, in the example code below taken from the shinyBS documentation I'd like to replace the shinyBS bsButton() with an icon (a small "i") or an image (a "?" for example) instead of the big bulky button shown in the image below. Any recommendation for how to do this?
Code:
# Source: shinyBS package documentation, pg 24-25
library(shiny)
library(shinyBS)
app = 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(
plotOutput("distPlot"),
uiOutput("uiExample")
)
)
),
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$uiExample <- renderUI({
tags$span(
popify(bsButton("pointlessButton", "Button", style = "primary", size = "large"),
"A Pointless Button",
"This button is <b>pointless</b>. It does not do <em>anything</em>!"),
tipify(bsButton("pB2", "Button", style = "inverse", size = "extra-small"),
"This button is pointless too!")
)
})
addPopover(session, "distPlot", "Data", content = paste0("<p>Waiting time between ",
"eruptions and the duration of the eruption for the Old Faithful geyser ",
"in Yellowstone National Park, Wyoming, USA.</p><p>Azzalini, A. and ",
"Bowman, A. W. (1990). A look at some data on the Old Faithful geyser. ",
"Applied Statistics 39, 357-365.</p>"), trigger = 'click')
}
)
runApp(app)
I redid the example although Stéphane Laurent answered already.
library(shiny)
library(shinyBS)
app = 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(
plotOutput("distPlot"),
uiOutput("uiExample")
)
)
),
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$uiExample <- renderUI({
tags$span(
popify(icon("info-circle", verify_fa = FALSE),
"A Pointless Icon",
"This icon is <b>pointless</b>. It does not do <em>anything</em>!"),
tipify(img(src = 'https://upload.wikimedia.org/wikipedia/commons/1/11/Blue_question_mark_icon.svg', width = '50px'),
"This image is pointless too!")
)
})
addPopover(session, "distPlot", "Data", content = paste0("<p>Waiting time between ",
"eruptions and the duration of the eruption for the Old Faithful geyser ",
"in Yellowstone National Park, Wyoming, USA.</p><p>Azzalini, A. and ",
"Bowman, A. W. (1990). A look at some data on the Old Faithful geyser. ",
"Applied Statistics 39, 357-365.</p>"), trigger = 'click')
}
)
runApp(app)
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.
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')
}
)
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)
I did a popify for my radiobutton. However I would like to separate the popify in my radiobuttom options. For example, for "filter1", I would like to insert a popify for the "All properties" and other popify for "exclude properties" options. Is this possible ?? The executable code is below.
library(shinyBS)
library(shiny)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
popify(
radioButtons("filter1", h3("Select properties"),
choices = list("All properties" = 1,
"Exclude properties" = 2),
selected = 1),
title= "Select Proprierties",
content = paste0("Filter 1 refers to.....")),
radioButtons("filter2", h3("Select farms"),
choices = list("All farms" = 1,
"Exclude farms" = 2),
selected = 1),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 20,
value = 30)
),
mainPanel(
plotOutput("distPlot")
)
)
)
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)
Thank you very much!
Looking at popify we see that it works only on full shiny elements, but you want to add it not to the whole element but a child HTML element of it.
addPopover seems thus to be the better option. However, we see that the function adds the popover on an HTML element given by an id. Problem is that the row where you want to have the popover does not have an id and the addPopover function does not allow for specifying the element by other means than the id.
Thus, we have to work around:
Use JS to add an id to the radio button rows (I use shinyjs for that).
Use this created id in addPopover
Note. In order to make addPopover run you need to include at least one shinyBS component. From the help file:
There must be at least one ‘shinyBS’ component in the UI of your
app in order for the necessary dependencies to be loaded. Because
of this, ‘addTooltip’ and ‘addPopover’ will not work if they are
the only shinyBS components in your app.
library(shinyBS)
library(shiny)
library(shinyjs) ## needed to tamper with the HTML
ui <- fluidPage(
useShinyjs(),
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
radioButtons("filter1", h3("Select properties"),
choices = list("All properties" = 1,
"Exclude properties" = 2),
selected = 1),
title= "Select Proprierties",
radioButtons("filter2", h3("Select farms"),
choices = list("All farms" = 1,
"Exclude farms" = 2),
selected = 1),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 20,
value = 30),
## need to include at least one bs element, adapt
bsTooltip("bins", "The wait times will be broken into this many equally spaced bins",
"right", options = list(container = "body"))
),
mainPanel(
plotOutput("distPlot")
)
)
)
## use JS to add an id attribute to the elements where you want to add the popover
add_id_js <- paste0(
"$('#filter1').find('.radio > label').attr('id', function(i) {",
"return 'filter1_row_' + i})")
server <- function(input, output, session) {
## once the UI is loaded, call JS function and attach popover to it
session$onFlushed(function() {
runjs(add_id_js)
addPopover(session, "filter1_row_0", "My Popover", "Content")
})
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)