How to make the elements of a matrix callable functions - r

I want to make a matrix of functions (that I wrote). Then access them element wise and call.
So I have : func1(x) , func2(y), func3(z) and func4(t) that are four R functions I wrote that work fine.They return numerics.
Now if I do:
a_matrix <- matrix(c(a=func1,b=func2,c=func3,d=func4),2,2)
a_func<-a_matrix[1,1]
a_func(x)
I get the following error:
error:attempt to call non-function.
Instead of matrix if I use list,
a_list<-list(a=func1,b=func2,c=func3,d=func4)
a_func<-list$a
a_func(x)
gives expected result
typeof(list$a)
[1] "closure"
If I do :
typeof(a_matrix)
[1] "list"
typeof(a_matrix[1,1])
[1] "list"
(am using R 3.1.1)

When you create non-atomic matrices like that, they are basically made into fancy lists. Similar rules apply to these lists as to regular lists when it comes to indexing; namely that [ ] will always return another list, and [[ ]] will extract the element without the list wrapper. You really want
func1 <- function(x) x+1
func2 <- function(x) x+2
func3 <- function(x) x+3
func4 <- function(x) x+4
a_matrix <- matrix(c(a=func1,b=func2,c=func3,d=func4),2,2)
a_func <- a_matrix[[1,1]]
a_func(5)
# [1] 6
You'd get the same results with your standard list syntax if you did
a_list <- list(a=func1,b=func2,c=func3,d=func4)
a_func <- a_list["a"]
a_func(5)
# Error: could not find function "a_func"
a_func <- a_list[["a"]]
a_func(5)
# [1] 6

Related

how to extract multiple function output automatially in R

I have built my own function, where it returns many values. I really need to extract several values at once. For example, suppose the following is my function
myfunc <- function(x,y){
res <- x+y
res2 <- x^2
res3 <- x*2
out <- list()
out$add <- res
out$squ <- res2
out$or <- res3
out$ADD <- res+res2+res3
out$fi <- res^2+res2+res3
return(out)
}
Then,
> myres
$add
[1] 7
$squ
[1] 9
$or
[1] 6
$ADD
[1] 22
$fi
[1] 64
suppose I want to extract two values at a time, for example,
myres$add, and myres$ADD
is there a way to find them automatically in R instead of repeating it. My original function is very complicated and this will help a lot.
Perhaps, you can try something like this -
res <- myfunc(6, 4)
extract_values <- c('add', 'ADD')
res[extract_values]
#$add
#[1] 10
#$ADD
#[1] 58
You could concatenate them or join in a list:
c(myres$add, myres$squ)
list(myres$add, myres$squ)
If you only want one call to myres you could also index like this:
myres[c(1, 2)]
What you want is known as destructuring, and unfortunately R does not natively support it. There are multiple packages which support this. The one with the (IMHO) nicest syntax is my own package ‘unpack’, which allows you to write positional unpacking as follows:
c[add, ., ., ADD, .] = myfunc(3, 4)
After this, the variables add and ADD are directly available to the caller.
A similar solution (more powerful but with a less nice syntax) is provided by the ‘zeallot’ package.

How to use lapply to size objects in environment?

I want to make a table with all the dim() of objects in the environment. ls() returns a list of characters which lapply will not take as object names and operate properly on. What to do? Using R.
> lapply(ls(), dim)
just returns
[[1]]
NULL
You may use parse and eval to change the string vector to env objects and then use dim.
lapply(ls(), function(x) dim(eval(parse(text=x))))
1) Use eapply and then optionally use Filter to remove components with no dim. This creates a named list with the dimensions in the corresponding components.
Filter(length, eapply(.GlobalEnv, dim))
2) A variation would be to create a matrix result such that the row names are the variable names.
do.call("rbind", eapply(.GlobalEnv, dim))
3) or to restrict the output to data frames and not arrays (as arrays might cause problems if there are arrays not of two dimensions) then:
df_dim <- function(x) if (is.data.frame(x)) dim(x)
do.call("rbind", eapply(.GlobalEnv, df_dim))
4) or to restrict it to objects having 2 dimensions including both data frames and arrays:
two_dim <- function(x, dimx = dim(x)) if (length(dimx) == 2) dimx
do.call("rbind", eapply(.GlobalEnv, two_dim))
or
do.call("rbind", Filter(function(x) length(x) == 2, eapply(.GlobalEnv, dim)))

How could I define an application method on an S3 object in R? (like a "function object" in c++)

