So far I have created a function that can change its behaiviour depending on whether it receives a number or a character as input, a minumal example could be the following:
...
f <- function(x)
UseMethod("g")
f.numeric <- function(x)
return(x^2)
f.character <- function(x)
return("Hey, dude. WTF are you doing? Don't give me characters!")
...
Now assume that I want f to be able to receive two numbers as input and return its sum, without losing the previous functionality. How can I achieve that?.
Could rewrite the function to do the checks yourself? e.g...
f <- function(x, y=NA){
if (all(is.numeric(c(x,y))) & !is.na(y)){
return(x+y)
}else if(is.numeric(x)){
return(x^2)
}else if(is.character(x)){
return("Hey, dude. WTF are you doing? Don't give me characters!")
}else{
return("Hey, dude. I don't know what you are giving me?!")
}
}
With ellipsis this is easily possible:
f <- function(x,...)
{
if(missing(...))
{
if(is.numeric(x)) return(x^2)
if(is.character(x)) return("Hey, dude. WTF are you doing? Don't give me characters!")
}else
{
if(any(is.character(c(x,...))) return("Hey, dude. WTF are you doing? Don't give me characters!"))
return(x+..1)
}
}
> f("foo")
[1] "Hey, dude. WTF are you doing? Don't give me characters!"
> f(4)
[1] 16
> f(4,5)
[1] 9
Not sure if this is what you need, but maybe it helps :)
sum_them <- function(var1, var2, na.rm = F)
{
if(all(is.numeric(c(var1, var2)))) return(sum(c(var1, var2), na.rm = na.rm))
return("non numeric argument")
}
sum_them("test", "this")
sum_them("test", 10)
sum_them(5, "this")
sum_them(5, 10)
sum_them(NA, 10)
sum_them(NA, 10, na.rm = T)
Output
> sum_them("test", "this")
[1] "non numeric argument"
> sum_them("test", 10)
[1] "non numeric argument"
> sum_them(5, "this")
[1] "non numeric argument"
> sum_them(5, 10)
[1] 15
> sum_them(NA, 10)
[1] NA
> sum_them(NA, 10, na.rm = T)
[1] 10
Updated function, since i didn't get the do something different if it is just 1 number.
Logic behind:
if there is just 1 paramter (var1) do whatever you like whit it, but trycatch in case it is a no nummeric.
If all param are numeric, sum them up.
else return some string.
sum_them <- function(var1, ..., na.rm = F)
{
if(missing(...)) tryCatch({var1 <- var1^2}, warning = function(w){}, error = function(e){})
if(all(is.numeric(c(var1, ...)))) return(sum(c(var1, ...), na.rm = na.rm))
return("non numeric argument")
}
new output:
> sum_them("test", "this")
[1] "non numeric argument"
> sum_them("test", 10)
[1] "non numeric argument"
> sum_them(5, "this")
[1] "non numeric argument"
> sum_them(5, 10)
[1] 15
> sum_them(NA, 10)
[1] NA
> sum_them(NA, 10, na.rm = T)
[1] 10
> sum_them(NA, na.rm = T)
[1] 0
> sum_them(10, na.rm = T)
[1] 100
> sum_them(10)
[1] 100
> sum_them("test")
[1] "non numeric argument"
> sum_them(10,10,10,10, NA)
[1] NA
> sum_them(10,10,10,10, NA, na.rm = T)
[1] 40
> sum_them(10,10,10,test, NA, na.rm = T)
[1] "non numeric argument"
If what you're looking for is something like C's method signatures[1], then no, I'm not aware that R has anything of that nature.
The closest I'm aware of in R is that you have a "super-function" that accepts all of the arguments and then a set of sub-functions to which the super-function distributes. For example, consider (what I've outlined below isn't functionally different than Julian_Hn's answer. The difference between using ellipses and explicitly naming the arguments is the amount of control over what they user can pass to the function. If you use ellipses, your test for the existence of the argument will look different)
super_function <- function(x = NULL, y = NULL){
if (!is.null(x) & is.null(y)){
if (is.character(x)){
sub_function_xchar(x)
} else if {
(is.numeric(x)){
sub_function_xnum(x)
}
} else {
sub_function_xelse(x)
}
} else {
if (!is.null(x) & !is.null(y)){
if (is.character(x) & is.character(y)){
sub_function_xychar(x, y)
} else {
# Okay, I think you might get the point now
}
}
}
}
sub_function_xchar <- function(x){
# whatever you want to do with x as a character
}
sub_function_xnum <- function(x){
# whatever you want to do with x as a numeric
}
sub_function_xelse <- function(x){
# whatever you want to do with any other class of x
}
sub_function_xychar <- function(x, y){
# whatever you want to do with x and y as characters
}
Yes, it's messy. I've used approaches like this with success for small sets of arguments. I don't know that I'd recommend it for large sets of arguments. Instead, if you have a lot of arguments, I'd recommend finding ways to break whatever task you're intending into smaller chunks that can each be isolated to their own functions.
[1] Not sure if I got the term right, but the functionality in C that many methods may have the same name, but they must be unique on the collection and type of arguments they accept.
If you want to keep using S3 you could use ...length() (>= R 3.4.2) :
f <- function(...)
UseMethod("f")
f.numeric <- function(...)
if(...length() == 1) ..1^2 else sum(...)
f.character <- function(...)
return("Hey, dude. WTF are you doing? Don't give me characters!")
f(2)
#[1] 4
f(3,4)
# [1] 7
Related
Let's say I have a function like the following that only shows a message.
foo <- function(x) {
if (x < 0) message("entered number is negative")
}
Now I want to do something depending on whether the message was shown or not. To this end, I can use capture.output, which will capture the message.
But the problem is that the first message will no longer be shown to the user:
foo(-5)
#> entered number is negative
foo_new <- function(x) {
if (x < 0) m <- capture.output(message(cat("entered number is negative")))
if (length(m) > 0) return("think of a positive number")
}
foo_new(-2)
#>
#> [1] "think of a positive number"
Is there alternative to capture.output which capture the message and also prints it simultaneously?
P.S. This is just a minimal example demonstrating the problem.
You could also use the tee-operator %T>% from the magrittr library:
library(magrittr)
foo_new <- function(x) {
if (x < 0) m <- "entered number is negative" %T>% print()
if (length(m) > 0) return("think of a positive number")
}
foo_new(-2)
[1] "entered number is negative"
[1] "think of a positive number"
Here is more information on the tee-operator and how it works.
Given the code in the question this example is too complicated but the point it tries to make is the following:
If instead of giving a message, the message is first assigned to a variable then that variable can be returned to caller. This has the advantage of making it possible to create a message depending on the exact conditions it came to be needed.
foo <- function(x) {
xname <- deparse(substitute(x))
if(is.numeric(x)){
if(x < 0){
msg <- paste("entered number", sQuote(xname), "is negative")
message(msg)
msg
} else {
2*x
}
} else {
msg <- paste("Wrong class:", sQuote(xname), "is not numeric")
message(msg)
msg
}
}
x <- 1
y <- -2
z <- "1"
foo(x)
#[1] 2
foo(y)
#entered number ‘y’ is negative
#[1] "entered number ‘y’ is negative"
foo(z)
#Wrong class: ‘z’ is not numeric
#[1] "Wrong class: ‘z’ is not numeric"
I have to check if a value in two columns or lists has the same class. I wrote the following codes but none are working because just write the last value on the list but not only the first values.
My lists
x <- c(1,3,6,2) ## All are numeric
y <- c(6,4,3,'a') ## Note that is a string at here
m <- NULL
Code 1
for (i in length(x)) {
if (class(x[i]) == class(y[i])) m[i] <-'ok' else m[i] <- 'no ok'
}
Code 2
et <-function(x, y){
for (i in length(x)) {
if (class(x[i]) == class(y[i])) {
m[i] = 'ok'
} else {
m[i] = 'not ok'
}
return(f)
}
}
et(x,y)
Thanks for helping.
Your problem is in the for loop call, which is only passing one integer to run, rather than a list of integers, like you're hoping. Change this:
for (i in length(x)) { ...
to this:
for (i in 1:length(x)) { ...
Notice that "length(x)" is 4, whereas "1:length(x)" is all integers 1:4.
If you want to check the class of corresponding elements in two lists, you can use Map function:
x <- list(1,3,6,2)
y <- list(6,4,3,'a')
Map(function(x,y) c("no ok", "ok")[as.integer(class(x) == class(y)) + 1], x, y)
[[1]]
[1] "ok"
[[2]]
[1] "ok"
[[3]]
[1] "ok"
[[4]]
[1] "no ok"
Or mapply which returns a vector:
mapply(function(x,y) c("no ok", "ok")[as.integer(class(x) == class(y)) + 1], x, y)
[1] "ok" "ok" "ok" "no ok"
We can also loop through using lapply/sapply and get a logical output
sapply(seq_along(x), function(i) class(x[[i]])==class(y[[i]]))
data
x <- list(1,3,6,2)
y <- list(6,4,3,'a')
Description of stopifnot from R Documentation
Description
If any of the expressions in ... are not all TRUE, stop is called,
producing an error message indicating the first of the elements of ...
which were not true.
Usage
stopifnot(...)
Arguments
... any number of (logical) R expressions, which should evaluate to
TRUE.
Sometimes the expressions in ... dont evaluate to TRUE. Consider the error message for the the below scenario
a <- 1:10
stopifnot(
class(a) %in% c("numeric", "integer"),
sum(a) >= 100
)
> Error: sum(a) >= 100 is not TRUE
which is fine. But, the error message for the the below scenario is not what I expect
a <- letters
stopifnot(
class(a) %in% c("numeric", "integer"),
sum(a) >= 100
)
> Error in sum(a) : invalid 'type' (character) of argument
I expect it to say
Error: class(a) %in% c("numeric", "integer") is not TRUE
But, it doesnt.
Are my expectations correct? Is that how stopifnot() is supposed to work? And how can I make stopifnot() work like that?
stopifnot evaluates each of your supplied expressions, and then checks that all of them are TRUE. If this isn't the case, it halts and prints an error message, saying which of the expressions failed.
In your example, what's happening is that the expressions themselves are triggering an error. It's the evaluation of the expression sum(a) >= 100 that results in the error message, not stopifnot itself.
I cant answer about how stopifnot() is supposed to work. But, here is how to achieve what is expected
Consider using the hadley's assertthat package. It works as expected
a <- letters
assertthat::assert_that(
class(a) %in% c("numeric", "integer"),
sum(a) >= 100
)
> Error: `%in%`(x = class(a), table = c("numeric", "integer")) is not TRUE
It also gives more useful error messages. The above error message is not a really good example of that. Consider the below scenario
a <- 1:10
assert_that(
class(a) %in% c("numeric", "integer"),
sum(a) >= 100
)
> Error: sum(a) not greater than or equal to 100
Also, here's how stopifnot() can be made to work like that. So, now for the same scenario
stopifnot <- function (...) {
ll <- lazyeval::lazy_dots(...)
n <- length(ll)
if (n == 0L) {
return(invisible())
}
mc <- match.call()
for (i in 1L:n) {
if (!(is.logical(r <- lazyeval::lazy_eval(ll[[i]])) && !anyNA(r) && all(r))) {
ch <- deparse(mc[[i + 1]], width.cutoff = 60L)
if (length(ch) > 1L) {
ch <- paste(ch[1L], "....")
}
stop(sprintf(ngettext(length(r), "%s is not TRUE", "%s are not all TRUE"), ch), call. = FALSE, domain = NA)
}
}
invisible()
}
a <- letters
stopifnot(
class(a) %in% c("numeric", "integer"),
sum(a) >= 100
)
> Error: class(a) %in% c("numeric", "integer") is not TRUE
I am trying to write a function which would take as argument a function call, evaluates numeric args of this function call and then return corresponding character vector. This is what I have came up with:
ConvertToCharacter <- function(function.call) {
call.str <- deparse(substitute(function.call))
return(call.str)
}
> a <- 1
> ConvertToCharacter(sum(2, a))
"sum(2, a)"
> ConvertToCharacter(ddply(mtcars, .(vs), summarize, col=mean(cyl)))
"ddply(mtcars, .(vs), summarize, col = mean(cyl))"
Now, I want the numeric args to be evaluated before getting converted into a character vector. So that ConvertToCharacter(sum(2, a)) would return "sum(2, 1)" instead. I tried passing env=parent.frame() to subsitute but it won't work. Any idea how I could go with this?
Thanks!
You need to recursively inspect your call, evaluate the symbols, and sub in the values for the numeric ones like so:
ConvertToCharacter <- function(function.call, env=parent.frame()) {
call <- substitute(function.call)
convert_recurse <- function(x, env) {
if(is.call(x)) {
return(as.call(lapply(x, match.fun(sys.call()[[1]]), env=env)))
} else if (
is.symbol(x) &&
is.numeric(try(val <- eval(x, env), silent=TRUE))
) {
return(val)
} else {
return(x)
}
}
deparse(convert_recurse(call, env))
}
a <- 1
ConvertToCharacter(sum(2, a))
lbsToKgs <- 2.2
ConvertToCharacter(ddply(mtcars, .(vs), summarize, col=mean(cyl), wtkg=mean(wt * lbsToKgs)))
And this is what you get:
# [1] "sum(2, 1)"
# [1] "ddply(mtcars, .(vs), summarize, col = mean(cyl), wtkg = mean(wt * "
# [2] " 2.2))"
Also, credit to Robert for the workaround the apply/Recall issue.
ConvertToCharacter <- function(function.call) {
library(stringr)
str_replace(deparse(substitute(function.call)),"a",eval(a,envir=.GlobalEnv))
}
I hope it helps
I expect this code to set plt equal to 10:
> var = "plt"
> eval(paste0(var, "<-", 10))
[1] "plt<-10"
But instead, it returns a string.
I tried eval(as.expression(paste0(var, "<-", 10))) and other options, but it still doesn't give the expected result.
What's wrong with the code?
If I understand your comment correctly there is no reason to dive into the shark-infested waters of eval(parse()). Try something like this instead:
myfun <- function(x, fun) {
if (is.character(fun)) fun <- match.fun(fun)
fun(x)
}
myfun(1:5, mean)
#[1] 3
myfun(1:5, "mean")
#[1] 3
See: ?parse. Your demo code:
> var = "plt"
> eval(parse(text = paste0(var, "<-", 10)))
> plt
[1] 10
Update: based on #Anton's comment about the original goal - what about:
> f <- function(type, ...) {
+ assign('plt', do.call(deparse(substitute(type)), list(...)), envir = .GlobalEnv)
+ }
> f(mean, x = 1:20)
> plt
[1] 10.5
PS: I still trying to implement what the OP is after, not what he might or should be after -- that's why I used above assign and .GlobalEnv, although it's not a great idea BTW.