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)
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 am attempting to add the Google Translate toolbar to a Shiny app, but I can't quite seem to get the syntax correct leveraging the code found at https://www.w3schools.com/howto/howto_google_translate.asp.
library(shiny)
ui <- fluidPage(
# tags$head(
tags$div(id="google_translate_element"),
HTML("<script type='text/javascript'>, function googleTranslateElementInit() {
new google.translate.TranslateElement({pageLanguage: 'en'}, 'google_translate_element');} </script>" ),
HTML("<script type='text/javascript', src='//translate.google.com/translate_a/element.js?cb=googleTranslateElementInit'></script>"),
# ),
HTML("<html lang='en'></html>"),
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
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')
})
}
shinyApp(ui = ui, server = server)
I have tried wrapping in tags$head() and I have tried calling the javascript from a .js file in my www folder with the project.
I appreciate any supports. Thank you!
Cool idea. This seems to work.
library(shiny)
ui <- fluidPage(
HTML("<!DOCTYPE html><html lang='en-US'><body><h1>My Web Page</h1><p>Hello everybody!</p><p>Translate this page:</p><div id='google_translate_element'></div><script type='text/javascript'>function googleTranslateElementInit() {new google.translate.TranslateElement({pageLanguage: 'en'}, 'google_translate_element');}</script><script type='text/javascript' src='//translate.google.com/translate_a/element.js?cb=googleTranslateElementInit'></script></body></html>"),
titlePanel("Old Faithful Geyser Data"),
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30
)
),
mainPanel(
plotOutput("distPlot")
)
)
server <- function(input, output) {
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')
})
}
shinyApp(ui = ui, server = server)
Is it possible to use box() element in classic shiny app? As classic app I mean not shiny dashboard.
Yes it's possible - you can use useShinydashboard() from library(shinyWidgets)
Here is an example:
library(shiny)
library(shinyWidgets)
library(shinydashboard)
ui <- fluidPage(
useShinydashboard(),
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
box(plotOutput("distPlot"), title = "My box title", footer = "My box footer", collapsible = TRUE, status = "success")
)
)
)
server <- function(input, output) {
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')
})
}
shinyApp(ui = ui, server = 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!