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)
}
Related
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)
I've created the following loop but would like to write it as a lapply function.
Is this possible? I'm trying to get my head around apply functions but haven't quite got the hang of it yet.
Decay <- function(x, decay=y) stats::filter(x, decay, method = "recursive")
d<-iris[,c("Sepal.Length","Sepal.Width","Petal.Length","Petal.Width")]
DecayX <- c(0.1,0.3,0.6,0.8,0.95)
DecVars = c("Sepal.Length","Petal.Width")
for (j in DecVars){
for (i in DecayX){
VarName <- paste(colnames(d[j]),i*100,"DEC",sep="_")
d[[VarName]]<-Decay(d[j],i)
}
}
I don't see any reason to use the apply family here.
You could use mapply
vars <- c(expand.grid(DecayX,DecVars,stringsAsFactors = F))
invisible(
mapply(function(x,DecV){VarName <- paste(colnames(d[DecV]),x*100,"DEC",sep="_");
d[[VarName]]<<-Decay(d[DecV],x)},x=vars[[1]],DecV=vars[[2]])
)
I think in cases of a double loop I would not use the apply family.
Another way would be to replace each for loop with an sapply() which is faster than for loops and doesn't require the use of expand.grid().
invisible(
sapply(DecVars, function(j) {
sapply(DecayX, function(i) {
VarName <- paste(colnames(d[j]),i*100,"DEC",sep="_")
d[[VarName]] <<- Decay(d[j],i)
})
})
)
You can see that this is a lot faster than using for loops and also marginally faster than the use of mapply() with grid.expand():
library(microbenchmark)
microbenchmark(
'mapply' = {
vars <- c(expand.grid(DecayX,DecVars,stringsAsFactors = F))
invisible(
mapply(function(x,DecV){VarName <- paste(colnames(d[DecV]),x*100,"DEC",sep="_");
d[[VarName]]<<-Decay(d[DecV],x)},x=vars[[1]],DecV=vars[[2]])
)},
'sapply' = {
invisible(
sapply(DecVars, function(j) {
sapply(DecayX, function(i) {
VarName <- paste(colnames(d1[j]),i*100,"DEC",sep="_")
d1[[VarName]] <<- Decay(d1[j],i)
})
})
)
},
'for-loop' = {
for (j in DecVars){
for (i in DecayX){
VarName <- paste(colnames(d[j]),i*100,"DEC",sep="_")
d[[VarName]]<-Decay(d[j],i)
}
}
},
times = 1000)
Note: if you ignore the expand.grid() step, mapply() would be marginally faster.
What type of object is passed to myFunc as x? It doesn't seem to be an expression, nor a function and str just evaluates it. I understand that I can use force() to evaluate. I'm wondering if there's some way to gather more information about x without evaluating it.
myFunc = function( x )
{
is.expression( x )
is.function( x )
str( x )
}
myFunc( { x = 5; print( x + 1 ) } )
You can use match.call for extracting the arguments:
myFunc <- function( x ) {
x <- match.call()$x
print(class(x))
print(typeof(x))
print(mode(x))
print(storage.mode(x))
print(is.expression(x))
print(is.call(x))
if (is.call(x)) print(x[[1]])
}
myFunc({x = 5; print("a")})
myFunc(expression(x))
x <- factor(1)
myFunc(x)
myFunc(1)
Probably I need to say that { is a function in R, so {...} is no more than call.
Updated: why x is not function while { is function:
f <- function(x) {
x <- match.call()$x
print(eval(x[[1]]))
print(is.function(eval(x[[1]])))
}
f({1})
I think class would do the trick... See docs.
EDIT: According to the docs,
for {, the result of the last expression evaluated
Which means the class is the class resulting from the evaluation, which is why it not showing up as an "expression". It is being passed after evaluation.
Dason just posted a similar response to this on Talkstats.com for determining if an object is a data frame or a list (click here for a link to that post). I just extended it to an expression which I think suits your needs.
j.list <- function(list, by = NULL){
print("list")
print(list)
}
j.data.frame <- function(df, ..., by = NULL){
print("data frame")
print(df)
}
j.expression <- function(expression, by = NULL){
print("expression")
print(expression)
}
j <- function(x, ...){
UseMethod("j")
}
j(list(test = "this is a list"))
j(data.frame(test = 1:10))
j(expression(1+ 0:9))
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
I have a function like this dummy-one:
FUN <- function(x, parameter){
if (parameter == 1){
z <- DO SOMETHING WITH "x"}
if (parameter ==2){
z <- DO OTHER STUFF WITH "x"}
return(z)
}
Now, I would like to use the function on a dataset using apply.
The problem is, that apply(data,1,FUN(parameter=1))
wont work, as FUN doesn't know what "x" is.
Is there a way to tell apply to call FUN with "x" as the current row/col?
`
You want apply(data,1,FUN,parameter=1). Note the ... in the function definition:
> args(apply)
function (X, MARGIN, FUN, ...)
NULL
and the corresponding entry in the documentation:
...: optional arguments to ‘FUN’.
You can make an anonymous function within the call to apply so that FUN will know what "x" is:
apply(data, 1, function(x) FUN(x, parameter = 1))
See ?apply for examples at the bottom that use this method.
Here's a practical example of passing arguments using the ... object and *apply. It's slick, and this seemed like an easy example to explain the use. An important point to remember is when you define an argument as ... all calls to that function must have named arguments. (so R understands what you're trying to put where). For example, I could have called times <- fperform(longfunction, 10, noise = 5000) but leaving off noise = would have given me an error because it's being passed through ... My personal style is to name all of the arguments if a ... is used just to be safe.
You can see that the argument noise is being defined in the call to fperform(FUN = longfunction, ntimes = 10, noise = 5000) but isn't being used for another 2 levels with the call to diff <- rbind(c(x, runtime(FUN, ...))) and ultimately fun <- FUN(...)
# Made this to take up time
longfunction <- function(noise = 2500, ...) {
lapply(seq(noise), function(x) {
z <- noise * runif(x)
})
}
# Takes a function and clocks the runtime
runtime <- function(FUN, display = TRUE, ...) {
before <- Sys.time()
fun <- FUN(...)
after <- Sys.time()
if (isTRUE(display)) {
print(after-before)
}
else {
after-before
}
}
# Vectorizes runtime() to allow for multiple tests
fperform <- function(FUN, ntimes = 10, ...) {
out <- sapply(seq(ntimes), function(x) {
diff <- rbind(c(x, runtime(FUN, ...)))
})
}
times <- fperform(FUN = longfunction, ntimes = 10, noise = 5000)
avgtime <- mean(times[2,])
print(paste("Average Time difference of ", avgtime, " secs", sep=""))