run a function for specified time in R - r

I'm trying to get a function to run for a specified amount of time, at the moment I'm trying to use the system.time function. I can't figure out how to define a new variable that takes on cumulative value the function running, then put it into a while loop.
timer<-(system.time(simulated_results<-replicate(n=1,simulation(J,10000,FALSE,0.1),simplify="vector"))[3])
print(timer)
while(cumsum(timer)<15){
print(cumsum(timer))
simulated_results<-replicate(n=10000,simulation(J,10000,FALSE,0.1),simplify="vector")
}
I would greatly appreciate any help!!!

If you want to run some code for a specified number of seconds, you can try the following :
start <- as.numeric(Sys.time())
duration <- 5
results <- NULL
while(as.numeric(Sys.time())-start < duration) {
results <- c(results, replicate(...))
}
Of course, you have to change the value of duration (in seconds), and replace replicate(...) with your code.

You can use tryCatch approach for this task. For example, consider the following code
fun_test = function(test_parameter){
result <- 1+test_parameter #some execution
return(result)
}
time = 10 #seconds
res <- NULL
tryCatch({
res <- withTimeout({
check = fun_test(tsp)
}, timeout = time)
}, TimeoutException = function(ex) {
message("Timeout. Skipping.")
})
This program will run the function fun_test for 10 seconds. If the execution is successful in this time, the result is returned, else program is stoped. For more guidance, you can follow this URL
Time out an R command via something like try()

Related

How can we build a timer for 5 different player using closure in R

There are 4 separate function for starting, ending, get their duration and display their result in desc order which needs to be implemented using closure. I was trying to implement three functions first :-
StopWatch <- function(){
list(strt<-function(Name = "name") Start <<- Sys.time(),
stop<-function() End <<- Sys.time(),
duration<-function(){ t <<- Start- End
print(t)})
}
w<- StopWatch()
w$strt("player1")
sleep_for_a_minute()
w$stop()
w$duration()
When I run w$strt("player1") it give an Error: attempt to apply non-function
The list you create in your function isn't named. Check by running names(w). You should use = instead of <-
As #Tyler Smith already wrote, you need =, because you want to assign names to list elements here and not really define functions. Also you're attempting to overwrite the t() function (which exemplarily here yields an error), use something different.
StopWatch <- function() {
list(strt=function(Name = "name") Start <<- Sys.time(),
stop=function() End <<- Sys.time(),
duration=function() {
tm <<- Start - End
print(tm)
})
}
w <- StopWatch()
w$strt("player1")
Sys.sleep(1)
w$stop()
w$duration()
# Time difference of -2.27513 secs

How to use withTimeout function to interrupt expression if it takes too long

I would like to terminate some code if a computation takes too long, i.e., it takes more than 2 seconds. I am trying to use the withTimeout function. Reading the example in the help, the following code is working and I get an error:
foo <- function() {
print("Tic")
for (kk in 1:100) {
print(kk)
Sys.sleep(0.1)
}
print("Tac")
}
res <- withTimeout({foo()}, timeout = 2)
I tried to replicate this logic writing the following code, but it does not work, i.e., the computation ends even if the timeout has passed (on my laptop, it takes more or less 10 seconds).
res <- withTimeout({rnorm(100000000)}, timeout = 2)
Does anyone know why?
The rnorm example is a known "issue", which you can find on the R.utils GitHub site as a non-supported case.
You can make this work by doing
foo1 <- function(n = 1000000) {
ret <- rep(0, n);
for (kk in 1:n) ret[kk] <- rnorm(1);
ret;
}
# The following will time out after 2s
tryCatch( { res <- withTimeout( { foo1() },
timeout = 2) },
TimeoutException = function(ex) cat("Timed out\n"))
#Timed out
# Confirm that res is empty
res
#NULL

Questions on rxDataStep when using 'transformFunc'

The following R code is to add one column to the dataset and return the data.frame.
xdfAirDemo <- RxXdfData(file.path(rxGetOption("sampleDataDir"), "AirlineDemoSmall.xdf"))
I add a print function to check the length of the vector.
f.append <- function(lst){
lst$mod_val_test <- rep(1, length(lst[[1]]))
print(length(lst$mod_val_test))
return(lst)
}
df.Airline <- rxDataStep(inData = xdfAirDemo, transformFunc = f.append)
When I run the above rxDatastep , the print function in the 'f.append' function was executed twice and output two values. Can someone help me to understand how the rxDatastep works?
The result show as below.
[1] 10
[1] 600000
Rows Read: 600000, Total Rows Processed: 600000, Total Chunk Time: 0.651 seconds
When you call rxDataStep, it actually runs your code on the first 10 rows of the data as a test. If this succeeds, it then processes the entire dataset one chunk at a time.
If you don't want your code to be executed in the test run, you can check the value of the .rxIsTestChunk builtin variable:
f.append <- function(lst)
{
# don't print anything if this is the test chunk
if(.rxIsTestChunk)
return(NULL)
lst$mod_val_test <- rep(1, length(lst[[1]]))
print(length(lst$mod_val_test))
return(lst)
}

R - tryCatch - use last iteration index to restart the for loop