The problem I am trying to tackle here is needing to apply (execute) an S3 object which is essentially a vector-like structure. This may contain various formulas which at some stage I need to evaluate for a single argument, in order to get back a vector-like object of the original shape, containing the evaluation of its constituent formulas at the given argument.
Examples of this (just to illustrate) might be a matrix of transformation - say rotation - which would take the angle to rotate by, and produce a matrix of values by which to multiply a point, for the given rotation. Another example might be the vector of states in a problem in classical mechanics. Then given t, v, a, etc, it could return s...
Now, I have created my container object in S3, and its working fine in most respects, using generic methods; I also found the Ops.myClass system of operator overloading very useful.
To complete my class, all I need now is a way to specify it as executable.
I see that there are various mechanisms that will do what I want in part, for instance I suppose that as.function() will convert the object to behave as I want, and something like lapply() could be used for the "reverse" application of the argument to the functions. What I am not sure how to do is link it all up so that I can do something like this mock-up:
new_Object <- function(<all my function vector stuff spec>)
vtest <- new_Object(<say, sin, cos, tan>)
vtest(1)
==>
myvec(.8414709848078965 .5403023058681398 1.557407724654902)
(Yes, I have already specified a generic print() routine that will make it appear nice)
All suggestions, sample code, links to examples are welcome.
PS =====
I have added some basic example code as per request.
I am not sure how much would be too much, so the full working minimal example, including operator overloading is in this gist here.
I am only showing the constructor and helper functions below:
# constructor
new_Struct <- function(stype , vec){
stopifnot(is.character(stype)) # enforce up | down
stopifnot(is.vector(vec))
structure(vec,class="Struct", type=stype)
}
# constructor helper functions --- need to allow for nesting!
up <-function(...){
vec <- unlist(list(...),use.names = FALSE)
new_Struct("up",vec)
}
down <-function(...){
vec <- unlist(list(...),use.names = FALSE)
new_Struct("down",vec)
}
The above code behaves thus:
> u1 <- up(1,2,3)
> u2 <- up(3,4,5)
> d1 <- down(u1)
> d1
[1] down(1, 2, 3)
> u1+u2
[1] up(4, 6, 8)
> u1+d1
Error: '+' not defined for opposite tuple types
> u1*d1
[1] 14
> u1*u2
[,1] [,2] [,3]
[1,] 3 4 5
[2,] 6 8 10
[3,] 9 12 15
> u1^2
[1] 14
> s1 <- up(sin,cos,tan)
> s1
[1] up(.Primitive("sin"), .Primitive("cos"), .Primitive("tan"))
> s1(1)
Error in s1(1) : could not find function "s1"
What I need, is for it to be able to do this:
> s1(1)
[1] up(.8414709848078965 .5403023058681398 1.557407724654902)
You can not call each function in a list of functions without a loop.
I'm not fully understanding all requirements, but this should give you a start:
new_Struct <- function(stype , vec){
stopifnot(is.character(stype)) # enforce up | down
stopifnot(is.vector(vec) || is.function(vec))
structure(vec,class="Struct", type=stype)
}
# constructor helper functions --- need to allow for nesting!
up <- function(...) UseMethod("up")
up.default <- function(...){
vals <- list(...)
stopifnot(all(vapply(vals, is.vector, FUN.VALUE = logical(1))))
vec <- unlist(vals, use.names = FALSE)
new_Struct("up",vec)
}
up.function <- function(...){
funs <- list(...)
stopifnot(all(vapply(funs, is.function, FUN.VALUE = logical(1))))
new_Struct("up", function(x) new_Struct("up", sapply(funs, do.call, list(x))))
}
up(1, 2, 3)
#[1] 1 2 3
#attr(,"class")
#[1] "Struct"
#attr(,"type")
#[1] "up"
up(1, 2, sin)
#Error in up.default(1, 2, sin) :
# all(vapply(vals, is.vector, FUN.VALUE = logical(1))) is not TRUE
up(sin, 1, 2)
#Error in up.function(sin, 1, 2) :
# all(vapply(funs, is.function, FUN.VALUE = logical(1))) is not TRUE
s1 <- up(sin, cos, tan)
s1(1)
#[1] 0.8414710 0.5403023 1.5574077
#attr(,"class")
#[1] "Struct"
#attr(,"type")
#[1] "up"
After some thought I have come up with a way to approach this, it's not perfect, it would be great if someone could figure out a way to make the function call implicit/transparent.
So, for now I just use the call() mechanism on the object, and that seems to work fine. Here's the pertinent part of the code, minus checks. I'll put up the latest full version on the same gist as above.
# constructor
new_Struct <- function(stype , vec){
stopifnot(is.character(stype)) # enforce up | down
stopifnot(is.vector(vec))
structure(vec,class="Struct", type=stype)
}
# constructor helper functions --- need to allow for nesting!
up <- function(...){
vec <- unlist(list(...), use.names = FALSE)
new_Struct("up",vec)
}
down <- function(...){
vec <- unlist(list(...), use.names = FALSE)
new_Struct("down",vec)
}
# generic print for tuples
print.Struct <- function(s){
outstr <- sprintf("%s(%s)", attributes(s)$type, paste(c(s), collapse=", "))
print(noquote(outstr))
}
# apply the structure - would be nice if this could be done *implicitly*
call <- function(...) UseMethod("call")
call.Struct <- function(s,x){
new_Struct(attributes(s)$type, sapply(s, do.call, list(x)))
}
Now I can do:
> s1 <- up(sin,cos,tan)
> length(s1)
[1] 3
> call(s1,1)
[1] up(0.841470984807897, 0.54030230586814, 1.5574077246549)
>
Not as nice as my ultimate target of
> s1(1)
[1] up(0.841470984807897, 0.54030230586814, 1.5574077246549)
but it will do for now...

