I have a function in R, say
f1 <- function(x,y,vec, func0,...){
...
...
...
return(out)
}
The arguments func0 and vec in this function f1 are function object and some vector object respectively. Now I want to repeat this function 'reps' times (everything else being the same). I have stored the arguments of this function in a list as there are a lot of arguments and I keep changing them to do the replications again.
list1 <- list(x,y,vec, func0, other arguments)
Then I want to do,
f1_reps <- lapply(1:reps, f1, list1)
I get an error when I do this as the function arguments func0 and vec are not found.
Any help in this direction would be helpful. Here is a mock example of the situation.
Here is an example,
a <- function(n){
sqrt(n)
}
N = 100
out <- rep(NA,N)
# simple function with multiple arguments
foo <- function(a=a, b= c(1:3), c= 1000){
for(n in 1:N){
out[n] <- b%*%b+ a(n)*c
}
return(out)
}
candidates <- list(a=a, b = c(1:3), c=1000)
lapply(1:4, foo(a=candidates$a,b=candidates$b,c=candidates$c)) ## Doesn't work
lapply(1:4, foo, a=candidates$a, b=candidates$b, c=candidates$c) ## Doesn't work
candidates2 <- c(a=a, b = c(1:3), c=1000) # A vector of arguments
lapply(1:4, foo, a=candidates2$a, b = c(candidates2$b1,candidates2$b2,candidates2$b3), c=candidates2$c) #Doesn't work either
This uses the dots aka the ... argument:
foo2 <- function(...) {
#I just returns the identity
l <- lapply(..., I)
a <- l[[1]]
b <- l[[2]]
c <- l[[3]]
for(n in 1:N){
out[n] <- b%*%b+ a(n)*c
}
return(out)
}
candidates <- list(a=a, b = c(1:3), c=1000)
foo2(candidates)
# or to simplify. Same output as previous.
c(crossprod(1:3)) + sqrt(seq_len(100)) * 1000
[1] 1014.000 1428.214 1746.051 2014.000 2250.068 2463.490 2659.751 2842.427 3014.000 3176.278 3330.625 3478.102 3619.551 3755.657
[15] 3886.983 4014.000 4137.106 4256.641 4372.899 4486.136 4596.576 4704.416 4809.832 4912.979 5014.000 5113.020 5210.152 5305.503
[29] 5399.165 5491.226 5581.764 5670.854 5758.563 5844.952 5930.080 6014.000 6096.763 6178.414 6258.998 6338.555 6417.124 6494.741
[43] 6571.439 6647.250 6722.204 6796.330 6869.655 6942.203 7014.000 7085.068 7155.428 7225.103 7294.110 7362.469 7430.198 7497.315
[57] 7563.834 7629.773 7695.146 7759.967 7824.250 7888.008 7951.254 8014.000 8076.258 8138.038 8199.353 8260.211 8320.624 8380.600
[71] 8440.150 8499.281 8558.004 8616.325 8674.254 8731.798 8788.964 8845.761 8902.194 8958.272 9014.000 9069.385 9124.434 9179.151
[85] 9233.544 9287.618 9341.379 9394.832 9447.981 9500.833 9553.392 9605.663 9657.651 9709.360 9760.794 9811.959 9862.858 9913.495
[99] 9963.874 10014.000
The main issue is your function f1 takes an input of variables, not a list of the variables. This is one way you could approach it, with a simple eg, if I've understood correctly how your inputs are stored
# simple function with multiple arguments
foo <- function(a=1, b=2, c=3){
return(a+b+c)
}
# works
foo(a=1, b=2, c=3)
# doesn't work as not required format
foo(list(a=1, b=2, c=3))
# formatted list such that each element has 5 elements
candidates <- list(
a=1:5,
b=2:6,
c=3:7
)
# you need to apply the variables one by one with this setup
N <- 5
out <- lapply(1:N, function(i){
foo(a=candidates$a[i]
,b=candidates$b[i]
,c=candidates$c[i])
})
out
Related
I need to loop through a number of functions, and plot/print the result next to the function name. I learned (this question/answer) that I have to use substitute / eval. This works nicely if each function name per se is enclosed in substitute() (see (A) and (B) below). Is there a way to automatize this, e.g. by using a construction similar to sapply? (C) obviously fails because substitute encloses also the c() clause, but maybe there is a something that I missed to make (D) work? Or any other ideas? Or is there no way?
This is what I tried (small examples, real code has many more functions and plotting stuff).
# A
x <- c(1:10)
my.fun <- substitute(mean) # works
print(paste(deparse(my.fun), ": ", eval(my.fun)(x), sep=""))
# B
for (my.fun in c(substitute(mean), substitute(median))) { # works, but lots of typing for longer function lists
print(paste(deparse(my.fun), ": ", eval(my.fun)(x), sep=""))
}
# C
for (my.fun in substitute(c(mean, median))) { # error: invalid for() loop sequence
print(paste(deparse(my.fun), ": ", eval(my.fun)(x), sep=""))
}
# D
for (my.fun in sapply(c(mean, median), substitute)) { # error: '...' used in an incorrect context
print(paste(deparse(my.fun), ": ", eval(my.fun)(x), sep=""))
}
# E # also not helpful
my.functions <- c(mean, median)
my.fun.2 <- NULL
for (i in 1:2) {
my.fun.2 <- c(my.fun.2, substitute(my.functions[i]))
}
# my.fun.2
# [[1]]
# my.functions[i]
# [[2]]
# my.functions[i]
What about this "one-liner"? :)
> x <- c(1:10)
> f <- function(...)
+ sapply(
+ sapply(
+ as.list(substitute(list(...)))[-1L],
+ deparse),
+ function(fn)
+ get(fn)(x))
> f(mean, median)
mean median
5.5 5.5
In short, you can pass the functions as multiple arguments, then quickly deparse those before actually evaluating the functions one by one. So the above function with a few extra comments:
#' Evaluate multiple functions on some values
#' #param ... any number of function that will take \code{x} as the argument
#' #param x values to be passed to the functions
#' #examples
#' f(mean, median)
#' f(mean, median, sum, x = mtcars$hp)
f <- function(..., x = c(1:10)) {
## get provided function names
fns <- sapply(as.list(substitute(list(...)))[-1L], deparse)
## run each function as an anonymous function on "x"
sapply(fns, function(fn) get(fn)(x))
}
Or with do.call instead of this latter anonymous function:
f <- function(..., x = c(1:10)) {
## get provided function names
fns <- sapply(as.list(substitute(list(...)))[-1L], deparse)
## run each function on "x"
sapply(fns, do.call, args = list(x))
}
Certainly a very basic question but I do not have the answer:
I have a vector of function:
func1 <- function(u) u
func2 <- function(u) NA
func3 <- function(u) 1
funcs = c(func1, func2, func3)
I loop over every function using sapply, and I want to find a function command that retrieves the name of the function:
res=sapply(funcs, function(f){
command(f)
})
So that res is then:
c("func1","func2","func3")
Although there is no way to get the names if funcs is created with c, here is a convenience function for creating funcs that preserves the names:
cn <- function(...)
{
# call c() on parameters supplied, adding names
cnames <- sapply(as.list(substitute(list(...)))[-1L],as.character)
out <- c(...)
names(out) <- cnames
return(out)
}
funcs = cn(func1, func2, func3)
How about this approach:
flist<-ls(patt='func*')
flist[1]
[1] "func1"
do.call(flist[1],list(5))
# 5
I would like use a function that uses the standard deparse(substitute(x)) trick within lapply. Unfortunately I just get the argument of the loop back. Here's my completely useless reproducible example:
# some test data
a <- 5
b <- 6
li <- list(a1=a,b2=b)
# my test function
tf <- function(obj){
nm <- deparse(substitute(obj))
res <- list(myName=nm)
res
}
tf(a)
#returns
$myName
[1] "a"
which is fine. If I use lapply I either get [[1L]] or the x argument of an anonymous function.
lapply(li,function(x) tf(x))
# returns
$a1
$a1$myName
[1] "x"
$b2
$b2$myName
[1] "x"
Is there any way to obtain the following?
$a1
$a1$myName
[1] "a1"
$b2
$b2$myName
[1] "b1"
If there's anything more general on deparse(substitute(x)) and lapply I'd also eager to know.
EDIT:
The problem as opposed to using an anonymous function that accepts multiple arguments and can thus use the name of the object and the object itself does not work because, the tf function will only accept one argument. So this does not work here...
A possible solution :
lapply(li, function(x) {
call1 <- sys.call(1)
call1[[1]] <- as.name("names")
call1 <- call1[1:2]
nm <- eval(call1)
y <- deparse(substitute(x))
y <- gsub("\\D", "", y)
y <- as.numeric(y)
list(myname=nm[y])
})
I have written a stack "class" with the following functions: add, push, pop, size, isEmpty, clear (and some more).
I'd like to use this "class" as a generic in R, so I may create multiple instances of stacks within my script. How do I go about doing this?
(I have class in quotes because my stack functions are written in a different script (not necessarily the definition of a class per se)
Thanks in advance
list <- ""
cursor = 0
#Initializes stack to empty
stack <- function(){
list <- c()
cursor = -1
assign("list",list,.GlobalEnv)
assign("cursor",cursor,.GlobalEnv)
}
#Where item is a item to be added to generic list
push <- function(item){
if(size(list) == 0){
add(item, -1)
}else{
add(item, 0)
}
assign("list",list,.GlobalEnv)
}
This is a simpler version of the stack implementation #GSee references that avoids using any of the formal object-orientation systems available in R. Simplification proceeds from the fact that all functions in R are closures and functions created during a function call are bound to the environment created for that call.
new_stack <- function() {
stack <- vector()
push <- function(x) stack <<- c(stack, x)
pop <- function() {
tmp<-tail(stack, 1)
stack<<-stack[-length(stack)]
return(tmp)
}
structure(list(pop=pop, push=push), class='stack')
}
x <- new_stack()
x$push(1:3)
x$pop()
# [1] 3
x$pop()
# [1] 2
Here's an S4 implementation, for comparison.
setClass('Stack',
representation(list='list', cursor='numeric'), # type defs
prototype(list=list(), cursor=NA_real_)) # default values
setGeneric('push', function(obj, ...) standardGeneric('push'))
setMethod('push', signature(obj='Stack'),
function(obj, x) {
obj#list <- c(x, obj#list)
obj
})
setGeneric('pop', function(obj, ...) standardGeneric('pop'))
setMethod('pop', signature(obj='Stack'),
function(obj) {
obj#cursor <- obj#list[[1]]
obj#list <- obj#list[-1]
obj
}
)
x <- new('Stack')
# cursor is empty to start
x#cursor
#[1] NA
# add items
x <- push(x, 1)
x <- push(x, 2)
# pop them (move next item to cursor, remove from list)
x <- pop(x)
x#cursor
# [1] 2
x <- pop(x)
x#cursor
# [1] 1
Since you are specifically talking about a stack "class" with push and pop methods, here's an implementation by Jeff Ryan taken from Introducing Closures which you can read for an explanation of what's going on here.
new_stack <- function() {
stack <- new.env()
stack$.Data <- vector()
stack$push <- function(x) .Data <<- c(.Data,x)
stack$pop <- function() {
tmp <- .Data[length(.Data)]
.Data <<- .Data[-length(.Data)]
return(tmp)
}
environment(stack$push) <- as.environment(stack)
environment(stack$pop) <- as.environment(stack)
class(stack) <- "stack"
stack
}
> x <- new_stack()
> x$push(1:3)
> x$pop()
[1] 3
> x$pop()
[1] 2
Then, if you create S3 generics...
push <- function(x, value, ...) UseMethod("push")
pop <- function(x, ...) UseMethod("pop")
push.stack <- function(x, value, ...) x$push(value)
pop.stack <- function(x) x$pop()
> push(x, 5)
> pop(x)
[1] 5
> pop(x)
[1] 1
I would like to write a function that handles multiple data types. Below is an example that works but seems clunky. Is there a standard (or better) way of doing this?
(It's times like this I miss Matlab where everything is one type :>)
myfunc = function(x) {
# does some stuff to x and returns a value
# at some point the function will need to find out the number of elements
# at some point the function will need to access an element of x.
#
# args:
# x: a column of data taking on many possible types
# e.g., vector, matrix, data.frame, timeSeries, list
x.vec <- as.vector(as.matrix(as.data.frame(x)))
n <- length(x.vec)
ret <- x.vec[n/3] # this line only for concreteness
return(ret)
}
Use S3 methods. A quick example to get you started:
myfunc <- function(x) {
UseMethod("myfunc",x)
}
myfunc.data.frame <- function(x) {
x.vec <- as.vector(as.matrix(x))
myfunc(x.vec)
}
myfunc.numeric <- function(x) {
n <- length(x)
ret <- x[n/3]
return(ret)
}
myfunc.default <- function(x) {
stop("myfunc not defined for class",class(x),"\n")
}
Two notes:
The ... syntax passes any additional arguments on to functions. If you're extending an existing S3 method (e.g. writing something like summary.myobject), then including the ... is a good idea, because you can pass along arguments conventionally given to the canonical function.
print.myclass <- function(x,...) {
print(x$keyData,...)
}
You can call functions from other functions and keep things nice and parsimonious.
Hmm, your documentation for the function is
# args:
# x: a column of data taking on many possible types
# e.g., vector, matrix, data.frame, timeSeries, list
and if one supplies an object as you claim is require, isn't it already a vector and not a matrix or a data frame, hence obviating the need for separate methods/specific handling?
> dat <- data.frame(A = 1:10, B = runif(10))
> class(dat[,1])
[1] "integer"
> is.vector(dat[,1])
[1] TRUE
> is.vector(dat$A)
[1] TRUE
> is.numeric(dat$A)
[1] TRUE
> is.data.frame(dat$A)
[1] FALSE
I would:
myfunc <- function(x) {
# args:
# x: a column of data taking on many possible types
# e.g., vector, matrix, data.frame, timeSeries, list
n <- length(x)
ret <- x[n/3] # this line only for concreteness
return(ret)
}
> myfunc(dat[,1])
[1] 3
Now, if you want to handle different types of objects and extract a column, then S3 methods would be a way to go. Perhaps your example is over simplified for actual use? Anyway, S3 methods would be something like:
myfunc <- function(x, ...)
UseMethod("myfunc", x)
myfunc.matrix <- function(x, j = 1, ...) {
x <- x[, j]
myfunc.default(x, ...)
}
myfunc.data.frame <- function(x, j = 1, ...) {
x <- data.matrix(x)
myfunc.matrix(x, j, ...)
}
myfunc.default <- function(x, ...) {
n <- length(x)
x[n/3]
}
Giving:
> myfunc(dat)
[1] 3
> myfunc(data.matrix(dat))
[1] 3
> myfunc(data.matrix(dat), j = 2)
[1] 0.2789631
> myfunc(dat[,2])
[1] 0.2789631
You probably should try to use an S3 method for writing a function that will handle multiple datatypes.
A good reference is here: http://www.biostat.jhsph.edu/~rpeng/biostat776/classes-methods.pdf