How to break a loop after a certain elapsed time? I have a function that collects observational data from a user. The user should have a pre-defined time limit, when the data are recorded (30 sec in the example). At the moment, the function breaks, if the user-input arrives later than the end of the time limit.
record.events <- function(duration = 30, first.event = "a"){
# Initial settings
time.start <- proc.time()[3]
events <- c(first.event, 0)
# Timed data collection
while(proc.time()[3] - time.start < duration){
temp <- readline("record events...")
events <- c(events, temp, proc.time()[3] - time.start)
}
# Format recorded data for post-processing
events <- as.data.frame(matrix(events, byrow=T, ncol=2,
dimnames=list(NULL, c("events","stroke.time"))))
events[,2] <- round(as.numeric(as.character(events[,2])),3)
return(events)
}
Gives for example this result:
events stroke.time
1 a 0.000
2 f 2.618
3 a 23.791
4 f 24.781
5 a 33.488
The last event (a) arrived after the time limit. SO has a solution for this in matlab. Is there a way in R, how to stop waiting for the user input as soon as the time is up?
Edit:
While functions setTimeLimit() and R.utils::withTimeout() can terminate execution of a function that takes too long (thanks to Kodl, Carl Witthoft and Colombo, together with this answer), neither can interrupt readline(). Documentation to withTimeout specifies:
Furthermore, it is not possible to interrupt/break out of a "readline" prompt (e.g. readline() and readLines()) using timeouts; the timeout exception will not be thrown until after the user completes the prompt (i.e. after pressing ENTER).
The user input after the time limit is thus the only way, how to stop waiting for readline. The check can be executed with the while loop as in my code, or with setTimeLimit or withTimeout in a combination with tryCatch. I therefore accept Kodl's answer.
I've also been looking for a solution to this, ended up writing my own function below, but it only works in some setups/platforms.
The main problem is that readline suspends execution until input is provided, so it may hang indefinitely, without ever returning.
My workaround is to open(file('stdin'), blocking=FALSE), and then use readLines(n=1). Problem with that is that it only accepts file('stdin'), which is not always connected. It fails in RGui for windows and MacOS, and for RStudio (at least for MacOS). But it seems to work for R when run from terminal under MacOS.
readline_time <- function(prompt, timeout = 3600, precision=.1) {
stopifnot(length(prompt)<=1, is.numeric(timeout), length(timeout)==1, !is.na(timeout), timeout>=0, is.numeric(precision), length(precision)==1, !is.na(precision), precision>0)
if(!interactive()) return(NULL)
if(timeout==0) return(readline(prompt))
my_in <- file('stdin')
open(my_in, blocking=FALSE)
cat(prompt)
ans <- readLines(my_in, n=1)
while(timeout>0 && !length(ans)) {
Sys.sleep(precision)
timeout <- timeout-precision
ans <- readLines(my_in, n=1)
}
close(my_in)
return(ans)
}
Or if you want to import (along with some other functions):
devtools::install_github('EmilBode/EmilMisc')
i think you can use fucntion "setTimeLimit" from library base. so...
record.events <- function(duration = 30, first.event = "a"){
# Initial settings
time.start <- proc.time()[3]
events<-first.event
stroke.time<-c(0)
# Timed data collection
while(proc.time()[3] - time.start < duration){
temp <- tryCatch({setTimeLimit(elapsed=(time.start + duration - proc.time()[3]),
transient = TRUE);readline("record events...")},
error = function(e) { return("NULL")})
#you need to set up back this function... (but why i dont know????)
setTimeLimit(elapsed = Inf, transient = TRUE)
events[length(events)+1] <- temp
stroke.time[length(stroke.time)+1]<-round(proc.time()[3],3)
}
# Format recorded data for post-processing
events<-data.frame(events, stroke.time)
return(events)
}
But setTimeLimit inst great for use in user functions.. My results is:
events stroke.time
1 a 0.00
2 s 1539.12
3 s 1539.52
4 ass 1539.96
5 s 1540.49
6 asd 1540.94
7 fed 1541.27
8 NULL 1541.55
For more info see:
https://stackoverflow.com/a/7891479
https://stat.ethz.ch/R-manual/R-devel/library/base/html/setTimeLimit.html
How does setTimeLimit work in R?
setTimeLimit fails to terminate idle call in R
I was curious to see if anyone had a real Rland solution to this problem, but it looks like not.
One possible solution is to shell out with system() and run a command that allows reading input with a time limit. This is inherently platform-specific. The Unix bash shell provides a read builtin that is perfect for this purpose, and this will also work on the Cygwin emulation layer on Windows. Unfortunately, I haven't ever come across a command available on the vanilla native Windows platform that provides sufficient functionality for this. set /p can read arbitrary string input but does not provide a timeout, while choice.exe provides a timeout (accurate to the second) but only supports selection of an item from a finite list of (single-character!) items, as opposed to arbitrary string input. Fun fact: choice.exe has its own Wikipedia article.
Here's how you can use read to do this:
LIMIT <- 10; ## conceptual constant
end <- Sys.time()+(left <- LIMIT); ## precompute end of input window and init left
repeat {
input <- suppressWarnings(system(intern=T,sprintf(
'read -r -t %.2f; rc=$?; echo "$REPLY"; exit $rc;',
left
))); ## suppress warnings on non-zero return codes
left <- difftime(end,Sys.time(),units='secs');
cat(sprintf('got input: \"%s\" [%d] with %.2fs left\n',
input,
if ('status'%in%names(attributes(input))) attr(input,'status') else 0L,
left
));
if (left<=0) break;
};
## asdf
## got input: "asdf" [0] with 9.04s left
## xcv
## got input: "xcv" [0] with 8.15s left
## a
## got input: "a" [0] with 6.89s left
## b
## got input: "b" [0] with 6.68s left
## c
## got input: "c" [0] with 6.44s left
##
## got input: "" [0] with 5.88s left
##
## got input: "" [1] with 4.59s left
## got input: "" [1] with 3.70s left
##
## got input: "" [0] with 0.86s left
##
## got input: "" [0] with 0.15s left
## got input: "" [142] with -0.03s left
The sample output I've shown above was me playing around during the input window. I mostly typed some random lines and pressed enter to submit them, giving a return code of 0. The two lines of output that show a return code of 1 were me pressing ^d, which causes read to return 1 immediately, leaving whatever input that was in the buffer in $REPLY (nothing, in those two cases). The final line of output was read terminating immediately upon hitting the timeout, which I believe is the functionality you're looking for. You can use the return code of 142 to distinguish the timeout event from other input events. I'm not completely certain that the return code of 142 is consistent and reliable on all Unix systems, but there's also another way to detect the timeout event: check the current time against end (i.e. the left calculation), as I do in the code. Although I suppose that approach introduces a race condition between a possible last-moment submission and the time check in Rland, but you probably don't need that level of design criticality.
Related
?option says this.
‘prompt’: a non-empty string to be used for R's prompt; should
usually end in a blank (‘" "’).
Is it possible to make the prompt to include some dynamic stuffs, e.g., the current time?
You should take a look at the taskCallbackManager (https://developer.r-project.org/TaskHandlers.pdf). With prompt you can call the current time and save it. Example: options("prompt"=format(Sys.time(), "%H:%M:%S> ")). But this is fixed with the time it was set.
The doc for the function taskCallbackManager has the rest:
R> h <- taskCallbackManager()
R> h$add(function(expr, value, ok, visible) {
+ options("prompt"=format(Sys.time(), "%H:%M:%S> "));
+ return(TRUE) },
+ name = "simpleHandler")
[1] "simpleHandler"
07:25:42> a <- 2
07:25:48>
This registers a callback that gets evaluated after each command completes.
I have the following code which, because of Excel max row limitations, is restricted to ~1million rows:
ZStream.unwrap(generateStreamData).mapMPar(32) {m =>
streamDataToCsvExcel
}
All fairly straightforward and it works perfectly. I keep track of the number of rows streamed, and then stop writing data. However I want to interrupt all the child fibers spawned in mapMPar, something like this:
ZStream.unwrap(generateStreamData).interruptWhen(effect.true).mapMPar(32) {m =>
streamDataToCsvExcel
}
Unfortunately the process is interrupted immediately here. I'm probably missing something obvious...
Editing the post as it needs some clarity.
My stream of data is generated by an expensive process in which data is pulled from a remote server, (this data is itself calculated by an expensive process) with n Fibers.
I then process the streams and then stream them out to the client.
Once the processed row count has reached ~1 million, I then need to stop pulling data from the remote server (i.e. interrupt all the Fibers) and end the process.
Here's what I can come up with after your clarification. The ZIO 1.x version is a bit uglier because of the lack of .dropRight
Basically we can use takeUntilM to count the size of elements we've gotten to stop once we get to the maximum size (and then use .dropRight or the additional filter to discard the last element that would take it over the limit)
This ensures that both
You only run streamDataToCsvExcel until the last possible message before hitting the size limit
Because streams are lazy expensiveQuery only gets run for as many messages as you can fit within the limit (or N+1 if the last value is discarded because it would go over the limit)
import zio._
import zio.stream._
object Main extends zio.App {
override def run(args: List[String]): URIO[zio.ZEnv, ExitCode] = {
val expensiveQuery = ZIO.succeed(Chunk(1, 2))
val generateStreamData = ZIO.succeed(ZStream.repeatEffect(expensiveQuery))
def streamDataToCsvExcel = ZIO.unit
def count(ref: Ref[Int], size: Int): UIO[Boolean] =
ref.updateAndGet(_ + size).map(_ > 10)
for {
counter <- Ref.make(0)
_ <- ZStream
.unwrap(generateStreamData)
.takeUntilM(next => count(counter, next.size)) // Count size of messages and stop when it's reached
.filterM(_ => counter.get.map(_ <= 10)) // Filter last message from `takeUntilM`. Ideally should be .dropRight(1) with ZIO 2
.mapMPar(32)(_ => streamDataToCsvExcel)
.runDrain
} yield ExitCode.success
}
}
If relying on the laziness of streams doesn't work for your use case you can trigger an interrupt of some sort from the takeUntilM condition.
For example you could update the count function to
def count(ref: Ref[Int], size: Int): UIO[Boolean] =
ref.updateAndGet(_ + size).map(_ > 10)
.tapSome { case true => someFiber.interrupt }
I am unable to define empty IndexedTables, e.g.
using IndexedTables, IndexedTables.Table
t = Table(Columns(a=Int64[],b=String[]),Int64[])
t[1,"a"] = 1
t[1,"b"] = 2
t[1,"c"] = t[1,"a"] + t[1,"b"]
BoundsError: attempt to access 0-element Array{Int64,1} at index [0]
I am aware that creating the IndexedTable with already the data is more efficient that creating an empty one and then insert values, but sometimes you are obliged to go on this way.
Is this a bug ? If so, is there any workaround possible ?
(I already posted this thread on the Julia forum, but so far I had no replies there)
This is probably a bug in IndexedTables.
Inserting into an IndexedTable requires reindexing to access the data. Reindexing is done with flush!.
But flush!(t) fails in the example in the question with the empty t.
Fixing flush! which calls _merge! can be done by:
julia> function IndexedTables._merge!(dst::IndexedTable, src::IndexedTable, f)
if length(dst.index)==0 || isless(dst.index[end], src.index[1])
append!(dst.index, src.index)
append!(dst.data, src.data)
else
# merge to a new copy
new = _merge(dst, src, f)
ln = length(new)
# resize and copy data into dst
resize!(dst.index, ln)
copy!(dst.index, new.index)
resize!(dst.data, ln)
copy!(dst.data, new.data)
end
return dst
end
julia> t[1,"c"] = t[1,"a"] + t[1,"b"]
3
The change is the addition of the length(...) check in the first if.
Of course, a pull request / issue should be opened with IndexedTables.jl. Antonello, will you do this? (or shall I)
I'm trying to make life a little bit easier for myself but it is not working yet. What I'm trying to do is the following:
NOTE: I'm running R in the unix server, since the rest of my script is in R. That's why there is system(" ")
system("TRAIT=some_trait")
system("grep var.resid.anim rep_model_$TRAIT.out > res_var_anim_$TRAIT'.xout'",wait=T)
When I run the exact same thing in putty (without system(" ") of course), then the right file is read and right output is created. The script also works when I just remove the variable that I created. However, I need to do this many times, so a variable is very convenient for me, but I can't get it to work.
This code prints nothing on the console.
system("xxx=foo")
system("echo $xxx")
But the following does.
system("xxx=foo; echo $xxx")
The system forgets your variable definition as soon as you finish one call for "system".
In your case, how about trying:
system("TRAIT=some_trait; grep var.resid.anim rep_model_$TRAIT.out > res_var_anim_$TRAIT'.xout'",wait=T)
You can keep this all in R:
grep_trait <- function(search_for, in_trait, out_trait=in_trait) {
l <- readLines(sprintf("rep_model_%s.out", in_trait))
l <- grep(search_for, l, value=TRUE) %>%
writeLines(l, sprintf("res_var_anim_%s.xout", out_trait))
}
grep_trait("var.resid.anim", "haptoglobin")
If there's a concern that the files are read into memory first (i.e. if they are huge files), then:
grep_trait <- function(search_for, in_trait, out_trait=in_trait) {
fin <- file(sprintf("rep_model_%s.out", in_trait), "r")
fout <- file(sprintf("res_var_anim_%s.xout", out_trait), "w")
repeat {
l <- readLines(fin, 1)
if (length(l) == 0) break;
if (grepl(search_for, l)[1]) writeLines(l, fout)
}
close(fin)
close(fout)
}
How can I offer 5 seconds to the user to write something in order to ask for a pause of indefinite length. If the pause is not demanded within these 5 seconds, the process continues. If a pause is demanded, then the user has all the time (s)he needs and (s)he can hit "enter" in order to resume the process whenever (s)he wants.
The interest of such functionality is that if the user is absent, the pause lasts for 5 seconds only. And if the user is present, then (s)he can enjoy a pause in order to watch the graph that has been produced for example.
The code may eventually look like that:
DoYouWantaPause = function(){
myprompt = "You have 5 seconds to write the letter <p>. If you don't the process will go on."
foo = readline(prompt = myprompt, killAfter = 5 Seconds) # give 5 seconds to the user. If the user enter a letter, then this letter is stored in `foo`.
if (foo == "p" | foo == "P") { # if the user has typed "p" or "P"
foo = readline(prompt = "Press enter when you want to resume the process") # Offer a pause of indefinite length
}
}
# Main
for (i in somelist){
...
DoYouWantaPause()
}
Here is a quick little function based on the tcltk and tcltk2 packages:
library(tcltk)
library(tcltk2)
mywait <- function() {
tt <- tktoplevel()
tmp <- tclAfter(5000, function()tkdestroy(tt))
tkpack( tkbutton(tt, text='Pause', command=function()tclAfterCancel(tmp)))
tkpack( tkbutton(tt, text='Continue', command=function()tkdestroy(tt)),
side='bottom')
tkbind(tt,'<Key>', function()tkdestroy(tt) )
tkwait.window(tt)
invisible()
}
Run mywait and a small window will pop-up with 2 buttons, if you don't do anything then after about 5 seconds the window will go away and mywait will return allowing R to continue. If you click on "Continue" at any time then it will return immediately. If you click on "Pause" then the countdown will stop and it will wait for you to click on continue (or pressing an key) before continuing on.
This is an extension of the answer given here.