Loop over list of functions, and return function name as character

In R, I have a list of functions (strategies for a simulation). For example:
a <- function(x){
return(x)
}
b <- function(y){
return(y)
}
funclist <- list(a,b)
I'd like to write some code that returns the name of each function. Normally, for functions I would use:
as.character(substitute(a))
But this does not work for the list, as it just would return the list name (as expected). I then tried lapply:
> lapply(X = funclist,FUN = substitute)
Error in lapply(X = funclist, FUN = substitute) :
'...' used in an incorrect context
But get the above error.
Ideally I would get (lapply solution):
[[1]]
[1] "a"
[[2]]
[1] "b"
or even (sapply solution):
[1] "a" "b"
After you do
funclist <- list(a,b)
The parameters a and b are evaluated and the functions they point to are returned. There is no way to get back to the original names. (The substitute() "trick" works on parameters passed to functions as promises. It will not work on evaluated called without additional escaping.)
If you want to retain names, it's best to use a named list. You can do
funclist <- list(a=a,a=b)
or
funclist <- setNames(list(a,b), c("a","b"))
or even use mget() here
funclist <- mget(c("a","b"))
All these methods will returned a named list and you can use
names(funclist)
# [1] "a" "b"
to get the names

Accessing same named list elements of the list of lists in R

Frequently I encounter situations where I need to create a lot of similar models for different variables. Usually I dump them into the list. Here is the example of dummy code:
modlist <- lapply(1:10,function(l) {
data <- data.frame(Y=rnorm(10),X=rnorm(10))
lm(Y~.,data=data)
})
Now getting the fit for example is very easy:
lapply(modlist,predict)
What I want to do sometimes is to extract one element from the list. The obvious way is
sapply(modlist,function(l)l$rank)
This does what I want, but I wonder if there is a shorter way to get the same result?
probably these are a little bit simple:
> z <- list(list(a=1, b=2), list(a=3, b=4))
> sapply(z, `[[`, "b")
[1] 2 4
> sapply(z, get, x="b")
[1] 2 4
and you can define a function like:
> `%c%` <- function(x, n)sapply(x, `[[`, n)
> z %c% "b"
[1] 2 4
and also this looks like an extension of $:
> `%$%` <- function(x, n) sapply(x, `[[`, as.character(as.list(match.call())$n))
> z%$%b
[1] 2 4
I usually use kohske way, but here is another trick:
sapply(modlist, with, rank)
It is more useful when you need more elements, e.g.:
sapply(modlist, with, c(rank, df.residual))
As I remember I stole it from hadley (from plyr documentation I think).
Main difference between [[ and with solutions is in case missing elements. [[ returns NULL when element is missing. with throw an error unless there exist an object in global workspace having same name as searched element. So e.g.:
dah <- 1
lapply(modlist, with, dah)
returns list of ones when modlist don't have any dah element.
With Hadley's new lowliner package you can supply map() with a numeric index or an element name to elegantly pluck components out of a list. map() is the equivalent of lapply() with some extra tricks.
library("lowliner")
l <- list(
list(a = 1, b = 2),
list(a = 3, b = 4)
)
map(l, "b")
map(l, 2)
There is also a version that simplifies the result to a vector
map_v(l, "a")
map_v(l, 1)

Resources