I need to refresh data displayed in an infobox on a regular interval, but every time it updates it renders a new infobox making for an undesirable user experience.
I've tried using futures/promises for async processing but the renderinfobox still renders a new box on data update. Here's my code :
invalidateLater(30000)
results <-future({testFuture()})
return(value(results))
I would like to be able to update the underlying data of the infobox without dimming the ui element for the entire duration of the query.
Instead of re-rendering the infobox everytime the value changes, you can re-render just the title or the value of the infobox as I have shown by creating an output element. I have created an working example that refreshes the infobox to show current time at seconds level.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Test App"),
dashboardSidebar(),
dashboardBody(
infoBox("TestBox", value = textOutput("currentTime"), subtitle = NULL,
icon = shiny::icon("bar-chart"), color = "aqua", width = 4,
href = NULL, fill = FALSE)
)
)
server <- function(input, output, session) {
output$currentTime <- renderText({
invalidateLater(1000, session)
paste(Sys.time())
})
}
shinyApp(ui = ui, server = server)
Do try out your code with this and let me know if this helps!
Related
I am trying to make an Shiny app which takes input from user in textInput. I want text inside the textbox to be clear when it is clicked on. I could find solutions only for clicked on button. I need a mouse event for clicking on text box.
Do you have any idea about it?
This can be achieved through the shinyjs onclick function like so:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
textInput(inputId = "text_input", label = "Example Text Input", value = "Click me to clear")
)
)
server <- function(input, output) {
shinyjs::onclick(id = "text_input", expr = updateTextInput(inputId = "text_input", value = ""))
}
# Run the application
shinyApp(ui = ui, server = server)
I have been trying to make a login for a single tabPanel in Shiny. I have used the shinyAlert method, (as described here: How to access Shiny tab ids for use with shinyalerts?) which works, but unfortunately, it shows parts of the tabPanel's content before the user is logged in.
Is there a way to change this? I am trying to figure out how to make the "backdrop" of the shinyAlert just a white page until the user is successfully logged in. I read that this might be possible with CSS, but it is unclear to me how.
Or is there another method to do this, that I haven't considered? I am pretty new to Shiny.
Edit: the relevant parts of the code.
ui <- fluidPage(navbarPage("Eksempel", theme = shinytheme("cerulean"),
tabPanel("Home", icon = icon("home"),
fluidRow(
box(
Title = "Welcome to the example layout",
width = 10,
solidHeader = TRUE,
"Welcome text")
)),
tabPanel("Prototype", icon = ("chart-line"),
fluidPage(tagList(
textInput("user", "User:"),
passwordInput("password", "Password:"),
uiOutput("secrets"))),
# other tabPanels
server <- function(input, output, session){
output$secrets <- renderUI({
req(input$user == "admin", input$password == "shiny")
fluidPage( #contents of tabPanel, containing different plots ect.
)
})
The contents of the fluidPage I am trying to hide works fine when I don't try to hide it.
You can use req in combination with a renderUI and uiOutput to hide stuff until someone authenticates.
library(shiny)
ui <- fluidPage(
tagList(
textInput("user", "User:"),
passwordInput("password", "Password:"),
uiOutput("secrets")
)
)
server <- function(input, output) {
output$secrets <- renderUI({
req(input$user == "admin", input$password == "stackoverflow")
wellPanel("Hello admin! These are the secrets!")
})
}
shinyApp(ui = ui, server = server)
If you want a more enterprise-ready approach, you can try ShinyProxy or Shiny-Server Pro.
I am building a dashboard page where the user uploads a file and on clicking the actionbutton it should run the server code and show the output and also allow to download the output as file. Below is the code that shows the basic UI.
I would need help with the server function to render the output from the command in server function to the "Table" output in the NavBar page where first 5 rows could be shown in the UI and download the complete output file on clicking the "Download List" button. I am novice with rshiny. Any help would be helpful.
library(shiny)
library(shinydashboard)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Documentation", tabName = "documentation",selected=FALSE),
menuItem("Dataset", tabName = "dataset", badgeColor = "green"),
menuItem("Result", tabName = "results", badgeColor = "green")
))
body <- dashboardBody(
tabItems(
tabItem(tabName = "documentation",h3("Tool Documentation")),
tabItem(tabName = "dataset",menuItem(icon = NULL, fileInput("PE", "Upload input file:")),
menuSubItem(icon = icon("refresh"),actionButton("Start","Analyze"))),
tabItem(tabName = "results",navbarPage(tabPanel("summary","Summary",icon = icon("list-alt")),
tabPanel("Table",tableOutput("table"),icon = icon("table")),
downloadButton("downList", "Download List")))))
# Put them together into a dashboardPage
ui <- dashboardPage(dashboardHeader(title = "FanDB"),
sidebar,
body)
# Define server logic
server <- function(input, output, session) {
##run this command on input$PE file on the click of actionButton
output$Table <- renderTable({
input$Start
req(input$PE)
a<-read.delim(input$PE,sep="\t",header=T)
b<-a[a[,6]==2,1]
{
return(b)
}
#Show the results from the actionButton in the Table panel in the navbar page and download the results using downloadButton
})
}
shinyApp(ui, server)
Or displaying the "results" menu (navbarPage) which is currently in the sidebarMenu to the dashboardBody on the completion of actionButton would be ideal.
There's a typo: output$Table should be output$table to refer to the table, not the tab holding it. Also, to load a file from fileInput, you need to access input$PE$datapath
The way I'd structure this is to use an eventReactive, which is triggered by the actionButton, to load the data and make it available as a reactive expression which is used by renderTable
server <- function(input, output, session) {
# When button is pressed, load data and make available as reactive expression
table_content <- eventReactive(input$Start, {
req(input$PE$datapath)
a <- read.delim(input$PE$datapath,sep="\t",header=T)
b <- a[a[,6]==2,1]
return(b)
})
# Render data as table
# Since table_content is reactive, the table will update when table_content changes
output$table <- renderTable({
table_content()
})
}
To download the table, you can just set up a downloadHandler function with this same table_content() expression as the content. There are a bunch of other questions on downloadHandler, so I won't go into detail on that.
If you want the input$Start button to change to the results tab when clicked, you need to do 2 things:
First, add an id to your sidebarMenu:
sidebar <- dashboardSidebar(
sidebarMenu(id = 'tabs',
...
Second, set up updateTabItems to change the selected tab to results. Since you're using shinydashboard, you want to use shinydashboard::updateTabItems, not shiny:: updateTabsetPanel as in this question. Since you want to change tabs when the table content is loaded, I'd make the table_content() reactive the trigger by adding this:
observeEvent(table_content(),{
updateTabItems(session, "tabs", 'results')
})
Now, when table_content() is changed, the tab will be switched to results. If something goes wrong in your eventReactive and the file cannot be read or processed properly, then the tab won't switch.
textInput(paste0("inp1-", wid),label = NULL,value = record$Current_week)
This is the code I used to create the text input boxes dynamically, the id for the text input box depends on the wid(which is a number).
I tried using following CSS format to change the background color, but it didn't work.
tags$head(tags$style(HTML('#',paste0("inp1-", wid),'{background-color:#f1c232;}')))
Please help me in solving this problem.
See here for an example where the input is not created dynamically. In your case, you could do as follows:
library(shiny)
wid=2
ui <- fluidPage(
uiOutput("my_ui")
)
server <- function(input, output) {
output$my_ui <- renderUI({
tagList(
textInput(paste0("inp1-", wid),label = NULL,value = 0),
tags$style(paste0("#inp1-", wid,"{background-color:#ff0000;}"))
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Hope this helps!
I used bsModal successfully in my code before. However, I can't seem to get a modal pop up to show just when the user visits an app's first page by default. I thought something like this would work, but not. Any idea how I can trigger a bsModal on page visit?
library(shiny)
library(shinyBS)
ui <- fluidPage(
mainPanel(
bsModal(id = 'startupModal', title = 'Dum Dum', trigger = '',
size = 'large', p("here is my mumbo jumbo")),
width = 12
)
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
I simply need to alert the user with a message when they visit the app and then allow them to close the modal pop up and navigate the rest of the app freely. I am using Shinydashboard. So, eventually, this has to work with that.
You can use toggleModal to manually trigger the popup from the server.
library(shiny)
library(shinyBS)
ui <- fluidPage(
mainPanel(
bsModal(id = 'startupModal', title = 'Dum Dum', trigger = '',
size = 'large', p("here is my mumbo jumbo")),
width = 12
)
)
server <- function(input, output, session) {
toggleModal(session, "startupModal", toggle = "open")
}
shinyApp(ui = ui, server = server)
Here is a solution using JS to trigger bsModal when page load "onload" from ui without waiting for the server. Along with a solution proposed here to prevent end users from accidentally closing the modal by clicking outside the modal or press Esc
library(shiny)
library(shinyBS)
bsModalNoClose <-function(...) {
b = bsModal(...)
b[[2]]$`data-backdrop` = "static"
b[[2]]$`data-keyboard` = "false"
return(b)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
bsModalNoClose("window", "Window",
title="Enter Login Details",size='small',
textInput('username', 'Username'),
passwordInput('pwInp', 'Password'),
actionButton('butLogin', 'Login', class = 'btn action-button btn-success', icon = icon('sign-in')),
footer = h4(actionLink('create_account','Create an account'),align='right'),
tags$head(tags$style("#window .modal-footer{display:none}
.modal-header .close{display:none}"),
tags$script("$(document).ready(function(){
$('#window').modal();
});")
))
)
,mainPanel()
))
server <- function(input, output, session) {}
shinyApp(ui, server)
I hope it may be helpful for future readers.