outer() equivalent for non-vector lists in R - r

I understand how outer() works in R:
> outer(c(1,2,4),c(8,16,32), "*")
[,1] [,2] [,3]
[1,] 8 16 32
[2,] 16 32 64
[3,] 32 64 128
It basically takes 2 vectors, finds the crossproduct of those vectors, and then applies the function to each pair in the crossproduct.
I don't have two vectors, however. I have two lists of matrices:
M = list();
M[[1]] = matrix(...)
M[[2]] = matrix(...)
M[[3]] = matrix(...)
And I want to do an operation on my list of matricies. I want to do:
outer(M, M, "*")
In this case, I want to take the dot product of each combination of matrices I have.
Actually, I am trying to generate a kernel matrix (and I have written a kernel function), so I want to do:
outer(M, M, kernelFunction)
where kernelFunction calculates a distance between my two matrices.
The problem is that outer() only takes "vector" arguments, rather than "list"s etc. Is there a function that does the equivalent of outer() for non-vector entities?
Alternately, I could use a for-loop to do this:
M = list() # Each element in M is a matrix
for (i in 1:numElements)
{
for (j in 1:numElements)
{
k = kernelFunction(M[[i]], M[[j]])
kernelMatrix[i,j] = k;
}
}
but I am trying to avoid this in favor of an R construct (which might be more efficient). (Yes I know I can modify the for-loop to compute the diagonal matrix and save 50% of the computations. But that's not the code that I'm trying to optimize!)
Is this possible? Any thoughts/suggestions?

The outer function actually DOES work on lists, but the function that you provide gets the two input vectors repeated so that they contain all possible combinations...
As for which is faster, combining outer with vapply is 3x faster than the double for-loop on my machine. If the actual kernel function does "real work", the difference in looping speed is probably not so important.
f1 <- function(a,b, fun) {
outer(a, b, function(x,y) vapply(seq_along(x), function(i) fun(x[[i]], y[[i]]), numeric(1)))
}
f2 <- function(a,b, fun) {
kernelMatrix <- matrix(0L, length(a), length(b))
for (i in seq_along(a))
{
for (j in seq_along(b))
{
kernelMatrix[i,j] = fun(a[[i]], b[[j]])
}
}
kernelMatrix
}
n <- 300
m <- 2
a <- lapply(1:n, function(x) matrix(runif(m*m),m))
b <- lapply(1:n, function(x) matrix(runif(m*m),m))
kernelFunction <- function(x,y) 0 # dummy, so we only measure the loop overhead
> system.time( r1 <- f1(a,b, kernelFunction) )
user system elapsed
0.08 0.00 0.07
> system.time( r2 <- f2(a,b, kernelFunction) )
user system elapsed
0.23 0.00 0.23
> identical(r1, r2)
[1] TRUE

Just use the for loop. Any built-in functions will degenerate to that anyway, and you'll lose clarity of expression, unless you carefully build a function that generalises outer to work with lists.
The biggest improvement you could make would be to preallocate the matrix:
M <- list()
length(M) <- numElements ^ 2
dim(M) <- c(numElements, numElements)
PS. A list is a vector.

Although this is an old question, here is another solution that is more in the spirit of the outer function. The idea is to apply outer along the indices of list1 and list2:
cor2 <- Vectorize(function(x,y) {
vec1 <- list1[[x]]
vec2 <- list2[[y]]
cor(vec1,vec2,method="spearman")
})
outer(1:length(list1), 1:length(list2), cor2)

Related

How do I adjust my function to multiply multiple (random number of) matrices?

I have written the following function for multiplying two matrices A and B:
f <- function(A,B){
m<-nrow(A)
n<-ncol(A)
n<-nrow(B)
p<-ncol(B)
Result<-matrix(0,nrow = m,ncol = p)
for(i in 1:m){
for(j in 1:p){
for(k in 1:n){
Result[i,j]<-Result[i,j]+A[i,k]*B[k,j]
}
}
}
return(Result)
}
How would I adjust my function code to multiple 3 or more, i.e., a random number of matrices rather than just 2?
You just iteratively apply two-matrix multiplication. Let f be the fundamental function multiplying two matrices A and B. Normally we use the internal one %*%, but you can use the one defined in your question.
Since the number of matrices are unknown, I suggest using .... We collect all matrices input into a "matrix list" by list(...), then use Reduce to cumulatively apply two-operand matrix multiplication.
g <- function (...) Reduce(f, list(...))
Note, it is your responsibility to ensure the matrix dimension are conformable, especially when you have a lot of matrices. In the following, I would just use square matrices as an example.
set.seed(0)
A <- matrix(rnorm(4),2)
B <- matrix(rnorm(4),2)
C <- matrix(rnorm(4),2)
f <- "%*%"
g(A, B, C)
# [,1] [,2]
#[1,] -3.753667 0.08634328
#[2,] -0.161250 -1.54194176
And this is as same as:
A %*% B %*% C
# [,1] [,2]
#[1,] -3.753667 0.08634328
#[2,] -0.161250 -1.54194176

