How can I write into a function a way to detect if the output is being assigned (<-) to something? The reasoning is I'd like to print a message if it is not being assigned and just goes to the console but if it is being assigned I'd like it not to print the message.
Here's a dummy example and how I'd like it to behave:
fun <- function(x) {
if (being_assigned) {
print("message")
}
return(x)
}
#no assignment so message prints
> fun(6)
[1] "message"
[1] 6
#assignment so message does not prints
> x <- fun(6)
The being_assigned in the function is the imaginary unknown condition I'd like to detect but don't know how.
I think the best you can do is to define a special print method for objects returned by the function:
## Have your function prepend "myClass" to the class of the objects it returns
fun <- function(x) {
class(x) <- c("myClass", class(x))
x
}
## Define a print method for "myClass". It will be dispatched to
## by the last step of the command line parse-eval-print cycle.
print.myClass <- function(obj) {
cat("message\n")
NextMethod(obj)
}
> fun(1:10)
message
[1] 1 2 3 4 5 6 7 8 9 10
attr(,"class")
[1] "myClass"
>
> out <- fun(1:10)
>
I love Josh's idea but for future posters wanted to show what I did which is a slightly modified version of his approach. His approach prints out the class information which is the only thing I didn't like. He used the NextMethod to avoid the infinite recursion printing. This causes the
attr(,"class")
[1] "myClass"
to be printed. So to avoid this I print the message first and then print 1 through the length of the class object (using indexing).
fun <- function(x) {
class(x) <- 'beep'
comment(x) <- "hello world"
return(x)
}
print.beep<- function(beep) {
cat(paste0(comment(beep), "\n"))
print(beep[1:length(beep)])
}
> fun(1:10)
hello world
[1] 1 2 3 4 5 6 7 8 9 10
Thanks again Josh for the idea.
If the reader didn't want the little [1] index to print either they could cat the output int he print statement as:
print.beep<- function(beep) {
cat(paste0(comment(beep), "\n"))
cat(beep[1:length(beep)], "\n")
}
Related
I'm having problems with applying a function to a vector of arguments. The point is, none of the arguments are vectors.
I'm trying to apply my function with the do.call command, and my attempts go like this:
do.call("bezmulti", list(dat$t, as.list(getvarnames(n, "a"))))
where bezmulti is a function that takes in a vector (dat$t) and an indefinite number of single numbers, which are provided by the function getvarnames in the form of a vector, which I need to split.
The problem is that this list doesn't work the way I want it to - the way I would want would be:
[[1]]
#vector goes here
[[2]]
#the
[[3]]
#numbers
[[4]]
#go
[[5]]
#here
however my proposed solution, and all my other solutions provide lists that are either somehow nested or have only two elements, both of which are vectors. Is there a way to force the list to be in the format above?
EDIT: Functions used in this post look as follows
bezmulti <- function(t,...) {
coeff <- list(...)
n <- length(coeff)-1
sumco <- rep(0, length(t))
for (i in c(0:n)) {
sumco=sumco+coeff[[i+1]]*choose(n, i)*(1-t)^(n-i)*t^i
}
return(sumco)
}
getvarnames <- function(n, charasd) {
vec=NULL
for (j in c(1:n)) {
vec <- append(vec, eval(str2expression(paste0(charasd, as.character(j)))))
}
return(vec)
}
I think what you need to do is this:
do.call("bezmulti", c(list(dat$t), as.list(getvarnames(n, "a"))))
For example:
dat= data.frame(t = c(1,2,3,4,6))
c(list(dat$t), as.list(c(8,10,12)))
Output:
[[1]]
[1] 1 2 3 4 6
[[2]]
[1] 8
[[3]]
[1] 10
[[4]]
[1] 12
#Create a function to print squares of numbers in sequence
squareseq <- function(a) {
for(i in 1:a) {
b <- i^2
result <- print(b)
}
return(result)
}
# Call the function supplying 6 as an argument
squareseq(6)
The result of calling the function above, is shown below:
[1] 1
[1] 4
[1] 9
[1] 16
[1] 25
[1] 36
[1] 36
How do I keep "return(result)" but remove the duplicated line: "[1] 36"? So I get this result below:
[1] 1
[1] 4
[1] 9
[1] 16
[1] 25
[1] 36
Use invisible:
squareseq <- function(a) {
for(i in 1:a) {
b <- i^2
result <- print(b)
}
invisible(result)
}
squareseq(6)
#[1] 1
#[1] 4
#[1] 9
#[1] 16
#[1] 25
#[1] 36
My answer is going to be old fashion theortical here.
Problem in your approach is first you are printing values in for loop so whenever function is called it will print as per argument(all numbers). Now when function comes out of that loop you are returning the value which will return latest value of variable named result in your case, that is the actually reason only last item is being printed 2 times(because item is already printed previously and now getting returned).
As per #Roland's comments I have edited my answer now(where it was saying do not return anything in function, seems to be not applicable with R). Since it is mandatory to return a value in R so pleaseuse #DiceboyT's nice solution using invisible.
I am implementing a replacement for the subset operator in an S3 class. I followed the advice on
How to define the subset operators for a S4 class?
However I am having a special problem. How do I distinguish in R code if someone wrote x[i] or x[i,]. In both cases, the variable j just comes back missing.
setOldClass("myclass")
'[.myclass' <- function(x, i, j, ..., drop=TRUE) {
print(missing(j))
return(invisible(NULL))
}
And as a result I get:
x <- structure(list(), class="myclass")
> x[i]
[1] TRUE
> x[i,]
[1] TRUE
> x[i,j]
[1] FALSE
I don't see a way on how to distinguish between the two. I assume the internal C code does it by looking at the length of the argument pairlist, but is there a way to do the same in native R?
Thanks!
From alexis_laz's comment:
See, perhaps, how [.data.frame handles arguments and nargs()
Inside the function call nargs() to see how many arguments were supplied, including missing ones.
> myfunc = function(i, j, ...) {
+ nargs()
+ }
>
> myfunc()
[1] 0
> myfunc(, )
[1] 2
> myfunc(, , )
[1] 3
> myfunc(1)
[1] 1
> myfunc(1, )
[1] 2
> myfunc(, 1)
[1] 2
> myfunc(1, 1)
[1] 2
This should be enough to help you figure out which arguments were passed in the same fashion as [.data.frame.
Within a function, how can we reliably return an object that contains the function itself?
For example with:
functionBuilder <- function(wordToSay) {
function(otherWordToSay) {
print(wordToSay)
print(otherWordToSay)
get(as.character(match.call()[[1]]))
}
}
I can build a function like so:
functionToRun <- functionBuilder("hello nested world")
... and run it ...
functionToRun("A")
#[1] "hello nested world"
#[1] "A"
#
#function(otherWordToSay) {
# print(wordToSay)
# print(otherWordToSay)
# get(as.character(match.call()[[1]]))
# }
#<environment: 0x1e313678>
... as you can see functionToRun returns itself. However, this approach appears to break if I call functionToRun via sapply:
> sapply(LETTERS, functionToRun)
#[1] "hello nested world"
#[1] "A"
#Error in get(as.character(match.call()[[1]])) : object 'FUN' not found
I can see that this is because the actual call when using sapply is FUN but that FUN doesn't exist at pos = -1 (the default for get). Code that works in that position looks like:
get(as.character(match.call()[[1]]),envir = sys.frame(sys.parent()))
But that same code fails if the function hasn't been called via sapply because sys.frame(sys.parent())) goes too far back and ends up referring to R_GlobalEnv.
From the documentation (R 3.2.2) I'd have expected dynGet to perhaps solve the issue of only going as far back in the stack as needed. Although this works for an sapply call of the function, it fails when the function is called on its own. (Besides, it is marked as 'somewhat experimental'). Inversely getAnywhere seems promising, but doesn't seem to work for the sapply called function.
Is there a reliable way to return the function that is currently being processed, i.e. works for both a bare and sapply wrapped function call?
What I'm doing right now is wrapping the attempt to grab the function in a tryCatch; but I'm a little uncertain whether I can trust that get(as.character(match.call()[[1]]),envir = sys.frame(sys.parent())) will work in all wrapping cases (not just sapply). So, I'm looking for a more reasonable way to approach this problem.
Potentially Related Questions:
How to access a variable stored in a function in R
How to get the name of the calling function inside the called routine?
I can't guarantee that this will work in all cases, but it looks okay:
fun <- function(x) {
print(x)
y <- exp(x)
print(y)
sys.function(0)
}
fun(1)
# [1] 1
# [1] 2.718282
# function(x) {
# print(x)
# y <- exp(x)
# print(y)
# sys.function(0)
# }
lapply(1:5, fun)[[3]]
# [1] 1
# [1] 2.718282
# [1] 2
# [1] 7.389056
# [1] 3
# [1] 20.08554
# [1] 4
# [1] 54.59815
# [1] 5
# [1] 148.4132
# function(x) {
# print(x)
# y <- exp(x)
# print(y)
# sys.function(0)
# }
Of course, I don't understand what you need this for.
Let's say I have a vector where I've set a few attributes:
vec <- sample(50:100,1000, replace=TRUE)
attr(vec, "someattr") <- "Hello World"
When I subset the vector, the attributes are dropped. For example:
tmp.vec <- vec[which(vec > 80)]
attributes(tmp.vec) # Now NULL
Is there a way to, subset and persist attributes without having to save them to another temporary object?
Bonus: Where would one find documentation of this behaviour?
I would write a method for [ or subset() (depending on how you are subsetting) and arrange for that to preserve the attributes. That would need a "class" attribute also adding to your vector so that dispatch occurs.
vec <- 1:10
attr(vec, "someattr") <- "Hello World"
class(vec) <- "foo"
At this point, subsetting removes attributes:
> vec[1:5]
[1] 1 2 3 4 5
If we add a method [.foo we can preserve the attributes:
`[.foo` <- function(x, i, ...) {
attrs <- attributes(x)
out <- unclass(x)
out <- out[i]
attributes(out) <- attrs
out
}
Now the desired behaviour is preserved
> vec[1:5]
[1] 1 2 3 4 5
attr(,"someattr")
[1] "Hello World"
attr(,"class")
[1] "foo"
And the answer to the bonus question:
From ?"[" in the details section:
Subsetting (except by an empty index) will drop all attributes except names, dim and dimnames.
Thanks to a similar answer to my question #G. Grothendieck, you can use collapse::fsubset see here.
library(collapse)
#tmp_vec <- fsubset(vec, vec > 80)
tmp_vec <- sbt(vec, vec > 80) # Shortcut for fsubset
attributes(tmp_vec)
# $someattr
# [1] "Hello World"