I have a text input box that uses Sys.time() as its value, however as normal time passes it stays static, I've been trying to refresh the time to display a new value, but insofar the only way I've been able to update the time is via restarting the app.
I've tried using textoutput() and the invalidate later() function, however this only displays the current time that "ticks" so to speak but still requires user input, which is redundant since the whole point is to have them not enter the time. This input and a few others eventually gets uploaded into a google sheet via the googlesheets package.
this is my current code:
Stime <- as.character(format(Sys.time(), "%H:%M", "EST"))
textInput(
inputId = "Time",
label = "Today's Time",
value = Stime)
what it looks like now (via imgur) except it is static
The only thing I'm trying to do is literally increment the time! Any help appreciated!
From the R Shiny website:
http://shiny.rstudio.com/gallery/current-time.html
options(digits.secs = 3) # Include milliseconds in time display
function(input, output, session) {
output$currentTime <- renderText({
# invalidateLater causes this output to automatically
# become invalidated when input$interval milliseconds
# have elapsed
invalidateLater(as.integer(input$interval), session)
format(Sys.time())
})
}
I have amended the shiny example slightly from http://shiny.rstudio.com/gallery/current-time.html to help display time within a textInput box, as requested:
library(shiny)
ui <- shiny::fluidPage(shiny::uiOutput("ui"))
server <- function(input, output, session) {
output$ui <- shiny::renderUI({
invalidateLater(1000, session)
shiny::textInput(
inputId = "time",
label = "Today's Time",
value = as.character(format(Sys.time(), "%H:%M", "EST"))
)
})
}
shiny::shinyApp(ui = ui, server = server)
Related
I want to take a user's input and store it as a variable that will be used in a plotting function. My code:
ui <- fluidPage(
mainPanel(
plotlyOutput("plot", width = '100%'),
br(),
textAreaInput("list", "Input List", ""),
actionButton("submit", "Submit", icon = icon("refresh"), style="float:right")
))
server <- function(input, output, session) {
my_text <<- renderText({
req(input$submit)
return(isolate(input$list))
my_text ->> subv
})
bindEvent(my_text,
output$plot <- renderPlotly({
#my very long plot code goes here which takes subv as input. This part has been tested outside of shiny and I know works.
}
I am trying to store the text in the subv variable as it will dictate what the renderPlotly will generate. When I hit submit nothing happens and the variable is only created after the session ends. The newly created subv variable in my environment does not show the text that was inputted but lists subv as an empty function i.e. subv function(...)
Below you can find a working prototype of what you would like to achieve with some information on what the issues were
First, we need to have a textOutput where our text will be shown. I understand this may not be necessary for the actual use case but it is important for this answer's demonstration purposes.
Next, we should not need to set variables to global via <<- or ->>. This is generally not good practice. Instead, we should store our result in a reactive. See also reactiveVals (but this is harder to follow when the app gets complex).
Since we need to only get the value when we click submit, we should use an event bind to only run when we click submit. This is essentially similar to eventReactive.
Finally, we can use bindCache to cache our result on the input list.
ui <- fluidPage(
mainPanel(
plotlyOutput("plot", width = '100%'),
br(),
textAreaInput("list", "Input List", ""),
actionButton("submit", "Submit", icon = icon("refresh"),
style="float:right"),
textOutput("hello_out")
))
server <- function(input, output, session) {
my_text <- reactive({
input$list
}) %>%
shiny::bindCache(input$list
) %>%
shiny::bindEvent(input$submit)
output$hello_out <- renderText({
my_text()
})
}
shinyApp(ui, server)
I am trying to create a date input that automatically updates the inputted value to the end of the selected month. The problem I was having was when I ran this first bit of code (below) was that if the user tries to manually change the date by typing in a date, they are unable to because the input is updated instantly to the end of the month before the user can finish typing.
library(shinydashboard)
library(lubridate)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
dateInput(
inputId = "date",
label = "End of Month Date",
value = ceiling_date(x = Sys.Date() + 365, unit = "month") - 1,
startview = "year"
)
)
)
server <- function(input, output, session) {
observe({
if(is.Date(input$date) & length(input$date) > 0){
if(input$date != ceiling_date(input$date, unit = "month") - 1) {
updateDateInput(
session,
inputId = "date",
value = ceiling_date(x = input$date, unit = "month") - 1
)
}
}
})
}
shinyApp(ui, server)
So, I tried implementing debounce (as shown below - server code change only) so that it would delay the input from updating until the user was finished typing; however, I am running into an issue. The timer does not reset on each key stroke as I understand it should. Instead, the timer operates as if I were using the throttle function and starts when the input is first changed and doesn't reset when the input changes.
server <- function(input, output, session) {
observe({
dateinputdelay <- debounce(r = reactive(input$date), millis = 2000)
if(is.Date(dateinputdelay()) & length(dateinputdelay()) > 0){
if(dateinputdelay() != ceiling_date(dateinputdelay(), unit = "month") - 1) {
updateDateInput(
session,
inputId = "date",
value = ceiling_date(x = input$date, unit = "month") - 1
)
}
}
})
}
Edit: the best I can get is with the code below, but because the "fancy date input thingy" has its own internal updating mechanism separate from shiny's reactive concept, this debouncing is only addressing one source of problem.
The first trick is that the debounce needs to happen before the block of code is even started. That is, it "de-bounces" the start of the dependent code blocks; once they are started, it does not help.
The second is knowing that observe blocks attempt to run their code eagerly (see shiny docs and read "Details"), whereas reactive blocks are relatively lazy -- they only run dependent code as needed. It's the "eager" part that may be hurting.
Additionally, you use side-effect in the observe block to update the input field, but you never store the value elsewhere. I suggest that it might be better to calculate the new value in one place (in a functional manner, like a reactive block that should not operate in side-effect) and then use that later.
server <- function(input, output, session) {
dateinputdelay <- debounce(reactive(input$date), 2000)
end_of_month <- reactive({
# print("react!")
x <- dateinputdelay()
if (is.Date(x) & length(x) > 0) {
if (x != ceiling_date(x, unit = "month") - 1) {
x <- ceiling_date(x = input$date, unit = "month") - 1
}
}
x
})
observe({
# print("observe!")
updateDateInput(
session,
inputId = "date",
value = end_of_month()
)
})
}
(I've kept a couple of print statements in there, not because they help much here, but because they can be a good tool to see when/how-frequently reactitivity is causing code-blocks to run.)
As I said up top, I suspect this behavior is indicative of something within dateInput, not within the subsequent reactive or observe blocks.
I would like to create a dashboard in shiny. The purpose of the dashboard is to show KPI for several mobile app in several platforms. I would like to create a template and just give filtered data to this template and observe my KPI for this app on this platform.
The data are on sql, so instead of maintaining a connection between shiny and the sql server, I prefer to create a function that extract the data once on the time range selected by the user and collect it. I want this function to extract again only if date range change and the user validate by clicking on an action button.
This a very simple toy example to illustrate my goal
ui = dashboardPage(
dashboardHeader(),
dashboardSidebar(sidebarMenu( dateRangeInput("daterange", "Date Range"), actionButton("do", "Do it !", width="100%"))),
dashboardBody(fluidPage(plotlyOutput("plot")))
)
data = function(start, end)
{
return(data.frame(x = c(start, end), y = runif(2)))
}
outputTemplate = function(input, output, data, instanceName)
{
output[[instanceName]] = renderPlotly({
plot_ly(data = data) %>% add_bars(x~x, y~y)
})
}
server = function(input, output){
dt = eventReactive(input$do,{
return(data(input$daterange[1], input$daterange[2]))
})
outputTemplate(input, output, dt(), "plot")
}
shinyApp(ui, server)
So, when I click the "Do it !" button, I load data base on the dateRange input, and then use this Data in one Template.
The first time I click on the button, the plot appear but then when I change the date and click again the plot is never updated.
What I have missed about reactive in shiny ?
EDIT 1 :
If I replace by
output[["plot"]] = renderPlot({
plot(dt()$x, dt()$y, type = "b")
})
instead of the outputTemplate function it works perfectly
I found the problem but I don't understand why.
If you do not put the parenthesis on dt it works.
The solution is
outputTemplate(input, output, dt, "plot")
outputTemplate = function(input, output, data, instanceName)
{
output[[instanceName]] = renderPlotly({
plot_ly(data = data()) %>% add_bars(x~x, y~y)
})
}
I have a shiny application with many tabs and many widgets on each tab. It is a data-driven application so the data is tied to every tab.
I can save the application using image.save() and create a .RData file for later use.
The issue I am having how can I get the state restored for the widgets?
If the user has checked boxes, selected radio buttons and specified base line values in list boxes can I set those within a load() step?
I have found libraries such as shinyURL and shinystore but is there a direct way to set the environment back to when the write.image was done?
I am not sure where to even start so I can't post code.
edit: this is a cross-post from the Shiny Google Group where other solutions have been suggested
This is a bit hacky, but it works. It uses an "internal" function (session$sendInputMessage) which is not meant to be called explicitly, so there is no guarantee this will always work.
You want to save all the values of the input object. I'm getting all the widgets using reactiveValuesToList(input) (note that this will also save the state of buttons, which doesn't entirely make sense). An alternative approach would be to enumerate exactly which widgets to save, but that solution would be less generic and you'd have to update it every time you add/remove an input. In the code below I simply save the values to a list called values, you can save that to file however you'd like (RDS/text file/whatever). Then the load button looks at that list and updates every input based on the value in the list.
There is a similar idea in this thread
library(shiny)
shinyApp(
ui = fluidPage(
textInput("text", "text", ""),
selectInput("select", "select", 1:5),
uiOutput("ui"),
actionButton("save", "Save"),
actionButton("load", "Load")
),
server = function(input, output, session) {
output$ui <- renderUI({
tagList(
numericInput("num", "num", 7),
checkboxGroupInput("chk", "chk", 1:5, c(2,4))
)
})
observeEvent(input$save, {
values <<- lapply(reactiveValuesToList(input), unclass)
})
observeEvent(input$load, {
if (exists("values")) {
lapply(names(values),
function(x) session$sendInputMessage(x, list(value = values[[x]]))
)
}
})
}
)
Now with bookmarking is possible to save the state of your shinyapp. You have to put the bookmarkButton on your app and also the enableBookmarking.
The above example may not work if shiny UI involves date. Here is a minor change for date handling.
library(shiny)
shinyApp(
ui = fluidPage(
dateInput("date", "date", "2012-01-01"),
selectInput("select", "select", 1:5),
uiOutput("ui"),
actionButton("save", "Save"),
actionButton("load", "Load")
),
server = function(input, output, session) {
output$ui <- renderUI({
tagList(
numericInput("num", "num", 7),
checkboxGroupInput("chk", "chk", 1:5, c(2,4))
)
})
observeEvent(input$save, {
values <<- lapply(reactiveValuesToList(input), unclass)
})
observeEvent(input$load, {
if (exists("values")) {
lapply(names(values),
function(x) session$sendInputMessage(x, list(value = values[[x]]))
)
temp=as.character(as.Date(values$date, origin = "1970-01-01"))
updateDateInput(session, inputId="date", label ="date", value = temp)
}
})
}
)
I am constructing an animated graph project using R Studio's Shiny. Currently the "Go !" button initiates the animation. I would like to have the "Reset" button re-initialize the variables and re-run the animation, but since Shiny does not allow within-code changes to the input$button values, I am stuck on how to do this. The real project is similar in form to the sample blocks below, but much more involved. Animation is integral to the information being conveyed. When the project is completed, I intend to deploy it on the Shiny server, so I would like users to be able to re-run the animation with different selections without having to re-open the link.
# ui.R
library(shiny)
shinyUI(fluidPage(
# Application title
headerPanel("Cost Explorer"),
sidebarPanel(
actionButton("goButton", "Go!"),
actionButton("reset", "Reset"),
sliderInput("myvar", label=h6("Variability of cost"),
min=0, max=50, value=10)
),
mainPanel(
plotOutput(outputId="tsplot")
)
))
# server.R
library(shiny)
shinyServer(function(input, output, session) {
# initialize reactive values
ts <- reactiveValues(cost=rep(NA,100), year=(2010:2109), counter=1)
output$tsplot <- renderPlot({
plot(ts$year, ts$cost, xlim=c(2010,2110), ylim=c(-200,200), xlab="Year",
ylab="Cost (US Dollars)", type="l", main="Forecasted Cost Time series")
})
observe({
isolate({
if (ts$counter==1){
ts$cost[ts$counter]=50 #initial cost
}
if (ts$counter > 1){
ts$cost[ts$counter]=ts$cost[ts$counter-1]+rnorm(1,0,input$myvar)
}
ts$counter=ts$counter+1
})
if (((isolate(ts$counter) < 100)) & (input$goButton > 0)){
invalidateLater(200, session)
}
if (input$reset > 0){
# How do I add reset functionality?
}
})
})
Based on your app it was quicker to add another observe and reset the counter to 1 using the global assignment operator <<-. Also I changed the plot so it is plots indexed variables. Have a look at similar problem people had, here. NB: In some of my apps I also have the pause button when a user presses the start button twice, you can achieve this by checking if the button index is divisible by two or not since every time the button is clicked it increments by one.
I was further looking into your app, make sure you are garbage collecting unreferenced observers, as you might run out of memory (look at the memory profile via Task manager). Look into this example here, alternately you can set-up a log-off functionality per session where the client will be logged off after n amount of minutes.
rm(list = ls())
library(shiny)
ui <- (fluidPage(
# Application title
headerPanel("Cost Explorer"),
sidebarPanel(
actionButton("goButton", "Go!"),
actionButton("reset", "Reset"),
sliderInput("myvar", label=h6("Variability of cost"),min=0, max=50, value=10)
),
mainPanel(plotOutput(outputId="tsplot"))
))
server <- (function(input, output, session) {
# initialize reactive values
ts <- reactiveValues(cost=rep(NA,100), year=(2010:2109), counter=1)
output$tsplot <- renderPlot({
plot(ts$year[1:ts$counter], ts$cost[1:ts$counter], xlim=c(2010,2110), ylim=c(-200,200), xlab="Year",
ylab="Cost (US Dollars)", type="l", main="Forecasted Cost Time series")
})
observe({
isolate({
if (ts$counter==1){
ts$cost[ts$counter]=50 #initial cost
}
if (ts$counter > 1){
ts$cost[ts$counter]=ts$cost[ts$counter-1]+rnorm(1,0,input$myvar)
}
ts$counter=ts$counter+1
})
if (((isolate(ts$counter) < 100)) & (input$goButton > 0)){
invalidateLater(200, session)
}
})
observe({
if (input$reset > 0){
ts$counter <<- 1
}
})
})
runApp(list(ui = ui, server = server))