adding values to the vector inside for loop in R

I have just started learning R and I wrote this code to learn on functions and loops.
squared<-function(x){
m<-c()
for(i in 1:x){
y<-i*i
c(m,y)
}
return (m)
}
squared(5)
NULL
Why does this return NULL. I want i*i values to append to the end of mand return a vector. Can someone please point out whats wrong with this code.
You haven't put anything inside m <- c() in your loop since you did not use an assignment. You are getting the following -
m <- c()
m
# NULL
You can change the function to return the desired values by assigning m in the loop.
squared <- function(x) {
m <- c()
for(i in 1:x) {
y <- i * i
m <- c(m, y)
}
return(m)
}
squared(5)
# [1] 1 4 9 16 25
But this is inefficient because we know the length of the resulting vector will be 5 (or x). So we want to allocate the memory first before looping. This will be the better way to use the for() loop.
squared <- function(x) {
m <- vector("integer", x)
for(i in seq_len(x)) {
m[i] <- i * i
}
m
}
squared(5)
# [1] 1 4 9 16 25
Also notice that I have removed return() from the second function. It is not necessary there, so it can be removed. It's a matter of personal preference to leave it in this situation. Sometimes it will be necessary, like in if() statements for example.
I know the question is about looping, but I also must mention that this can be done more efficiently with seven characters using the primitive ^, like this
(1:5)^2
# [1] 1 4 9 16 25
^ is a primitive function, which means the code is written entirely in C and will be the most efficient of these three methods
`^`
# function (e1, e2) .Primitive("^")
Here's a general approach:
# Create empty vector
vec <- c()
for(i in 1:10){
# Inside the loop, make one or elements to add to vector
new_elements <- i * 3
# Use 'c' to combine the existing vector with the new_elements
vec <- c(vec, new_elements)
}
vec
# [1] 3 6 9 12 15 18 21 24 27 30
If you happen to run out of memory (e.g. if your loop has a lot of iterations or vectors are large), you can try vector preallocation which will be more efficient. That's not usually necessary unless your vectors are particularly large though.

How to use with() function in R instead of apply()