I already read documentations and several other question about tryCatch(), however, I am not able to figure out the solution to my class of problem.
The task to solve is:
1)There is a for loop that goes from row 1 to nrow of the dataframe.
2)Execute some instruction
3)In the case of error that would stop the program, instead restart the loop cycle from the current iteration.
Example
for (i in 1:50000) {
...execute instructions...
}
What I am looking for is a solution that in the case of error at the iteration 30250, it restart the loop such that
for (i in 30250:50000) {
...execute instructions...
}
The practical example I am working on is the following:
library(RDSTK)
library(jsonlite)
DF <- (id = seq(1:400000), lat = rep(38.929840, 400000), long = rep( -77.062343, 400000)
for (i in 1 : nrow(DF) {
location <- NULL
bo <- 0
while (bo != 10) { #re-try the instruction max 10 times per row
location <- NULL
location <- try(location <- #try to gather the data from internet
coordinates2politics(DF$lat[i], DF$long[i]))
if (class(location) == "try-error") { #if not able to gather the data
Sys.sleep(runif(1,2,7)) #wait a random time before query again
print("reconntecting...")
bo <- bo+1
print(bo)
} else #if there is NO error
break #stop trying on this individual
}
location <- lapply(location, jsonlite::fromJSON)
location <- data.frame(location[[1]]$politics)
DF$start_country[i] <- location$name[1]
DF$start_region[i] <- location$name[2]
Sys.sleep(runif(1,2,7)) #sleep random seconds before starting the new row
}
N.B.: the try() is part of the "...execute instruction..."
What I am looking for is a tryCatch that when a critical error that stops the program happen, it instead restart the for loop from the current index "i".
This program would allow me to automatically iterate over 400000 rows and restart where it interrupted in the case of errors. This means that the program would be able to work totally independently by human.
I hope my question is clear, thank you very much.
This is better addressed using while rather than for:
i <- 1
while(i < 10000){
tryCatch(doStuff()) -> doStuffResults
if(class(doStuffResults) != "try-catch") i <- i + 1
{
Beware though if some cases will always fail doStuff: the loop will never terminate!
If the program will produce a fatal error and need a human restart, then the first line i <- 1 may be replaced (as long as you don't use i elsewhere in your code) with
if(!exists("i")) i <- 1
so that the value from the loop will persist and not be reset to one.

How do I run a function every second

I want to run a function that takes less than one second to execute. I want to run it in a loop every second. I do not want to wait one second between running the function like Sys.sleep would do.
while(TRUE){
# my function that takes less than a second to run
Sys.sleep(runif(1, min=0, max=.8))
# wait for the remaining time until the next execution...
# something here
}
I could record a starttime <- Sys.time() and do a comparison every iteration through the loop, something like this...
starttime <- Sys.time()
while(TRUE){
if(abs(as.numeric(Sys.time() - starttime) %% 1) < .001){
# my function that takes less than a second to run
Sys.sleep(runif(1, min=0, max=.8))
print(paste("it ran", Sys.time()))
}
}
But my function never seems to be executed.
I know python has a package to do this sort of thing. Does R also have one that I don't know about? Thanks.
You can keep track of the time with system.time
while(TRUE)
{
s = system.time(Sys.sleep(runif(1, min = 0, max = 0.8)))
Sys.sleep(1 - s[3]) #basically sleep for whatever is left of the second
}
You can also use proc.time directly (which system.time calls), which for some reasons got better results for me:
> system.time(
for(i in 1:10)
{
p1 = proc.time()
Sys.sleep(runif(1, min = 0, max = 0.8))
p2 = proc.time() - p1
Sys.sleep(1 - p2[3]) #basically sleep for whatever is left of the second
})
user system elapsed
0.00 0.00 10.02
Here are some alternatives. These do not block. That is you can still use the console to run other code while they are running.
1) tcltk Try after in the tcltk package:
library(tcltk)
run <- function () {
.id <<- tcl("after", 1000, run) # after 1000 ms execute run() again
cat(as.character(.id), "\n") # replace with your code
}
run()
Running this on a fresh R session gives:
after#0
after#1
after#2
after#3
after#4
after#5
after#6
after#7
...etc...
To stop it tcl("after", "cancel", .id) .
2) tcltk2 Another possibility is tclTaskSchedule in the tcltk2 package:
library(tcltk2)
test <- function() cat("Hello\n") # replace with your function
tclTaskSchedule(1000, test(), id = "test", redo = TRUE)
Stop it with:
tclTaskDelete("test")
or redo= can specify the number of times it should run.
Another non-blocking alternative worth mentioning is provided by library(later), via using later() recursive:
print_time = function(interval = 10) {
timestamp()
later::later(print_time, interval)
}
print_time()
The example is taken from here.
The shiny package has a function invalidateLater() which can be use to trigger functions. Have a look at http://shiny.rstudio.com/gallery/timer.html
Although its very late.
As an alternative we can use recursion. I don't know if its the solution you are looking for. But it executes function at regular interval.
ssc <- function(){
x <- rnorm(30,20,2)
print(hist(x))
Sys.sleep(4)
ssc()
}
ssc()

Resources