I have a long vector x, and another v, which contains lengths. I would like to sum x so that the answer y is a vector of length length(v), and y[1] is sum(x[1:v[i]]), y[2] is sum(x[(1+v[1]):(v[1]+v[2])]), and so on. Essentially this is performing sparse matrix multiplication from a space of dimension length(x) to one of dimension length(v). However, I would prefer not to bring in "advanced machinery", although I might have to. It does need to be very, very fast. Can anyone think of anything simpler than using a sparse matrix package?
Example -
x <- c(1,1,3,4,5)
v <- c(2,3)
y <- myFunc(x,v)
y should be c(2,12)
I am open to any pre-processing - e.g, storing in v the starting indexes of each stretch.
y <- cumsum(x)[cumsum(v)]
y <- c(y[1], diff(y))
This looks like it's doing extra work because it's computing the cumsum for the whole vector, but it's actually faster than the other solutions so far, for both small and large numbers of groups.
Here's how I simulated the data
set.seed(5)
N <- 1e6
n <- 10
x <- round(runif(N,0,100),1)
v <- as.vector(table(sample(n, N, replace=TRUE)))
On my machine the timings with n <- 10 are:
Brandon Bertelsen (for loop): 0.017
Ramnath (rowsum): 0.057
John (split/apply): 0.280
Aaron (cumsum): 0.008
changing to n <- 1e5 the timings are:
Brandon Bertelsen (for loop): 2.181
Ramnath (rowsum): 0.226
John (split/apply): 0.852
Aaron (cumsum): 0.015
I suspect this is faster than doing matrix multiplication, even with a sparse matrix package, because one doesn't have to form the matrix or do any multiplication. If more speed is needed, I suspect it could be sped up by writing it in C; not hard to do with the inline and rcpp packages, but I'll leave that to you.
You can do this using rowsum. It should be reasonably fast as it uses C code in the background.
y <- rowsum(x, rep(1:length(v), v))
Here's a slightly different tack.
s <- rep(1:length(v), v)
l <- split(x, s)
y <- sapply(l, sum)
Try something like:
for (i in 1:length(v)) {
y[i] <- ifelse(i > 1,sum(x[v[i-1]:v[i]]), sum(x[1:v[i]]))
}
Related
I was trying to use outer() function in R to create a matrix by pairwise evaluation of elements in a vector of dimension n. Specifically, let x be n-dimensional vector and I want to compare each pair of the elements of x. To do so, I use the following naive implementation using outer() function.
# these codes are example
n <- 500
x <- rnorm(n)
f <- function(x, y){
as.numeric(x<y)+0.5*as.numeric(x==y)
}
#new.mat <- outer(seq_len(n), seq_len(n), f) this was posted wrongly
new.mat <- outer(x, x, f) # edited
This implementation is extremely slow when n increases, and I would like to know an efficient way of doing this job. I really appreciate if you introduce me to your trick.
Thanks,
Alemu
When making predictions for a linear statistical model we usually have a model matrix X of predictors corresponding to the points at which we want to make predictions; a vector of coefficients beta; and a variance-covariance matrix V. Computing the predictions is just X %*% beta. The most straightforward way to compute the variances of the predictions is
diag(X %*% V %*% t(X))
or slightly more efficiently
diag(X %*% tcrossprod(V,X))
However, this is very inefficient, because it constructs an n*n matrix when all we really want is the diagonal. I know I could write some Rcpp-loopy thing that would compute just the diagonal terms, but I'm wondering if there is an existing linear algebra trick in R that will nicely do what I want ... (if someone wants to write the Rcpp-loopy thing for me as an answer I wouldn't object, but I'd prefer a pure-R solution)
FWIW predict.lm seems to do something clever by multiplying X by the inverse of the R component of the QR-decomposition of the lm; I'm not sure that's always going to be available, but it might be a good starting point (see here)
Along the lines of this Octave/Matlab question, for two matrices A and B, we can use the use the fact that the nth diagonal entry of AB will be the product of the nth row of A with the nth column of B. We can naively extend that to the case of three matrices, ABC. I have not considered how to optimize in the case where C=A^T, but aside from that, this code looks like promising speedup:
start_time <- Sys.time()
A=matrix(1:1000000, nrow = 1000, ncol = 1000)
B=matrix(1000000:1, nrow = 1000, ncol = 1000)
# Try one of these two
res=diag(A %*% B %*% t(A)) # ~0.47s
res=rowSums(A * t(B %*% t(A))) # ~0.27s
end_time <- Sys.time()
print(end_time - start_time)
Using tcrossprod did not appear to accelerate the results when I ran this code. However, just using the row-sum-dot-product approach appears to be a lot more efficient already, at least on this silly example, which suggests (though I'm not sure) that rowSums is not computing the full intermediate matrices before returning the diagonal entries, as I'd expect happens with diag.
I am not quite sure how efficient this is,
Find U such that V = U %*% t(U); this is possible since V is cov matrix.
XU = X %*% U
result = apply(XU, 1, function(x) sum(x^2))
Demo
V <- cov(iris[, -5])
X <- as.matrix(iris[1:5, -5])
Using SVD
svd_v <- svd(V)
U <- svd_v$u %*% diag(sqrt(svd_v$d))
XU = X %*% U
apply(XU, 1, function(x) sum(x^2))
# 1 2 3 4 5
#41.35342 39.36286 35.42369 38.25584 40.30839
Another approach - this isn't also going to be faster than #davewy's
U <- chol(V)
XU = (X %*% U)^2
rowSums(XU)
I recently found emulator::quad.diag(), which is just
colSums(crossprod(M, Conj(x)) * x)
This is slightly better than #davewy's solution (although the overall differences are less than I thought they would be anyway).
library(microbenchmark)
microbenchmark(full=diag(A %*% B %*% t(A)),
davewy=rowSums(A * t(B %*% t(A))),
emu = quad.diag(A,B))
Unit: milliseconds
expr min lq mean median uq max neval cld
full 32.76241 35.49665 39.51683 37.63958 41.46561 57.41370 100 c
davewy 22.74787 25.06874 28.42179 26.97330 29.68895 45.38188 100 b
emu 17.68390 20.21322 23.59981 22.09324 24.80734 43.60953 100 a
I seem to have a misunderstanding about memory usage when using a subset of a matrix in R. I came across when I tried to program a cross validation function, but I think the problem is more general. I have cooked up a small example below.
# parameters
n <- 1e6 # the real data are much bigger, but this will do
m <- 50
nfolds <- 10
X <- matrix(rnorm(n*m,0,1),nrow=n,ncol=m)
y <- rnorm(n,0,1)
mse <- rep(0,nfolds)
foldid <- sample(rep(seq(nfolds), length = n))
# produces big spikes in memory
for (i in (1:nfolds)) {
which <- foldid == i
xpx <- crossprod(X[!which,])
xpy <- crossprod(X[!which,],y[!which])
b <- solve(xpx,xpy)
mse[i] <- mean((y[which] - X[which,] %*% b)**2)
}
# does not produce spikes in memory usage
for (i in (1:nfolds)) {
xpx <- crossprod(X)
xpy <- crossprod(X,y)
b <- solve(xpx,xpy)
mse[i] <- mean((y - X %*% b)**2)
}
I don't understand why the first loop produces big upward spikes in memory usage, whereas the second loop doesn't although a strictly larger matrix is multiplied.
Let's compare the first lines withing the loops.
First, the simple crossprod:
xpx <- crossprod(X)
Without subsetting, you work with matrices X (already existing 400 MB) and xpx (small).
Second, with subsetting:
xpx <- crossprod(X[!which,])
Here you work with X, temporary matrix X[!which,], and xpx. The additional matrix X[!which,] requires additional 360 MB of memory.
object.size(X[!which,])
# 360000200 bytes
R has relatively poor memory managment, so the temporary matrix may not be discarded for some time.
I am newcomer to R, migrated from GAUSS because of the license verification issues.
I want to speed-up the following code which creates n×k matrix A. Given the n×1 vector x and vectors of parameters mu, sig (both of them k dimensional), A is created as A[i,j]=dnorm(x[i], mu[j], sigma[j]). Following code works ok for small numbers n=40, k=4, but slows down significantly when n is around 10^6 and k is about the same size as n^{1/3}.
I am doing simulation experiment to verify the bootstrap validity, so I need to repeatedly compute matrix A for #ofsimulation × #bootstrap times, and it becomes little time comsuming as I want to experiment with many different values of n,k. I vectorized the code as much as I could (thanks to vector argument of dnorm), but can I ask more speed up?
Preemptive thanks for any help.
x = rnorm(40)
mu = c(-1,0,4,5)
sig = c(2^2,0.5^2,2^2,3^2)
n = length(x)
k = length(mu)
A = matrix(NA,n,k)
for(j in 1:k){
A[,j]=dnorm(x,mu[j],sig[j])
}
Your method can be put into a function like this
A.fill <- function(x,mu,sig) {
k <- length(mu)
n <- length(x)
A <- matrix(NA,n,k)
for(j in 1:k) A[,j] <- dnorm(x,mu[j],sig[j])
A
}
and it's clear that you are filling the matrix A column by column.
R stores the entries of a matrix columnwise (just like Fortran).
This means that the matrix can be filled with a single call of dnorm using suitable repetitions of x, mu, and sig. The vector z will have the columns of the desired matrix stacked. and then the matrix to be returned can be formed from that vector just by specifying the number of rows an columns. See the following function
B.fill <- function(x,mu,sig) {
k <- length(mu)
n <- length(x)
z <- dnorm(rep(x,times=k),rep(mu,each=n),rep(sig,each=n))
B <- matrix(z,nrow=n,ncol=k)
B
}
Let's make an example with your data and test this as follows:
N <- 40
set.seed(11)
x <- rnorm(N)
mu <- c(-1,0,4,5)
sig <- c(2^2,0.5^2,2^2,3^2)
A <- A.fill(x,mu,sig)
B <- B.fill(x,mu,sig)
all.equal(A,B)
# [1] TRUE
I'm assuming that n is an integer multiple of k.
Addition
As noted in the comments B.fill is quite slow for large values of n.
The reason lies in the construct rep(...,each=...).
So is there a way to speed A.fill.
I tested this function:
C.fill <- function(x,mu,sig) {
k <- length(mu)
n <- length(x)
sapply(1:k,function(j) dnorm(x,mu[j],sig[j]), simplify=TRUE)
}
This function is about 20% faster than A.fill.
I am looking for a fast computation in R of the trace (trace(A)) of a matrix A = B' C. The fastest way I can think of is the following:
set.seed(123)
n <- 10^6
B <- matrix(rnorm(n), ncol=sqrt(n))
C <- matrix(rnorm(n), ncol=sqrt(n))
ptm <- proc.time()
A <- tcrossprod(B,C)
traceA <- sum(diag(A))
proc.time() - ptm
I am asking myself if there is a faster way (especially if matrix B and matrix C are symmetric or even idempotent). I mean with the line A <- tcrossprod(B,C) I am computing the whole matrix A, although I just need the sum of the diagonal elements of the matrix (trace(A)).
To speed this up, I thought of a parallel computation for tcrossprod, but I havn't found an implementation for this (additionally I don't know if this would be a good idea). Does someone have an idea?
Tr(B'C) is just the inner product of the matrices B and C viewed as vectors. Thus
sum(B*C)
does the trick and is several orders of magnitude faster in this example.