I am trying to optimise a code that I have written using the apply() and similar functions (e.g. lapply()). Unfortunately I do not see much of improvement so searching I came across this post apply() is slow - how to make it faster or what are my alternatives? where a suggestion is to use the function with() instead of apply() which is certainly much faster.
What I want to do is to apply a user defined function to every row of a matrix. This function takes as input the data from the row, makes some calculations and returns a vector with the results.
A toy example where I use the apply() function, the with() and a vectorized version:
#Generate a matrix 10x3
prbl1=matrix(runif(30),nrow=10)
prbl2=data.frame(prbl1)
prbl3=prbl2
#function for the apply()
fn1=function(row){
x=row[1]
y=row[2]
z=row[3]
k1=2*x+3*y+4*z
k2=2*x*3*y*4*z
k3=2*x*y+3*x*z
return(c(k1,k2,k3))
}
#function for the with()
fn2=function(x,y,z){
k1=2*x+3*y+4*z
k2=2*x*3*y*4*z
k3=2*x*y+3*x*z
return(c(k1,k2,k3))
}
#Vectorise fn2
fn3=Vectorize(fn2)
#apply the functions:
rslt1=t(apply(prbl1,1,fn1))
rslt2=t(with(prbl2,fn2(X1,X2,X3)))
rslt2=cbind(rslt2[1:10],rslt2[11:20],rslt2[21:30])
rslt3=t(with(prbl3,fn3(X1,X2,X3)))
All three produce the same output, a matrix 10x3 which is what I want. Nevertheless, notice at rslt2 that I need to bind the results as the output of using with() is a vector of length 300. I suspected that this is due to the fact that the function is not vectorised (if I understood this correctly). In rslt3 I am using a vectorised version of fn2 which generated the output in the expected way.
When I compare the performance of the three, I get:
library(rbenchmark)
benchmark(rslt1=t(apply(prbl1,1,fn1)),
rslt2=with(prbl2,fn2(X1,X2,X3)),
rslt3=with(prbl3,fn3(X1,X2,X3)),
replications=1000000)
test replications elapsed relative user.self sys.self user.child sys.child
1 rslt1 1000000 103.51 7.129 102.63 0.02 NA NA
2 rslt2 1000000 14.52 1.000 14.41 0.01 NA NA
3 rslt3 1000000 123.44 8.501 122.41 0.05 NA NA
where with() without vectorisation is definitely faster.
My question: Since rslt2 is the most efficient approach, is there a way that I can use this correctly without the need to bind the results afterwards? It does the job but I feel is not efficient coding.
The first and third functions you give are being applied 1 row at a time, so are called 10 times in your example. The second function is taking advantage of the fact that multiplication and addition in R are already vectorised and so using any form of loop or ply function is unnecessary. The function is only called once. If you wanted to use your current code, all you'd need to do is change the c to cbind in fn2.
fn2=function(x,y,z){
k1=2*x+3*y+4*z
k2=2*x*3*y*4*z
k3=2*x*y+3*x*z
return(cbind(k1,k2,k3))
}
All that with does is evaluate the expression it's given in the list, data.frame or environment given. So with(prbl2,fn2(X1,X2,X3)) is entirely equivalent to fn2(prbl2$X1, prbl2$X2, prbl2$X3).
Is this your real function? If it is, then problem solved. If not, then it depends on whether your real function consists entirely of operations and functions that already are vectorised or can be replaced with vectorised equivalents.
For the amended function per the comments:
Single row:
fn1 <- function(row){
x <- row[1]
y <- row[2]
z <- row[3]
k1 <- 2*x+3*y+4*z
k2 <- 2*x*3*y*4*z
k3 <- 2*x*y+3*x*z
if (k1>0 & k2>0 &k3>0){
return(cbind(k1,k2,k3))
} else {
k1 <- 5*x+3*y+4*z
k2 <- 5*x*3*y*4*z
k3 <- 5*x*y+3*x*z
if (k1<0 || k2<0 || k3<0) {
return(cbind(0,0,0))
} else {
return(cbind(k1,k2,k3))
}
}
}
Whole matrix:
fn2 <- function(mat) {
x <- mat[, 1]
y <- mat[, 2]
z <- mat[, 3]
k1 <- 2*x+3*y+4*z
k2 <- 2*x*3*y*4*z
k3 <- 2*x*y+3*x*z
l1 <- 5*x+3*y+4*z
l2 <- 5*x*3*y*4*z
l3 <- 5*x*y+3*x*z
out <- array(0, dim = dim(mat))
useK <- k1 > 0 & k2 > 0 & k3 > 0
useL <- !useK & l1 >= 0 & l2 >= 0 & l3 >= 0
out[useK, ] <- cbind(k1, k2, k3)[useK, ]
out[useL, ] <- cbind(l1, l2, l3)[useL, ]
out
}

R-apply a function to each row of a matrix, with a changing argument?

