In R, is it possible to create a function that sets a default answer after some defined amount of time for menu (or to create something that works like that)?
My best not-working idea is to try using {future}.
Example
library(future)
plan(multisession(workers = 2))
zero_after_s <- function(s) Sys.sleep(s)
zero_after_t_menu <- function(
choices, graphics = FALSE, title = NULL, t = 0
) {
if (t == 0) {
menu(choices, graphics, title)
} else {
time_passed <- future(zero_after_s(t))
while (!resolved(time_passed)) {
return(menu(choices, graphics, title))
}
0
}
}
switch(
zero_after_t_menu(c("List letters", "List LETTERS"), t = 5) + 1,
cat("Nothing done (maybe t seconds passed without answers)\n"),
letters,
LETTERS
)
This cannon work because while will cycle and check its argument only when its body finishes the cycle, i.e., the user has answered to menu. I put this just as a tentative idea of a solution.
I try to call menu from the future (it seems more promising), but I cannot interact with it anymore (obviously), and anyway, it throws an error because menu cannot be used non-interactively :-)
zero_after_t_menu <- function(
choices, graphics = FALSE, title = NULL, t = 0
) {
if (t == 0) {
menu(choices, graphics, title)
} else {
res %<-% future(menu(choices, graphics, title), earlySignal = TRUE)
Sys.sleep(t)
if (resolved(res)) res else 0
}
}
Any ideas or suggestions?
Thank you,
Corrado.
PS: my actual use case is a loop across some (many) files to be (slowly) preprocessed. Under some conditions, I would like to have the opportunity to select what to do. Still, given that it is a very long execution, during nights or not-monitoring time, I would like a safe default selection (e.g., "skip that iteration for the future") to be made automatically to permit the loop to go on without my supervision.
I think I have a simple question, but I can not figure out how to do it.
I just wanna plot all hist of an data input and check if all var are numerical.
plotting_histogram_data<-function(x) {
for(i in seq_len((ncol(x)))) {
if(is.numeric(x[,i])) {
hist(x[,i])
}
else{
print("Variable is not of the Typ numeric!")
}
}
}
I know that the problem is the index.
Thank and have nice day.
Is there something in R (either a package or base idiom) that is like an Option as found in Scala and other languages (see tag optional for details). Specifically, I'm looking for the following features some object that can:
signify the absence of a value but easily
hold attributes
return a default value in the face of having no contained value without requiring that the result of the default value be calculated unless it is actually needed
I'm sure there are a lot of other nice characteristics of Options that I haven't fully recognized as I'm relatively new to the idiom. Any answer that can provide more than the above listed features gets bonus points, especially if the additional features can be described well.
I tried writing a poor substitute using an R6 class (below). Anything that works better or is more idiomatically aligned with R would be greatly appreciated.
library(R6)
Option <- R6Class("Option",
public = list(
initialize = function(value=NULL) {
self$value <- value
}
,get = function() {
return(self$value)
}
,set = function(value) {
self$value <- value
return(value)
}
,getOrElse = function(...) {
if(self$isDefined()) {
return(self$value)
} else {
return(eval(...))
}
}
,isDefined = function() {
return(!all(is.null(self$value)) && !all(is.na(self$value)))
}
, value = NULL
)
,private = list()
,active = list()
) #end Option
Example:
bob <- Option$new()
bob$isDefined() == FALSE
bob$getOrElse("a") == "a"
bob$getOrElse({Sys.sleep(2);"b"})=="b"
bob$set(value = "a")
bob$isDefined() == TRUE
bob$getOrElse({Sys.sleep(2);"b"})=="a"
I have some particularly finicky code that behaves differently on different platforms, but also behaves differently if run under valgrind ... right now I know that it
gives a warning if run on 32-bit Linux not under valgrind
gives an error if run elsewhere or on 32-bit Linux with R -d valgrind
The code below works (sorry for the lack of reproducible example, you can probably see that it would be pretty hard to write one) if I'm not running under valgrind, but under valgrind it fails because we get an error rather than a warning.
if (sessionInfo()$platform=="i686-pc-linux-gnu (32-bit)") {
expect_warning(update(g0, .~. +year), "failed to converge")
} else {
expect_error(update(g0, .~. +year), "pwrssUpdate did not converge in")
}
I would like an expect_warning_or_error() function; I suppose I could make one by hacking together the guts of expect_error and expect_warning, which don't look too complicated, but I welcome other suggestions.
Alternatively, I could figure out how to detect whether I am running under valgrind or not (seems harder).
A sort-of reproducible example:
library(testthat)
for (i in c("warning","stop")) {
expect_warning(get(i)("foo"))
expect_error(get(i)("foo"))
}
My solution, hacked together from gives_warning() and throws_error(). I'm not sure it's completely idiomatic/robust ...
gives_error_or_warning <- function (regexp = NULL, all = FALSE, ...)
{
function(expr) {
res <- try(evaluate_promise(expr),silent=TRUE)
no_error <- !inherits(res, "try-error")
if (no_error) {
warnings <- res$warnings
if (!is.null(regexp) && length(warnings) > 0) {
return(matches(regexp, all = FALSE, ...)(warnings))
} else {
return(expectation(length(warnings) > 0, "no warnings or errors given",
paste0(length(warnings), " warnings created")))
}
}
if (!is.null(regexp)) {
return(matches(regexp, ...)(res))
}
else {
expectation(TRUE, "no error thrown", "threw an error")
}
}
}
#Ben I may be misunderstanding but it comes to mind here that if you want to know if something errored/warned or not you could use tryCatch. If this is not what you want or you were hoping for a more testthat approach feel free to say, "You're way of the mark" but add an emoticon like :-) and it will make everything better.
First I make a temperamental function to mimic what you describe. Then I make an is.bad function and just look for errors or warnings (don't worry about OS as this behavior is hard to predict). Then I wrap with expect_true or expect_false:
temperamental <- function(x) {
if (missing(x)){
ifelse(sample(c(TRUE, FALSE), 1), stop("Robot attack"), warning("Beware of bots!"))
} else {
x
}
}
temperamental()
temperamental(5)
is.bad <- function(code) {
isTRUE(tryCatch(code,
error = function(c) TRUE,
warning = function(c) TRUE
))
}
expect_true(is.bad(temperamental()))
expect_false(is.bad(temperamental(5)))
I had the same problem and after reading the source for both functions I found a good solution. Actually is very simple, you only need to add a small if statement in the code from expect_error.
This is the code from expect_error
function (object, regexp = NULL, ..., info = NULL, label = NULL)
{
lab <- make_label(object, label)
error <- tryCatch({
object
NULL
}, error = function(e) {
e
})
if (identical(regexp, NA)) {
expect(is.null(error), sprintf("%s threw an error.\n%s",
lab, error$message), info = info)
}
else if (is.null(regexp) || is.null(error)) {
expect(!is.null(error), sprintf("%s did not throw an error.",
lab), info = info)
}
else {
expect_match(error$message, regexp, ..., info = info)
}
invisible(NULL)
}
Adding an if statement before the return value you check if an error was not thrown and check for warnings (remember to add the all argument to the new function). The new function code is this:
expect_error_or_warning <- function (object, regexp = NULL, ..., info = NULL, label = NULL, all = FALSE)
{
lab <- testthat:::make_label(object, label)
error <- tryCatch({
object
NULL
}, error = function(e) {
e
})
if (identical(regexp, NA)) {
expect(is.null(error), sprintf("%s threw an error.\n%s",
lab, error$message), info = info)
} else if (is.null(regexp) || is.null(error)) {
expect(!is.null(error), sprintf("%s did not throw an error.",
lab), info = info)
} else {
expect_match(error$message, regexp, ..., info = info)
}
if(is.null(error)){
expect_warning(object = object, regexp = regexp, ..., all = all, info = info, label = label)
}
invisible(NULL)
}
This code is very robust and easy to maintain. If you are writing a package and can't use functions that aren't exported (:::) you can bring the code from make_label to the function, is only one line.
I would like to ask how can we get a value of a function which is embedded in another function, as in the following example:
message <- function() {
inside.message <- function() {
return("inside.message")
}
}
run.f <- function() {
return.inside.mesage <- message()
print(return.inside.mesage)
}
run.f() # We do not get "inside.message"
Thank you in advance, all of you
In your code message() returns a function. To call it, you need to add an extra pair of brackets:
> message()()
[1] "inside.message"
if you replace message() by message()() in your code it will do what you want.
As you wrote it, the function message returns a function, which if evaluated will return "inside.message". So there are a couple ways to get R to print "inside.message".
First way:
In the message function, add the line return(inside.message()) so that the function inside.message is evaluated and the result is returned, instead of returning the function itself:
message <- function() {
inside.message <- function() {
return("inside.message")
}
return(inside.message())
}
message()
# "inside.message"
Then evaluating run.f() will also print "inside.message".
The second way:
Leave message as you have it and change run.f() to the following
run.f <- function() {
return.inside.mesage <- message()
print(return.inside.mesage())
}
Above, you assign the function returned by message() to the object return.inside.message and then evaluate that function.
As you've written it, message returns the function inside.message because you didn't explicitly return anything and it is the last expression evaluated inside of message.
You seem to want it to return the value from evaluating inside.message, which requires another line of code in message:
message <- function() {
inside.message <- function() {
return("inside.message")
}
inside.message()
}