I would like to add a progress bar to my script in R, but I'm not sure where to put this in my loop. The code for the winProgressbar is below from the internet. Where should I place this code in my loop?
Thanks!
pb <- winProgressBar(title = "progress bar", min = 0,
max = total, width = 300)
for(i in 1:total){
Sys.sleep(0.1)
setWinProgressBar(pb, i, title=paste( round(i/total*100, 0),
"% done"))
}
close(pb)
To track the progress of an entire script or program, you just need to place the initializing function (winProgressBar) at the beginning of the code and do updates via setWinProgressBar at key points within the flow of your program. For example, if the first task your code performs usually takes about 10% of the total time required, set the value to 10% after that task completes.
Your code may look something like the following:
your_function <- function(arg1, arg2, arg3) {
#add random stuff here like loading packages
#create your progress bar
pb <- winProgressBar(title = "progress bar", min = 0, max = 100, width = 300)
#insert part 1 of your code, let's say it takes 10% of your total processing time
setWinProgressBar(pb, 10, label = paste(round(10/total*100, 0),"% done"))
#insert part 2 of your code, let's say it takes 25% of your total processing time
setWinProgressBar(pb, 35, label = paste(round(35/total*100, 0),"% done"))
etc...
close(pb)
}
You can also place it on the outside of your function similar to the example you provided.
Related
I am asking to write a text or graphical progress tracker while rforcecom's batch update function loads batches of up to 10,000.
To set up and complete a batch update, a few objects must be created--there is no avoiding it. I really do not like having to re-run code in order to check the status of rforcecom.checkBatchStatus(). This needs to be automated while a progress bar gives a visual of actual progress, since checking in the global environment isn't preferred and it will be a static "status" update until it's run again.
Here's how the code is set up:
require(Rforcecom)
## Login to Salesforce using your username and password token
## Once ready to update records, use the following:
job<- rforcecom.createBulkJob(session, operation = 'update',
object = 'custom_object__c')
info<- rforcecom.createBulkBatch(session, jobId = job$id, data = entry,
batchSize = 10000)
### Re-run this line if status(in global environment) is "In Progress" for
### updated status
status<- lapply(info, FUN = function(x) {
rforcecom.checkBatchStatus(session, jobId = x$jobId, batchId = x$id)})
###Once complete, check details
details<- lapply(status, FUN = function(x){
rforcecom.getBatchDetails(session, jobId = x$jobId, batchId = x$id)})
close<- rforcecom.closeBulkJob(session, jobId = job$id)
To automate re-running the status code, use the repeat loop:
repeat {
statements...
if (condition) {
break
}
}
Then, to get a visual for a progress update, use the txtProgressBar() in base R. For this particular function, I made my own progress bar function with two simple companion functions. As a note about progressValue(), the rforcecom.checkBatchStatus() outputs as a list of 1 and a sublist. The sublist name for checking the number of records processed is "numberRecordsProcessed".
progressBar<- function(x, start = 0, finish){
# x is your object that is performing a function over a varying time length
# finish is your number of rows of data your function is processing
pb <- txtProgressBar(min = start, max = finish, style = 3)
for (i in 1:finish){
i<- progressValue(x)
setTxtProgressBar(pb, i)
if (progressValue(x)/finish == 1) {
close(pb)
}
}
}
finish<- function(x){
return(as.numeric(nrow(x)))
}
progressValue<- function(x){
x=x[[1]][["numberRecordsProcessed"]]
return(as.numeric(x))
}
Now, bring it all together! Repeat loops can be trained to end as long as you know your conditions: "Completed" or "Failed". Repeat "status", which will update the number of records processed, and by doing so this will update your progress bar. When the number of records processed equals the number of rows in your data, the progress bar will quit and so will your repeat loop.
repeat {
status<- lapply(info, FUN = function(x){
rforcecom.checkBatchStatus(session, jobId = x$jobId, batchId = x$id)})
progressBar(status, finish = finish(entry))
if (status[[1]][["state"]]=="Completed") {
break
}
if (status[[1]][["state"]]=="Failed") {
break
}
}
In my code I plot a function and then raise a dialog to ask the user about it. The issue is that the dialog is raised before the plot is updated, so the user sees whatever was last in the plot window (I'm using R-studio). How can I solve this?
Example:
for(i in (1:3)) {
x = (1:100); #not the real vectors...just an example
f = (601:700);
plot(x,f)
ans = winDialog(type = c("yesno"), "is it any good?")
}
Searching for "R flush plot" led me to this solution. At least on my system I had to replace Sys.sleep(0) by Sys.sleep(1). But then it works.
for(i in (1:3)) {
x = (1:100); #not the real vectors...just an example
f = x^i
plot(x,f)
Sys.sleep(1)
ans = winDialog(type = c("yesno"), "is it any good?")
}
I need to process a long list of images using a loop. It takes a considerable time to run everything, and therefore I would like to keep track of the progress.
This is my loop:
files.list <- c("LC82210802013322LGN00_B1.TIF", "LC82210802013322LGN00_B10.TIF",
"LC82210802013322LGN00_B11.TIF", "LC82210802013322LGN00_B2.TIF",
"LC82210802013322LGN00_B3.TIF", "LC82210802013322LGN00_B4.TIF",
"LC82210802013322LGN00_B5.TIF", "LC82210802013322LGN00_B6.TIF",
"LC82210802013322LGN00_B7.TIF", "LC82210802013322LGN00_B8.TIF",
"LC82210802013322LGN00_B9.TIF", "LC82210802013322LGN00_BQA.TIF",
"LC82210802013354LGN00_B1.TIF", "LC82210802013354LGN00_B10.TIF",
"LC82210802013354LGN00_B11.TIF", "LC82210802013354LGN00_B2.TIF",
"LC82210802013354LGN00_B3.TIF", "LC82210802013354LGN00_B4.TIF",
"LC82210802013354LGN00_B5.TIF", "LC82210802013354LGN00_B6.TIF",
"LC82210802013354LGN00_B7.TIF", "LC82210802013354LGN00_B8.TIF",
"LC82210802013354LGN00_B9.TIF", "LC82210802013354LGN00_BQA.TIF",
"LC82210802014021LGN00_B1.TIF", "LC82210802014021LGN00_B10.TIF",
"LC82210802014021LGN00_B11.TIF", "LC82210802014021LGN00_B2.TIF",
"LC82210802014021LGN00_B3.TIF", "LC82210802014021LGN00_B4.TIF",
"LC82210802014021LGN00_B5.TIF", "LC82210802014021LGN00_B6.TIF",
"LC82210802014021LGN00_B7.TIF", "LC82210802014021LGN00_B8.TIF",
"LC82210802014021LGN00_B9.TIF", "LC82210802014021LGN00_BQA.TIF",
"LC82210802014037LGN00_B1.TIF", "LC82210802014037LGN00_B10.TIF",
"LC82210802014037LGN00_B11.TIF", "LC82210802014037LGN00_B2.TIF",
"LC82210802014037LGN00_B3.TIF", "LC82210802014037LGN00_B4.TIF",
"LC82210802014037LGN00_B5.TIF", "LC82210802014037LGN00_B6.TIF",
"LC82210802014037LGN00_B7.TIF", "LC82210802014037LGN00_B8.TIF",
"LC82210802014037LGN00_B9.TIF", "LC82210802014037LGN00_BQA.TIF",
"LC82210802014085LGN00_B1.TIF", "LC82210802014085LGN00_B10.TIF",
"LC82210802014085LGN00_B11.TIF", "LC82210802014085LGN00_B2.TIF",
"LC82210802014085LGN00_B3.TIF", "LC82210802014085LGN00_B4.TIF",
"LC82210802014085LGN00_B5.TIF", "LC82210802014085LGN00_B6.TIF",
"LC82210802014085LGN00_B7.TIF", "LC82210802014085LGN00_B8.TIF",
"LC82210802014085LGN00_B9.TIF", "LC82210802014085LGN00_BQA.TIF"
)
for (x in files.list) { #loop over files
# Tell about progress
cat('Processing image', x, 'of', length(files.list),'\n')
}
Of course, instead of showing the name of the file, I would like to show the index of the current file in the context of the length of the entire list.
I really need the names of the files within the loop, because I need to load and save a new version of each one of them.
Any ideas? Thanks in advance.
for (x in 1:length(files.list)) { #loop over files
# doing something on x-th file => files.list[x]
# Tell about progress
cat('Processing image', x, 'of', length(reproj),'\n')
}
for (i in 1:length(files.list)) {
x <- files.list[i]
# do stuff with x
message('Processing image ', i, ' of ', length(files.list))
}
You can use system window progress bar as under:
# put this before start of loop
total = length of your loop
# put this before closing braces of loop
pb <- winProgressBar(title = "progress bar", min = 0, max =total , width = 300)
Sys.sleep(0.1)
# Here i is loop itrator
setWinProgressBar(pb, i, title=paste( round(i/total*100, 0),"% done"))
# put this after closing braces of loop
close(pb)
I am making animation using animationOptions in sliderInput(). I want to use date/daterange in a slider, but sliderInput() does not accept date. There was a post in the shiny group. As of March, 2013, there was no solution yet. So I searched around and learned that one can achieve this using JavaScript. Here is the post. Unfortunately, I cannot write in JS. So, I searched around more and came up with this link and wrote the following codes. This works, but the numbers on the slider are confusing. Is this the only way one can move around and use date in sliderInput()? Thank you very much for taking your time.
server.R
library(shiny)
shinyServer(function(input, output, session) {
observe({
updateDateInput(session, "ana", value = as.Date("2014-07-01") + input$foo)
})
output$preImage <- renderImage({
filename <- normalizePath(file.path('./www',
paste(input$ana, '.png', sep='')))
list(src = filename,
alt = paste("There is no image for ", input$ana, ".", sep = ""))
}, deleteFile = FALSE)
})
ui.R
shinyUI(pageWithSidebar(
headerPanel("renderImage example"),
sidebarPanel(
sliderInput("foo", "Animation duration", min = -30,
max = 30, value = 0, step = 1,
animate = animationOptions(loop = TRUE, interval = 1000)),
dateInput("ana", "Choose a date:", value = as.Date("2014-07-01"))
),
mainPanel(
# Use imageOutput to place the image on the page
imageOutput("preImage")
)
))
I don't know when this feature was added, but now date values are automatically recognized in sliderInput(). And some related parameters are timeFormat and step (1-day by default)
sliderInput("date_range",
"Choose Date Range:",
min = as.Date("2016-02-01"), max = Sys.Date(),
value = c(as.Date("2016-02-25"), Sys.Date())
)
Reference: http://shiny.rstudio.com/reference/shiny/latest/sliderInput.html
The sliderInput control offers some limited formatting options. You can add a format parameter to your sliderInput to change the displayed text for the slider.
Ideally, you would want the sliderInput to offer a custom mapping function that maps the current value to an exact date. But since that is not the option, the only wiggle room for improvement is to slightly change the text a little bit with the format parameter.
Accepted format can be found in this document.
Based on the above document, probably you can change your sliderInput into:
sliderInput("foo", "Animation duration", min = -30,
max = 30, value = 0, step = 1,
format="## Days",
animate = animationOptions(loop = TRUE, interval = 1000)),
This will display as +10 Days, when originally it was "+10".
It may not be what you want exactly, but this is what you can do without writing Javascript.
EDIT: show customized slider value using Javascript
Say if you really want to change the current value label for the slider to indicate a somewhat sophisticated value (date, transformed values etc.), you can write some small Javascript snippet to do that.
One example provided by the jslider control (which is what Shiny uses for your sliderInput) indicates that by calling the constructor of a slider with a calculate function, you can manually change the mapping from the current value (numeric) to a custom string (in this case, a date).
Without being too verbose, let's just say that the slider's Javascript object is called slider. Which you can always get by calling:
$(select).slider()
where select is a jQuery selector. Again, in this case it is #foo because the slider has an id foo set in ui.R.
When initiated, the slider.settings.calculate function appeared in the example will be bound to be the slider.nice function. So, we can simply override the nice function to achieve our goal.
Below is a modified ui.R with a piece of Javascript to do exactly the nice function overriding.
ui.R
shinyUI(pageWithSidebar(
headerPanel("renderImage example"),
sidebarPanel(
sliderInput("foo", "Animation duration", min = -30,
max = 30, value = 0, step = 1,
animate = animationOptions(loop = TRUE, interval = 1000)),
dateInput("ana", "Choose a date:", value = as.Date("2014-07-01"))
),
mainPanel(
singleton(tags$head(HTML(
'
<script type="text/javascript">
$(document).ready(function() {
var slider = $("#foo").slider();
// override the default "nice" function.
slider.nice = function(value) {
var ref_date = new Date("2014-07-01");
// each slider step is 1 day, translating to 24 * 3600 * 1000 milliseconds
var slider_date = new Date(ref_date.getTime() + value * 24 * 3600 * 1000);
return [slider_date.getUTCFullYear(),
slider_date.getUTCMonth() + 1,
slider_date.getUTCDate()].join("-");
}
})
</script>
'))),
# Use imageOutput to place the image on the page
imageOutput("preImage")
)
))
Another detail we might want to tweak is the label on both ends of the slider. To achieve this we could:
replace the entire slider.domNode by calling slider.generateScales();
directly modify the two <span>'s with class jslider-label.
For example if we take approach 2, we can modify the HTML() part of ui.R as:
singleton(tags$head(HTML(
'
<script type="text/javascript">
$(document).ready(function() {
var slider = $("#foo").slider();
// override the default "nice" function.
var labels = slider.domNode.find(".jslider-label span");
labels.eq(0).text("2014-06-01");
labels.eq(1).text("2014-07-31");
slider.nice = function(value) {
var ref_date = new Date("2014-07-01");
// each slider step is 1 day, translating to 24 * 3600 * 1000 milliseconds
var slider_date = new Date(ref_date.getTime() + value * 24 * 3600 * 1000);
return [slider_date.getUTCFullYear(),
slider_date.getUTCMonth() + 1,
slider_date.getUTCDate()].join("-");
}
})
</script>
'))),
And the labels will display the dates as expected.
This is of course some quick hacking and may not work if some other customization is made to the slider.
I think somehow the Shiny team should consider adding a calculate option in sliderInput which directly maps to slider.settings.calculate, just to make things like this easier.
I am writing a code to generate four stimulations and then generate graphs. My code works, but I want instead of generating four graphs I want to combine them all in one graph. How can I do that?
My code:
queueSimulation <- function(arriverate, servrate, endtime) {
queue = numeric(0)
arrivetimes = rexp(10000, arriverate)
servtimes = rexp(10000, servrate)
clock = 0.0
clist=c()
qlist=c()
while(clock <= endtime) {
if(length(queue) > 0 && queue[1] < arrivetimes[1]) {
clock = clock + queue[1]
queue = queue[-1]
}
else {
clock = clock + arrivetimes[1]
queue[length(queue) + 1] = servtimes[1]
arrivetimes = arrivetimes[-1]
servtimes = servtimes[-1]
}
#queue_size= length(round(clock, 2))
clist = c(clist , clock)
qlist = c(qlist , length(queue))
}
a<-data.frame(time=clist , qsize=qlist)
print(a)
mean1<-mean(qlist)
cat("Average :", mean1, "\n")
plot(a)
}
and calling the function:
queueSimulation(1.0, 5.0, 100)
queueSimulation(2.0, 4.0, 100)
queueSimulation(2.3, 3.5, 100)
queueSimulation(4.0, 5.0, 100)
There might be a better solution to this, but how about slightly changing your approach.
1- In your function, add two variables, one for color (cl) and one to tell your function if your plotting the main plot or just adding lines (pl). 1 for main and 0 for lines.
function(arriverate, servrate, endtime,cl,pl) {
2- call your plot with an if statement, and fix your y axis to range from 0 to 200.
if(pl==1){plot(a,col=cl,ylim=c(0,200),type="l")} else{lines(a,col=cl)}}
and then, call your function with theses two variables (cl and pl) :
queueSimulation(1.0, 5.0, 100,"red",1)
queueSimulation(2.0, 4.0, 100,"blue",0)
queueSimulation(2.3, 3.5, 100,"green",0)
queueSimulation(4.0, 5.0, 100,"black",0)
The problem I see with this is that your simulations can get values way over 200 for the y axis, maybe try to find a way to get max y values in one of your call.
Take a look at layout, specifically put layout(matrix(1:4,nrow=2)) (or a variant) before you call your plotting functions.