I have a function with two arguments. The first argument takes vector, and the second argument takes a scalar. I want to apply this function to each row of a matrix, but this function takes different second argument every time. I tried the following, it didn't work. I expected to calculate the p.value for each row and then divide the p.value by the row number. I expected the result to be a vector, but I got a matrix instead. This is a pseudo example, but it illustrates my purpose.
> foo = matrix(rnorm(100),ncol=20)
> f = function (x,y) t.test(x[1:10],x[11:20])$p.value/y
> goo = 1:5
> apply(foo,1,f,y=goo)
[,1] [,2] [,3] [,4] [,5]
[1,] 0.9406881 0.6134117 0.5484542 0.11299535 0.20420786
[2,] 0.4703440 0.3067059 0.2742271 0.05649767 0.10210393
[3,] 0.3135627 0.2044706 0.1828181 0.03766512 0.06806929
[4,] 0.2351720 0.1533529 0.1371135 0.02824884 0.05105196
[5,] 0.1881376 0.1226823 0.1096908 0.02259907 0.04084157
The following for loop strategy produces the expected result, expect would be very slow for the real data.
> res = numeric(5)
> for (i in 1:5){
res[i]=f(foo[i,],i)
}
> res
[1] 0.94068810 0.30670585 0.18281807 0.02824884 0.04084157
Any suggestions would be appreciated!
If your real purpose is like your example, you can vectorize the division:
f <- function(x) t.test(x[1:10], x[11:20])$p.value
apply(foo, 1, f) / goo
Based on the comment, the above is not appropriate.
In the case of the example, you might observe that the diagonal of the returned matrix is the desired result:
f = function (x,y) t.test(x[1:10],x[11:20])$p.value/y
goo = 1:5
diag(apply(foo,1,f,y=goo))
Besides being inefficient in time or space, this suffers from another problem. It is a result of the operation on y being vectorized that this is correct for the example. And in that case, the former solution is better. So I suspect that in your actual problem, your operation is not vectorized.
Sometimes a for loop really is the best answer. The apply family of functions are not magical; they are still loops.
Here is an sapply solution. It won't beat for for time (probably won't lose either) but it doesn't have a high space overhead. The idea is to apply the row index and use that to extract the row of foo and the element of goo to pass to f
sapply(seq(nrow(foo)), function(i) f(foo[i,], goo[i]))
f <- function (x,y) t.test(x[1:10],x[11:20])$p.value/y
f2 <- function(a, b){
tt <- t.test(x = a[1:10], y = a[11:20])$p.value
tt/b
}
f3 <- function() {
res <- numeric(5)
for (i in 1:5){
res[i] <- f(foo[i,],i)
}
res
}
f4 <- function(x) t.test(x[1:10], x[11:20])$p.value
set.seed(101)
foo <- matrix(rnorm(100),ncol=20)
goo <- 1:5
library(rbenchmark)
benchmark(
apply(foo, 1, f4) / goo,
mapply(f,split(foo,row(foo)),goo),
f2(foo,goo),
f3(),replications=1000,
sapply(seq(nrow(foo)), function(i) f(foo[i,], goo[i])),
columns=c("test","replications","elapsed","relative"))
## test replications elapsed relative
## 1 apply(foo, 1, f4)/goo 1000 1.581 5.528
## 3 f2(foo, goo) 1000 0.286 1.000
## 4 f3() 1000 1.458 5.098
## 2 mapply(...) 1000 1.599 5.591
## 5 sapply(...) 1000 1.486 5.196
The direct division is best (but not actually applicable); for this example there's not much difference between the other solutions, but for loop is better than sapply which is better than mapply. You should try this on a more realistic example to see how it's going to scale for your problem.

Functional programming in R : illustration with vandermonde matrix

I would like to get a feel of functional programming in R.
To that effect, I would like to write the vandermonde matrix computation, as it can involve a few constructs.
In imperative style that would be :
vandermonde.direct <- function (alpha, n)
{
if (!is.vector(alpha)) stop("argument alpha is not a vector")
if (!is.numeric(alpha)) stop("argument n is not a numeric vector")
m <- length(alpha)
V <- matrix(0, nrow = m, ncol = n)
V[, 1] <- rep(1, m)
j <- 2
while (j <= n) {
V[, j] <- alpha^(j - 1)
j <- j + 1
}
return(V)
}
How would you write that elegantly in R in functional style ?
The following does not work :
x10 <- runif(10)
n <- 3
Reduce(cbind, aaply(seq_len(n-1),1, function (i) { function (x) {x**i}}), matrix(1,length(x10),1))
As it tells me Error: Results must have one or more dimensions. for list of function which go from i in seq_len(3-1) to the function x -> x**i.
It does not seem very natural to use Reduce for this task.
The error message is caused by aaply, which tries to return an array:
you can use alply instead; you also need to call your functions, somewhere.
Here are a few idiomatic alternatives:
outer( x10, 0:n, `^` )
t(sapply( x10, function(u) u^(0:n) ))
sapply( 0:3, function(k) x10^k )
Here it is with Reduce:
m <- as.data.frame(Reduce(f=function(left, right) left * x10,
x=1:(n-1), init=rep(1,length(x10)), accumulate=TRUE))
names(m) <- 1:n - 1
Here's another option, that uses the environment features of R:
vdm <- function(a)
{
function(i, j) a[i]^(j-1)
}
This will work for arbitrary n (the number of columns).
To create the "Vandermonde functional" for a given a, use this:
v <- vdm(a=c(10,100))
To build a matrix all at once, use this:
> outer(1:3, 1:4, v)
[,1] [,2] [,3] [,4]
[1,] 1 10 100 1e+03
[2,] 1 100 10000 1e+06
[3,] 1 NA NA NA
Note that index a[3] is out of bounds, thus returning NA (except for the first column, which is 1).

Resources