I have a program to execute per 15 seconds, how can I achieve this, the program is as followed:
print_test<-function{
cat("hello world")
}
What I use for executing same code block every 15 seconds:
interval = 15
x = data.frame()
repeat {
startTime = Sys.time()
x = rbind.data.frame(x, sum(data)) #replace this line with your code/functions
sleepTime = startTime + interval - Sys.time()
if (sleepTime > 0)
Sys.sleep(sleepTime)
}
x and data are dummy which you need to replace accordingly. This will execute indefinitely until stopped by user. If you need to stop and start at specific times then you need a for loop instead of 'repeat`.
Hope this helps.
You can do something like this:
print_test<-function(x)
{
Sys.sleep(x)
cat("hello world")
}
print_test(15)
If you want to execute it for a certain amount of iterations use to incorporate a 'for loop' in your function with the number of iterations.
You can use something like this:
print_test<-function(x)
{
if(condition)
{
Sys.sleep(x);
cat("hello world");
print_test(x);
}
}
print_test(15)
In this, a function is calling itself after the seconds passed as argument given the condition evaluates to true.
You also can use like this:
h <- function(i) {
Sys.sleep(i)
print("Hello world!")
}
timer <- function(i) {
while (T) {
h(i)
}
} # Timer function
Related
I have written the following function:
iterations_per_minute = function() {
Sys.setenv(TZ='GMT+5') ## This line is optional; it just sets my timezone
final_instant = as.numeric(format(Sys.time(), "%H.%M")) + 0.01
counter = 0
while(as.numeric(format(Sys.time(), "%H.%M")) < final_instant) {
counter = counter + 1
}
return(counter)
}
You can infer from the code what the function does, but allow me to explain in lay words anyway: what number can you reach by counting as fast as possible during one minute starting from the number 1? Think of the computer doing exactly that same thing. The output of this function is the number that the computer reaches after counting for a whole minute.
Or at least that is how I would like this function to behave. It does work the way I have described if we pair exactly the call to the function with the beginning of a minute in the clock. However, it will count for less than a minute if we execute this function when the second hand of the clock is pointing at any other number besides twelve. How do I fix this?
Also, I figure I probably won't get the desired output if I execute the function between 23:59 and 0:00. How can this other issue be fixed?
Seems to me like you're trying to introduce more moving parts than you need.
Consider the following:
a <- Sys.time()
a
# [1] "2020-07-25 16:21:40 CDT"
a + 60
# [1] "2020-07-25 16:22:40 CDT"
So, we can just add 60 to Sys.time() without worrying about conversions or whatever else:
iterations_per_minute = function() {
counter = 0
end <- Sys.time() + 60
while( Sys.time() < end ) {
counter = counter + 1
}
return(counter)
}
Using this function, apparently my machine can count to 1474572 in one minute.
I want to incorporate a countdown timer into an R function that I am writing to record the behavioural response of animals to smells so that the user knows how long an experiment has left to run.
I have found a package called countdown that I think could be useful, which can be found on GitHub here. When using this package I cannot get the countdown_fullscreen function to operate as I need for my function - it doesn't display the countdown in the viewer pane and nor does it begin automatically. Both of these issues decrease the experiment accuracy.
This is the code I am using for my function:
record_data = function(x) {
require(tictoc) #load required packages
require(countdown)
timer = readline("Observation time: ")
timer = as.numeric(timer)
countdown::countdown_fullscreen(timer)
while(T){ #open infinite while loop
tic() #start timer
input_state=readline("State input: ") #allow for entry of state
if(input_state %in% 1:5){ #check if it's acceptable
elapsed=toc() #if it is then end timer and record data
write.table(cbind(input_state,elapsed$toc-elapsed$tic),'results.txt',col.names=F,row.names=F,quote=F,append=T)
}else if(input_state=='t'){ #if input is 't'
break #break out of while loop
}else if(input_state <1 | input_state > 5 & input_state!='t'){ #if input is not and accepted state AND is not 't'
print('thats not an allowed state- please try another')
}
}
I expect that the timer would be displayed in viewer and begin automatically, but this is not the case. Any help would be greatly appreciated.
I'm not familiar with the countdown package. But one option may be to use a tcltk progress bar
library(tcltk)
timer = 10
pb <- tkProgressBar("Timer")
start = Sys.time()
while(TRUE) {
elapsed = as.numeric(difftime(Sys.time(), start, units = 'secs'))
remaining = timer - elapsed
Sys.sleep(0.1)
setTkProgressBar(pb, remaining/timer, label = sprintf("Time remaining: %i seconds", round(remaining)))
if (remaining <= 0) break
}
Sys.sleep(2)
close(pb)
Is it possible to write a function in R which will hold its execution, giving the users control over the console (while in interactive mode of course), meanwhile recording their inputs, and continuing execution either:
after a certain input has been made
or after a certain output has been made
or a certain duration of time has passed
Example: ask the user a question (without using readline() for the answer)
question <- function() {
message("How much is 2 + 2?")
#let users take control of the console
#continue to next statement only if they input "2+2", or "4" or a minute has passed
#meanwhile record their last input similar to ".Last.Value", e.g.:
startTime <- Sys.time()
timeout <- FALSE
lastInput <- lastInput()
while (eval(parse(text = lastInput)) != 4 & !timeout) {
if (difftime(Sys.time(), startTime, units = "mins") > 1) {
timeout <- TRUE
}
lastInput <- lastInput()
}
if (timeout) {
stop("Sorry, timeout.")
} else {
message("Correct! Let's continue with this function:")
}
}
Where lastInput() is a function which "listens" to user input when it changes.
Obviously the above structure is tentative and won't give me what I want, some way to "listen" or "observe" and only react when the user inputs something to the console.
The final user experience should be:
> question()
How much is 2+2?
> #I'm the user, I can do whatever
> head(mtcars)
> plot(1:10)
> 3
> 2 + 2
[1] 4
Correct! Let's continue with this function:
Am I too optimistic or is there some R magic for this?
Thanks to #parth I have looked at swirl's source code and got acquainted with the addTaskCallback function. From the help file:
addTaskCallback registers an R function that is to be called each time a top-level task is completed.
And so we can make R check the users input ("top-level task") with a specific function, responding accordingly.
But since the swirl code is very "heavy", I think I need to supply a minimal example:
swirllike <- function(...){
removeTaskCallback("swirllike")
e <- new.env(globalenv())
e$prompt <- TRUE
e$startTime <- Sys.time()
cb <- function(expr, val, ok, vis, data=e){
e$expr <- expr
e$val <- val
e$ok <- ok
e$vis <- vis
# The result of f() will determine whether the callback
# remains active
return(f(e, ...))
}
addTaskCallback(cb, name = "swirllike")
message("How much is 2+2?")
}
OK, so the swirllike function evokes the 2+2 question, but it also declares a new environment e with some objects the user needs not know. It then adds the swirllike task callback to the task callback list (or rather vector). This "task callback" holds the cb function which calls the f function - the f function will run with every input.
If you run this, make sure you see the swirllike task callback with:
> getTaskCallbackNames()
[1] "swirllike"
Now the f function is similar to my sketch in the question:
f <- function(e, ...){
if (e$prompt) {
if (difftime(Sys.time(), e$startTime, units = "mins") > 1) {
timeout <- TRUE
stop("Sorry, timeout.")
}
if(!is.null(.Last.value) && .Last.value == 4) {
message("Correct! Let's continue with this function:")
e$prompt <- FALSE
while (!e$prompt) {
#continue asking questions or something, but for this example:
break
}
}
}
return(TRUE)
}
And don't forget to remove the swirllike task callback with:
removeTaskCallback("swirllike")
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
}
}
I have the following code:
first.moves <- function()
{
go.first <- readline("Do you want to go first? (Y/N) ")
if (go.first == "Y" || go.first == "y")
{
game <- altern.moves()
}
else
{
game <- move(game,1,1)
}
return(game)
}
altern.moves <- function()
{
plyr.mv <- as.numeric(readline("Please make a move (1-9) "))
game <- move(game,plyr.mv,0)
cmp.mv <- valid.moves(game)[1]
game <- move(game,cmp.mv,1)
return(game)
}
#game
game <- matrix(rep(NA,9),nrow=3)
print("Let's play a game of tic-tac-toe. You have 0's, I have 1's.")
(game <- first.moves())
repeat
{
game <- altern.moves()
print(game)
}
When I run the part after #game in batch mode neither does R stop to wait for "Do you want to go first? (Y/N)" nor does it repeat the repeat block. Everything works fine on its own and when I click through it line-by-line.
What am I doing wrong and how can I remedy the situation to have a decent program flow but with user interaction? (or do I really have to click through this part of the code line-by-line? I hope not...)
Add this to the beginning of your code:
if (!interactive()) {
batch_moves <- list('Y', 5, 2) # Add more moves or import from a file
readline <- (function() {
counter <- 0
function(...) { counter <<- counter + 1; batch_moves[[counter]] }
})()
}
Now you get
> readline()
[1] "Y"
> readline()
[1] 5
> readline()
[1] 2
EDIT: Optionally, to clean up (if you are running more scripts), add rm(readline) to the end of your script.
EDIT2: For those who don't like <<-, replace counter <<- counter + 1 with assign('counter', counter + 1, envir = parent.env(environment())).