In an attempt to solve this question
R Shiny: display elapsed time while function is running,
I tried several things, and I have questions about the modal dialog.
Here is a MWE
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton('run', 'Run')
),
mainPanel(
tableOutput("result")
)
)
)
server <- function(input, output) {
N <- 4
rv_time <- reactiveValues(
startTime = Sys.time(),
endTime = Sys.time()
)
output$start <- renderUI({
line1 <- paste("Start at:", format(Sys.time(), format = "%R"))
line2 <- "Be patient, it can takes some time"
HTML(paste(line1, line2, sep = "<br/>"))
})
result_val <- reactiveVal()
observeEvent(input$run,{
showModal(modalDialog(htmlOutput("start"), footer = NULL))
rv_time$startTime <- Sys.time()
result_val(NULL)
for(i in 1:N){
# Long Running Task
Sys.sleep(1)
}
result_val(quantile(rnorm(1000)))
rv_time$endTime <- Sys.time()
# removeModal()
showModal(modalDialog(textOutput("timer"), footer = modalButton("Cancel")))
})
output$result <- renderTable({
result_val()
})
output$timer <- renderText({
paste0("Executed in: ", round(difftime(rv_time$endTime, rv_time$startTime, units = "mins"),2), " minutes")
})
}
shinyApp(ui = ui, server = server)
If you click on the "Run" button the first time, you will see that the first dialog message is empty, the one will the running time works.
If you click another time then on the "Run" button, then everything works. I don't know why this happens.
I could have avoid the call of output$start, and then I would have no problem. But I'd like to understand why it doesn't work, and also, instead of displaying the starting time, I want to display a "dynamical" timer.
Once one clicks on the "Run" button, the dialog box shows the elapsed time since the beginning of the run. So I thought that I need to use an intermediate output$start (I tried to include invalideLater but failed so far). I might be wrong though.
Not related to that, I have a question about difftime. I had to use the option unit = "mins" so I can add the unit behind, because otherwise it doesn't display the unit by default. This example runs in 4 seconds, it would be better than it prints 4 secondes, instead of 0.07 minutes. Is there a way to adapt the unit? (the real code I did runs in several minutes, and possibly hours).
htmlOutput("start") is not calculated when it is hidden. If you add the line
outputOptions(output, "start", suspendWhenHidden = FALSE)
then it will be shown at the first hit on the button.
Related
I am trying to write an input page that takes the date of a section's last training, then calculates the currency of that training (how many days since), but I seem to be having a problem accessing the date from the dateInput element. I'm currently just trying to get it to print, but it is eluding me. Is there something I'm missing, or how can I get this to work? I've commented out the code to (hopefully) calculate the date gap, as I haven't had a date to work through that just yet. If you see an issue there, I'd appreciate that pointer as well.
Thank you!
library(shiny)
ui <- fluidPage(
tags$h3("Section Training"),
dateInput("section_Last_Training",
"When was your last training course?",
daysofweekdisabled = c(0, 6),
max = Sys.Date()
),
)
server <- function(input, output, session) {
section_Last_Training <- reactive({
# dateGap = as.character(difftime(Sys.time(), input$section_Last_Training, units = "days"))
print(input$section_Last_Training)
})
}
shinyApp(ui, server)
It is working, just make sure the last value in reactive is the value you want to assign to the reactive. You can do print, but do it before your gap calculation. Another thing is reactive is "lazily" evaluated. It means if there is no downstream reactivity requires it, it will not be calculated. So you need to add some events that require this reactive to make it work. See the code below.
library(shiny)
ui <- fluidPage(
tags$h3("Section Training"),
dateInput("section_Last_Training",
"When was your last training course?",
daysofweekdisabled = c(0, 6),
max = Sys.Date()
),
)
server <- function(input, output, session) {
section_Last_Training <- reactive({
print(input$section_Last_Training)
as.character(difftime(Sys.time(), input$section_Last_Training, units = "days"))
})
observe(print(section_Last_Training()))
}
shinyApp(ui, server)
I have an RShiny app using a navBarPage, something like:
default_run_date = Sys.Date()
ui <- navbarPage(
"MyTitle",
id="mainNavbarPage"
),
tabPanel(
"Panel1",
fluidPage(
dateInput("datePicker1",
"Run date:",
value = default_run_date,max = Sys.Date())
),
tabPanel(
"Panel2",
fluidPage(
dateInput("datePicker2",
"Run date:",
value = default_run_date,max = Sys.Date())
)
)
I actually have 5-6 different tabs and I want the user to be able to change a date that applies a setting across all of these tabs. For convenience I want users to have this control when accessing either of two different tabs.
I tried setting up a pair of observers:
observeEvent(input$datePicker1,{updateDateInput(session,inputId ="datePicker2",value=input$datePicker1)})
observeEvent(input$datePicker2,{updateDateInput(session,inputId ="datePicker1",value=input$datePicker2)})
However each of these events actually triggers the other, resulting in an infinite loop.
Can anyone tell me a better way to handle this?
In this case, I would not use renderUI as the complete dateInput has to be rendered on the server side. This causes delays in updating the value, already visible in this toy example. This blog post describes why using updateInput and doing the change on the client side is faster. You can apply this approach here as following:
library(shiny)
ui <- navbarPage("MyTitle", id="mainNavbarPage",
tabPanel("Panel1", dateInput("datePicker1",
"Run date:",
value = Sys.Date(),
max = Sys.Date())),
tabPanel("Panel2", dateInput("datePicker2",
"Run date:",
value = Sys.Date(),
max = Sys.Date())))
server <- function(input, output, session){
# Default starting value for date pickers
date_chosen <- reactiveVal(Sys.Date())
observeEvent(input$datePicker1, {
date_chosen(input$datePicker1)
})
observeEvent(input$datePicker2, {
date_chosen(input$datePicker2)
})
observeEvent(date_chosen(), {
updateDateInput(session,
"datePicker1",
value = date_chosen())
updateDateInput(session,
"datePicker2",
value = date_chosen())
})
}
shinyApp(ui = ui, server = server)
Store the chosen date in a reactiveVal. Then use renderUI to recreate the date pickers whenever the reactiveVal changes.
library(shiny)
ui <- navbarPage("MyTitle", id="mainNavbarPage",
tabPanel("Panel1", uiOutput("date_ui_1")),
tabPanel("Panel2", uiOutput("date_ui_2")))
server <- function(input, output, session){
# Default starting value for date pickers
date_chosen <- reactiveVal(Sys.Date())
output$date_ui_1 <- renderUI({
dateInput("datePicker1",
"Run date:",
value = date_chosen(),
max = Sys.Date())
})
output$date_ui_2 <- renderUI({
dateInput("datePicker2",
"Run date:",
value = date_chosen(),
max = Sys.Date())
})
observeEvent(input$datePicker1, {
date_chosen(input$datePicker1)
})
observeEvent(input$datePicker2, {
date_chosen(input$datePicker2)
})
}
shinyApp(ui = ui, server = server)
I have a Shiny app with numerous numericInput fields. I would like a way to format the numericInput fields with commas separating every 10^3. For example, I want 5,000,000 instead of 5000000.
I can do this in R with the format and prettyNum functions. But I don't have a way to do this in Shiny.
This would be very helpful for the UI because it would work with percents, money, etc. Does anyone have any idea how to incorporate this into the numericInput field?
Thanks!
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
mainPanel(
numericInput("formatNumber",
"Number should be formatted, e.g."5,000,000",
value = 1000),
p(format(5000000.10, big.mark=",", big.interval=3L,
digits=0, scientific=F))
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
The shinyWidgets package has a great new function (added as of version 0.5.4, also a disclaimer, I added it via a pull request), autonumericInput that will allow you to do just this. It is based on the javascript library autonumeric. There are a lot of options to the function, but the documentation is extensive and for simple uses most can be ignored.
What you are trying to do can be accomplished as follows:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
h1("Autonumeric Input Example"),
shinyWidgets::autonumericInput(
inputId = "num",
label = "Enter a large number:",
value = 1000000,
currencySymbolPlacement = "p",
decimalPlaces = 2,
digitGroupSeparator = ",",
decimalCharacter = "."
),
verbatimTextOutput("res1")
)
server <- function(input, output) {
output$res1 <- renderText(input$num)
}
shinyApp(ui = ui, server = server)
This is especially nice because it provides as-you-type formatting, so that the user can easily know how big the number is as they put it in. I know from experience that it is a real pain to try to put large numbers into the base shiny numericInput, trying to count digits in a small little box and figure out how many zeros there are. The goal of this function is to make formatting numeric inputs much easier.
Hopefully this is useful!
I could not find anything that would help with numericInput(), but here's what works with textInput() instead.
library(shiny)
if(interactive()){
shinyApp(
ui <- fluidPage(
mainPanel(
textInput("formatNumber1", "Number should be formatted, e.g.5,000,000", value = 1000),
textInput("formatNumber2", "Number should be formatted, e.g.5,000,000", value = 1000)
)
),
server <- function(input, output, session) {
observe({
updateTextInput(session, "formatNumber1", "Number should be formatted, e.g.5,000,000",
value = prettyNum(input$formatNumber1, big.mark=",", scientific=FALSE))
updateTextInput(session, "formatNumber2", "Number should be formatted, e.g.5,000,000",
value = prettyNum(input$formatNumber2, big.mark=",", scientific=FALSE))
})
}
)
}
That is the only method I found, however if you're too slow or add a digit after the commas have been added, the number is not displayed properly (e.g., 3,000 becomes 3,0,000 if you add a 0 at the end of the string). To correct that, I've changed the updateTextInput() function as below:
updateTextInput(
session,
"formatNumber1",
"Number should be formatted, e.g.5,000,000",
value = prettyNum(
gsub(",", "", input$formatNumber1),
big.mark=",", scientific=FALSE
)
)
In effect gsub() function is used to reset the input to a number every time the input is amended, otherwise the prettyNum() function is only using the digits after the comma and ignoring all digits on the left of the last comma.
If you've got multiple inputs to reformat, then create a function as follows (NB: I've also added req(input[[x]]) to avoid NA appearing when the input is blank):
updatetoprettynb <- function(x) {
req(input[[x]])
updateTextInput(
session,
x,
value = prettyNum(
gsub(",", "", input[[x]]),
big.mark = ",",
scientific = FALSE
)
)
}
You still have to use the function in a similar fashion but don't forget to use "":
observe({
updatetoprettynb("formatNumber1")
})
I have below 3 files (Retrieve_AOI_Utilization.R, ui.R, server.R)
# Retrieve_AOI_Utilization.R
library(lubridate)
library(RODBC)
myconn<- odbcConnect("pfods", uid = "testingt", pwd = "****")
systemtype <- '0043-004'
startDate <- "08/12/2014" # DD/MM/YYYY format
endDate <- "11/12/2014" # DD/MM/YYYY format
TimeDiff <- as.Date(as.character(endDate), format="%d/%m/%Y")- as.Date(as.character(startDate), format="%d/%m/%Y")
TimeDiff <-as.data.frame(TimeDiff)
nDays <- TimeDiff$TimeDiff[[1]]
conveyortime <- 25
querytest <- paste("SELECT distinct MONO, LASTUPDATE, SYSTEMTYPE, TESTTIME
FROM PFODS.PPLPRODUCTAOI
WHERE SYSTEMTYPE = '",systemtype,"'
AND LASTUPDATE >= todate('",startDate,"','DD/MM/YYYY')
AND LASTUPDATE <= todate('",endDate,"','DD/MM/YYYY')
AND TESTTIME IS NOT NULL
ORDER BY LASTUPDATE ASC, MONO" , sep="")
test <- sqlQuery(myconn, query_test)
testtime <- test$TESTTIME
HourMinSec <-strftime(testtime, format="%H:%M:%S")
TotalTimeInSec <- periodtoseconds(hms(HourMinSec)) # convert to total seconds
Utilization = (sum(TotalTimeInSec) + nrow(test)conveyor_time)/ (nDays24*3600) *100
# ui.R
shinyUI(fluidPage(
titlePanel("TestSystem Utilization for AOI Machines in SMT."),
sidebarLayout(
sidebarPanel(
helpText("Select a TestSystem and Date Range and press Submit button to retrieve its Utilization value."),
selectInput("var",
label = "Select a TestSystem",
choices = list("0043-001","0043-002","0043-003","0043-004","0043-A067-001","0043-A067- 003"),
selected = "0043-001")
),
mainPanel(
textOutput("text1")
)
)
))
# server.R
Utilization <- source('Retrieve_AOI_Utilization.R')
shinyServer(
function(input, output) {
#Utilization <- 50
specify_decimal <- function(x, k) format(round(x, k), nsmall=k)
output$text1 <- renderText({
paste("TestSystem", input$var, "has Utilization value of", specify_decimal(Utilization$value, 2),"%")
})
}
)
If I retrieve Utilization value directly from Utilization <- 50, the application runs perfectly OK in Shiny Server.
I see that in the localhost, it is working, when the Utilization value is retrieved from "Utilization <- source('Retrieve_AOI_Utilization.R')" , see printscreen below:
http://imgur.com/8h24p5h
But if I retrieve Utilization value from source('Retrieve_AOI_Utilization.R'), and deployed to the Shiny server, the application hangs with a grey screen, as seen below:
http://imgur.com/BcqwMfb
Why is this so?
Please help.
Firstly, do you have two different files: Retrieve_AOI_Utilization.R and RetrieveAOIUtilization.R? Are you using both on purpose, or are you supposed to be using one? Because you have only shown the code for the latter one.
Secondly, if you press F12 on your browser when it crashes on shiny server, and go to the "Console" tab, the line of your R code which breaks could be displayed there. You can debug from this point.
Edit
You have the following connection:
myconn<- odbcConnect("pfods", uid = "testingt", pwd = "****")
Are you certain that you can connect to the pfods ODBC connector from where you are hosting shiny-server? Be sure to have the identical ODBC, database, username and password.
I developed a Shiny App with RStudio that takes input, performs a search of a look-up table, and then returns a value. The search is not supposed to be performed until the user hits the submit button. However, upon launch, the App automatically performs and returns the first set of values from the lookup table. After this initial search, the app works exactly as expected. Is it possible to suppress this initial search (or have a default value) and perform the search ONLY when the submit button is pressed? I can't present reproducible code, but here is the structure of my input (server.R) and my user-interface (ui.R) code:
#server.R snippet
output$Word <- renderText({
predictWord <- input$gram
predict.function(predictWord) #User-defined function in global.r file
})
#ui.R snippet
tabPanel("Word Prediction",
sidebarPanel(
textInput("gram", "Enter up to three words"),
submitButton("Predict")),
mainPanel(
h4("Word Prediction"),
textOutput("predictWord")))
One way would be to substitute actionButton in place of submitButton and wrap whichever component in an if statement. Here is a simple example to display a number only slightly modified from the Shiny Widget Gallery.
require(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(
numericInput("n", "N:", min = 0, max = 100, value = 50),
br(),
actionButton("goButton", "Go!"),
p("Click the button to update the value displayed in the main panel.")
),
mainPanel(
verbatimTextOutput("nText")
)
),
server = function(input, output){
output$nText <- renderText({
# Take a dependency on input$goButton
if(input$goButton >= 1){
# Use isolate() to avoid dependency on input$n
isolate(input$n)
}
})
}
)
)