Simple problem, but I can't find an answer that works anywhere. When I use readline() (for example, as demonstrated here - http://www.rexamples.com/4/Reading%20user%20input) it works perfectly:
readinteger <- function()
{
n <- readline(prompt="Enter an integer: ")
return(as.integer(n))
}
a <- print(readinteger())
However, if I add any code after this, readline() is skipped and the code just continues:
readinteger <- function()
{
n <- readline(prompt="Enter an integer: ")
return(as.integer(n))
}
a <- print(readinteger())
b <- 7
Any solutions (and/or easier ways to get user input)?
The problem here is that as soon as a <- print(readinteger()) is entered, it is evaluated, and b <- 7 is interpreted as the input to readline. A solution is to wrap your code in a function or a block:
{
a <- print(readinteger())
b <- 7
}
By putting everything into a block, the whole block is read as code and only after, as it is evaluated, you will be prompted for an integer.
put multiple outputs if processed by your function or the print function into "ONE object"
you name it: myOput <- list(abandoned.b,that.c)
print(myoutput)
Related
Lets say I want to ask the user for an input, a number over 10. If not, print a message and re-prompt/ask again. How can this be achieved in R?
I understand that this could be solved with IF or WHILE statement, but I can´t wrap my head around this.
Example
math <- function(number_1) {
number_1 <- readline("Enter your number: ")
if the number is below i want to reprompt readline(...)
result <- number_1 / 2
return(result)
}
Here's a way:
math <- function() {
result <- NA
while (is.na(result) || result < 10) {
text <- readline("Enter your number: ")
result <- as.numeric(text)
}
result
}
You don't need to give any input to your function; it will get the input when it prompts the user. The is.na(result) code checks for an NA: initially the result is NA, so it will run the loop at least once, and if
the user enters something that isn't a number, you'll get another one.
Since readline() returns a character value, you need as.numeric to convert it to a number.
I stacked with trying to pass variable through few functions, and on the final function I want to get the name of the original variable. But it seems like substitute function in R looked only in "local" environment, or just for one level up. Well, let me explain it by code:
fun1 <- function (some_variable) {deparse(substitute(some_variable)}
fun2 <- function (var_pass) { fun1 (var_pass) }
my_var <- c(1,2) # I want to get 'my_var' in the end
fun2 (my_var) # > "var_pass"
Well, it seems like we printing the name of variable that only pass to the fun1. Documentation of the substitute tells us, that we can use env argument, to specify where we can look. But by passing .Global or .BaseNamespaceEnv as an argument to substitute I got even more strange results - "some_variable"
I believe that answer is in this function with using env argument, so, could you please explain me how it works and how can I get what I need. Thanks in advance!
I suggest you consider passing optional name value to these functions. I say this because it seems like you really want to use the name as a label for something in the end result; so it's not really the variable itself that matters so much as its name. You could do
fun1 <- function (some_variable, name=deparse(substitute(some_variable))) {
name
}
fun2 <- function (var_pass, name=deparse(substitute(var_pass))) {
fun1 (var_pass, name)
}
my_var <- c(1,2)
fun2(my_var)
# [1] "my_var"
fun1(my_var)
# [1] "my_var"
This way if you end up having some odd variable name and what to give a better name to a result, you at least have the option. And by default it should do what you want without having to require the name parameter.
One hack, probably not the best way:
fun2 <- function (var_pass) { fun1 (deparse(substitute(var_pass))) }
fun1 <- function (some_variable) {(some_variable))}
fun2(my_var)
# "my_var"
And you could run get on that. But as Paul H, suggests, there are better ways to track variables.
Another approach I'd like to suggest is to use rlang::enexpr.
The main advantage is that we don't need to carry the original variable name in a parameter. The downside is that we have to deal with expressions which are slightly trickier to use.
> fun1 <- function (some_variable) {
message("Entering fun1")
rlang::enexpr(some_variable)
}
> fun2 <- function (var_pass) {
message("Entering fun2")
eval(parse(text=paste0("fun1(", rlang::enexpr(var_pass), ")")))
}
> my_var <- c(1, 2)
> fun1(my_var)
#Entering fun1
my_var
> fun2(my_var)
#Entering fun2
#Entering fun1
my_var
The trick here is that we have to evaluate the argument name in fun2 and build the call to fun1 as a character. If we were to simply call fun1 with enexpr(var_pass), we would loose the notion of fun2's variable name, because enexpr(var_pass) would never be evaluated in fun2:
> bad_fun2 <- function (var_pass) {
message("Entering bad fun2")
fun1(rlang::enexpr(var_pass))
}
> bad_fun2(my_var)
#Entering bad fun2
#Entering fun1
rlang::enexpr(var_pass)
On top of that, note that neither fun1 nor fun2 return variable names as character vectors. The returned object is of class name (and can of course be coerced to character).
The bright side is that you can use eval directly on it.
> ret <- fun2(my_var)
#Entering fun2
#Entering fun1
> as.character(ret)
[1] "my_var"
> class(ret)
[1] "name"
> eval(ret)
[1] 1 2
I'm looking for the functions get_output_content or at least get_output_length below, that would tell me how many characters were printed in the console.
test <- function(){
cat("ab")
cat("\b")
cat("cd")
c <- get_output_content() # "acd" (I'd be happy with "ab\bcd" as well)
l <- get_output_length() # 3
return(list(c,l))
}
test()
In this example obviously I could easily count the characters in the input, but If I'm using other functions I may not. Can you help me build one or both of these functions ?
EDIT to clarify:
in my real situation, I cannot work upstream and count before, like in the proposed solutions, I need to count the displayed output at a given time without monitoring what's before.
here's a reproducible example looking more like what I want to achieve
library(pbapply)
my_files <- paste0(1000:1,".pdf")
work_on_pdf <- function(pdf_file){
Sys.sleep(0.001)
}
report <- pbsapply(my_files,work_on_pdf) # the simple version, but I want to add the pdf name next to the bar to have more info about my progress
# so I tried this but it's not satisfying because it "eats" some of the current output of pbapply
report <- pbsapply(my_files,function(x){
buffer_length <- 25
work_on_pdf(x)
catmsg <- paste0(c( # my additional message, which is in 3 parts:
rep("\b",buffer_length), # (1) eat 25 characters
x, # (2) print filename
rep(" ",buffer_length-nchar(x))), # (3) print spaces to cover up what may have been printed before
collapse="")
cat(catmsg)
})
if I was able to count what's in the console I could easily tweak my function to get something satisfying.
NEW EDIT : FYI solution to example but not to general question:
I could solve my precise issue with this, though it doesn't solve the general question, which is measuring the current output of the console when you don't have any other info.
library(pbapply)
my_files <- paste0(1000:1,".pdf")
work_on_pdf <- function(pdf_file){
Sys.sleep(0.01)
}
pbsapply2 <- function(X,FUN,FUN2){
# FUN2 will give the additional message
pbsapply(X,function(x){
msg <- FUN2(x)
cat(msg)
output <- FUN(x)
eraser <- paste0(c(
rep("\b",nchar(msg)), # go back to position before additional message
rep(" ",nchar(msg)), # cover with blank spaces
rep("\b",nchar(msg))), # go back again to initial position
collapse="")
cat(eraser)
return(output)
})
}
report <- pbsapply2(my_files,work_on_pdf,function(x) paste("filename:",x))
Something like this (?):
test <- function(){
c <- paste0(capture.output(cat("ab")),
capture.output(cat("\b")),
capture.output(cat("cd")))
n <- nchar(c)
l <- length(c)
return(list(c,n,l))
}
test()
I have below function. I cannot alter the function in any way except the first block of code in the function.
In this simple example I want to display apply some function on returning object.
The point is the name of variable returned by function may vary and I'm not able to guess it.
Obviously I also cannot wrap the f function into { x <- f(); myfun(x); x }.
The below .Last.value in my on.exit call represents the value to be returned by f function.
f <- function(param){
# the only code I know - start
on.exit(if("character" %in% class(.Last.value)) message(print(.Last.value)) else message(class(.Last.value)))
# the only code I know - end
# real processing of f()
a <- "aaa"
"somethiiiing"
if(param==1L) return(a)
b <- 5L
"somethiiiing"
if(param==2L) return(b)
"somethiiiing"
return(32)
}
f(1L)
# function
# [1] "aaa"
f(2L)
# aaa
# [1] 5
f(3L)
# integer
# [1] 32
Above code with .Last.value seems to be working with lag (so in fact not working) and also the .Last.value is probably not the way to go as I want to use the value few times like if(fun0(x)) fun1(x) else fun2(x), and because returned value might be a big object, copy it on the side is also bad approach.
Any way to use on.exit or any other function which can help me to run my function on the f function results without knowing result variable name?
In a similar way to how you are modifying the function, you could easily wrap it as well. Here's a reproducible example.
library(data.table)
append.log<-function(x) {
cat(paste("value:",x,"\n"))
}
idx.dt <- data.table:::`[.data.table`
environment(idx.dt)<-asNamespace("data.table")
idx.wrap <- function(...) {
x<-do.call(idx.dt, as.list(substitute(...())), envir=parent.frame())
append.log(if(is(x, "data.table")) {
nrow(x)
} else { NA })
x
}
environment(idx.wrap)<-asNamespace("data.table")
(unlockBinding)("[.data.table",asNamespace("data.table"))
assign("[.data.table",idx.wrap,envir=asNamespace("data.table"),inherits=FALSE)
dt<-data.table(a=1:10, b=seq(2, 20, by=2), c=letters[1:10])
dt[a%%2==0]
Since R 3.2.0 it is fully possible, thanks to new function returnValue.
Working example below.
f <- function(x, err = FALSE){
pt <- proc.time()[[3L]]
on.exit(message(paste("proc.time:",round(proc.time()[[3L]]-pt,4),"\nnrow:",as.integer(nrow(returnValue()))[1L])))
Sys.sleep(0.001)
if(err) stop("some error")
return(x)
}
dt <- data.frame(a = 1:5, b = letters[1:5])
f(dt)
f(dt, err=T)
f(dt)
f(dt[dt$a %in% 2:3 & dt$b %in% c("c","d"),])
Is it possible to add an on.exit expr to the parent call? If so, how?
For example, say that parentOnExit(expr) is a function implementing this. Then for the following code:
f <- function() {
parentOnExit(print("B"))
print("A")
}
I want to see "A" printed, then "B".
Background: What brought this to mind was the following... we have a collection of functions, some of which call others, which require a resource that should be shared from the topmost call down and which also should be closed upon exiting the topmost function. Eg, a connection to a remote server which is expensive to open. One pattern for this is:
foo <- function(r=NULL) {
if (is.null(r)) { # If we weren't passed open connection, open one
r <- openR()
on.exit(close(r))
}
bar(r=r) # Pass the open connection down
}
I was hoping to abstract those three lines down to:
r <- openIfNull(r) # Magically call on.exit(close(r)) in scope of caller
Now that I think about it though, perhaps it's worth some repeated code to avoid anything too magical. But still I'm curious about the answer to my original question. Thank you!
I have seen in this recent mail discussion (https://stat.ethz.ch/pipermail/r-devel/2013-November/067874.html) that you can use do.call for this:
f <- function() { do.call("on.exit", list(quote(cat('ONEXIT!\n'))), envir = parent.frame()); 42 }
g <- function() { x <- f(); cat('Not yet!\n'); x }
g()
#Not yet!
#ONEXIT!
#[1] 42
Using this feature and an additional ugly trick to pass the R connection object to the caller environment, it seems to solve the problem:
openR <- function(id = "connection1") {
message('openR():', id)
list(id)
}
closeR <- function(r) {
message('closeR():', r[[1]])
}
openRIfNull <- function(r) {
if (length(r)) return(r)
# create the connection
r <- openR("openRIfNull")
# save it in the parent call environment
parent_env <- parent.frame()
assign("..openRIfNull_r_connection..", r, envir = parent_env)
do.call("on.exit", list(quote(closeR(..openRIfNull_r_connection..))), envir = parent_env)
r
}
foo <- function(r = NULL) {
message('entered foo()')
r <- openRIfNull(r)
bar(r = r) # Pass the open connection down
message('exited foo()')
}
bar <- function(r) {
message('bar()')
}
example use:
foo()
# entered foo()
# openR():openRIfNull
# bar()
# exited foo()
# closeR():openRIfNull
foo(openR('before'))
# entered foo()
# openR():before
# bar()
# exited foo()
I was intrigued by the problem and tried a couple of ways to solve it. Unfortunately, they didn't work. I'm therefore inclined to believe that it can't be done. ...But someone else might be able to prove me wrong!
Anyway, I though I'd post my failed attempts so that they are recorded. I made them so that they would print "ONEXIT!" after "Not yet!" if they worked...
1 - First, simply try to evaluate the on.exit in the parent environment:
f <- function() { eval(on.exit(cat('ONEXIT!\n')), parent.frame()); 42 }
g <- function() { x<-f(); cat('Not yet!\n'); x }
g() # Nope, doesn't work!
This doesn't work, probably because the on.exit function adds stuff to the current stack frame, not the current environment.
2 - Step up the game and try to return an expression that is evaluated by the caller:
f <- function() { quote( {on.exit(cat('ONEXIT!\n')); 42}) }
g <- function() { x<-eval(f()); cat('Not yet!\n'); x }
g() # Nope, doesn't work!
This doesn't work either, probably because eval has its own stack frame, different from g.
3 - Bring my A-game, and try to rely on lazy evaluation:
h <- function(x) sys.frame(sys.nframe())
f <- function() { h({cat('Registering\n');on.exit(cat("ONEXIT!\n"));42}) }
g <- function() { x<-f()$x; cat('Not yet!\n'); x }
g() # Worse, "ONEXIT!" is never printed...
This one returns an environment to the caller, and when the caller accesses "x" in it, the expression including on.exit is evaluated. ...But it seems on.exit does not register at all in this case.
4 - Hmm. There is one way that might still work: a .Call to some C code that calls on.exit. It might be that calling C won't add another stack frame... This is a bit too complex for me to test now, but maybe some RAPI/RCpp guru could give it a shot?
I remain confused, but if Tommy can't do it, I suspect I won't be able to either. This does the first task and since it seemed so simple I thought I must be missing something:
f <- function() {
on.exit(print("B"))
print("A")
}
Second effort:
txtB <- textConnection("test b")
txt <-textConnection("test A")
f <- function(con) { df <- read.table(con);
if( isOpen(txtB)){ print("B open")
eval( close(txtB), env=.GlobalEnv ) }
return(df) }
txtB #just to make sure it's still open
# description class mode text
# "\"test b\"" "textConnection" "r" "text"
# opened can read can write
# "opened" "yes" "no"
dat <- f(txt); dat
#[1] "B open"
# V1 V2
#1 test A
txtB
#Error in summary.connection(x) : invalid connection
(OK, I edited it to close a connection within the calling environment.)
So what am I missing? (It wasn't clear to me as I tested this that connections actually have environments.)
Though this question is quite old, there is a simple fix for any future visitors:
Use add=TRUE (I don't find the documentation very clear.)
f <- function() {
on.exit(expr = print("B"),
add = TRUE)
print("A")
}
A another solution is using withr::defer() which has more options and better documentation.
The vignette is especially helpful.