Could someone please tell me how to combine wrapper function with if..else conditions? For example this wrapper:
wrapper<-function(x){
varcoef<-function(x){
sd(x)/mean(x)
}
apply(x,MARGIN = 2, FUN=varcoef)
}
wrapper(mtcars)
With:
if(is.matrix(x)==TRUE){
apply(x,2,function(x) sd(x)/mean(x))
} else if (is.data.frame(x)==TRUE){
apply(x,2,function(x) sd(x)/mean(x))
} else print(NULL)
Thank you!
Normally to handle different classes (matrix, data.frame) one creates a generic and dispatches to a method for each class as opposed to using if. This provides a modular approach in which new classes can be added without modifying the existing code -- just add a new method.
wrapper <- function(x, ...) {
varcoef <- function(x) sd(x) / mean(x)
UseMethod("wrapper")
}
wrapper.data.frame <- function(x, ...) {
is.num <- sapply(x, is.numeric)
apply(x[is.num], 2, varcoef)
}
wrapper.matrix <- function(x, ...) {
stopifnot(is.numeric(x))
apply(x, 2, varcoef)
}
# tests
wrapper(CO2)
m <- as.matrix(BOD)
wrapper(m)
If you want to use if anyways then:
wrapper <- function(x, ...) {
varcoef <- function(x) sd(x) / mean(x)
if (inherits(x, "data.frame")) {
is.num <- sapply(x, is.numeric)
apply(x[is.num], 2, varcoef)
} else {
stopifnot(is.numeric(x))
apply(x, 2, varcoef)
}
}
# tests
wrapper(CO2)
m <- as.matrix(BOD)
wrapper(m)
Related
Is there any way to use only part of a function in R?
For example:
My.function <- function(x)
{
m = mean(x)
q.1 = quantile(x, 1/4)
q.3 = quantile(x, 3/4)
rbind(m, q.1, q.3)
}
I want to use only q.1 and q.3 and not m for any reason. Is it possible? If it is, then how?
Thanks
You could use if statements in the body of the function and add booleans in the function argument. Then the function won't evaluate if statements that are false. For your case, it would be something like
My.function <- function(x,getmean = F)
{
q.1 = quantile(x, 1/4)
q.3 = quantile(x, 3/4)
if (getmean) {
m = mean(x)
return(rbind(m, q.1, q.3))
} else {
return(rbind(q.1,q.3))
}
}
#test
My.function(rnorm(100))
My.function(rnorm(100), getmean = T)
Why would you bother? If you don't want the m in your output, just write
foo <- My.function(x)[2:3,]
Note: if you are dealing with a function which contains three seriously time-consuming subfunctions, then it makes sense to do something similar to "doubled"s answer. I would recommend full flexibility:
My.function <- function(x, dolist=c(1,1,1) )
{
result <-vector('list') # to handle any sorts of results
if(dolist[1]) { result[[1]] <- first.function(x) }
if(dolist[2]) {result[[2]] <- second.function(x) }
if(dolist[3]) {result[[3]] <- third.function(x) }
return(result)
}
I am studying Advanced R from Hadley and he shows the example below:
new_secret <- function(x = double()) {
stopifnot(is.double(x))
structure(x, class = "secret")
}
print.secret <- function(x, ...) {
print(strrep("x", nchar(x)))
invisible(x)
}
that's when he tries to create a [.secret method:
`[.secret` <- function(x, i) {
new_secret(x[i])
}
Could someone explain to me why this method, when called, goes into a loop?
x <- new_secret(c(15, 1, 456))
x[1]
I want to make a special behavour for function when an argument b is NA. I don't want to do this with if so I prefer generic. This is my try:
foo <- function(x) {
UseMethod("foo", x)
}
foo.numeric <- function(x) {
print("numeric")
}
foo.default <- function(x) {
print("def")
}
foo.NA <- function(x) {
print("na")
}
now when I run foo(NA) i want to run foo.NA() but foo.default() is executed.
I have a generic function like this:
convert <- function(x) UseMethod("simplifyResultConvert")
convert.default <- function(x) {
x
}
convert.POSIXct <- function(x) {
as.character(x)
}
convert.factor <- function(x) {
as.character(x)
}
convert.Date <- function(x) {
as.character(x)
}
Is there any way to simplify it by making one generic for type: POSIXct, Date and factor?
To make it clear: I need something like:
convert.(POSIXct || factor || date) <- funciton(x) {as.character(x)}
Write it like this:
convert.default <- function(x) x
convert.Date <-
convert.factor <-
convert.POSIXct <- function(x) as.character(x)
A further simplification would be:
convert.default <- identity
convert.Date <-
convert.factor <-
convert.POSIXct <- as.character
You can put a test of the class in the default method, for example:
convert.default <- function(x) {
if (inherits(x, "POSIXct") ||
inherits(x, "factor") ||
inherits(x, "Date"))
as.character(x)
else
x
}
This is not quite the same as what you want, because an object could have class c("POSIXct", "other") and if there was a convert.other() method set, it would be called instead of the default.
If you really want the behaviour you asked for, you need the three functions, but you can save a bit of typing by using
convert.Date <- convert.factor <- convert.POSIXct <- function(x) {
as.character(x)
}
Since there are no super-classes in S3, this is not possible with S3. However, you can easily do this with S4 which allows defining super-classes:
setGeneric("convert", function(object) {
standardGeneric("convert")
})
setClassUnion("fooClasses", members = c("factor", "Date", "POSIXt")) #POSIXt is a super-class
setMethod("convert", signature(object = "fooClasses"), function(object) {
as.character(object)
})
class(convert(as.Date("2010-10-10")))
#[1] "character"
class(convert(as.POSIXct("2010-10-10")))
#[1] "character"
How do I partially bind/apply arguments to a function in R?
This is how far I got, then I realized that this approach doesn't work...
bind <- function(fun,...)
{
argNames <- names(formals(fun))
bindedArgs <- list(...)
bindedNames <- names(bindedArgs)
function(argNames[!argNames %in% bindedArgs])
{
#TODO
}
}
Thanks!
Here's a version of Curry that both preserves lazy evaluation of function argument, but constructs a function that prints moderately nicely:
Curry <- function(FUN, ...) {
args <- match.call(expand.dots = FALSE)$...
args$... <- as.name("...")
env <- new.env(parent = parent.frame())
if (is.name(FUN)) {
fname <- FUN
} else if (is.character(FUN)) {
fname <- as.name(FUN)
} else if (is.function(FUN)){
fname <- as.name("FUN")
env$FUN <- FUN
} else {
stop("FUN not function or name of function")
}
curry_call <- as.call(c(list(fname), args))
f <- eval(call("function", as.pairlist(alist(... = )), curry_call))
environment(f) <- env
f
}
It basically works by generating an anonymous function in exactly the same way you would if you were constructing the partial binding yourself.
Actually, this seems to work as a work around
bind <- function(fun,...)
{
boundArgs <- list(...)
formals(fun)[names(boundArgs)] <- boundArgs
fun
}
However, ideally I want the bound arguments to disappear completely from the new function so that calls to the new function can happen with name specification, e.g. with add <- function(a,b) a+b I would like (bind(add,a=2))(1) to return 3.
Have you tried looking at roxygen's Curry function?
> library(roxygen)
> Curry
function (FUN, ...)
{
.orig = list(...)
function(...) do.call(FUN, c(.orig, list(...)))
}
<environment: namespace:roxygen>
Example usage:
> aplusb <- function(a,b) {
+ a + 2*b
+ }
> oneplusb <- Curry(aplusb,1)
> oneplusb(2)
[1] 5
Edit:
Curry is concisely defined to accept named or unnamed arguments, but partial application of fun to arguments by way of formal() assignment requires more sophisticated matching to emulate the same functionality. For instance:
> bind <- function(fun,...)
+ {
+ argNames <- names(formals(fun))
+ boundArgs <- list(...)
+ boundNames <- names(boundArgs)
+ if(is.null(boundNames)) {
+ formals(fun)[1:length(boundArgs)] <- boundArgs
+ } else {
+ formals(fun)[match(names(boundArgs),argNames)] <- boundArgs
+ }
+ fun
+ }
> oneplusb <- bind(aplusb,1)
> oneplusb(2)
Error in 2 * b : 'b' is missing
Because the first argument in this function is still a, you need to specify which argument 2 is intended for (b=), or pass it as the second argument.
> oneplusb
function (a = 1, b)
{
a + 2 * b
}
> oneplusb(b=2) ## or oneplusb(,2)
[1] 5