I was given this matrix and i have to create it using exclusively matrix operations.
0 1 2 3 4
1 2 3 4 5
2 3 4 5 6
3 4 5 6 7
4 5 6 7 8
So this is what i have done, but im not sure if this is actually considered as matrix operations in order to create my MATNew
mat1 <- matrix(c(0:4), nrow=1, ncol=5) ; print(mat1)
mat2 <- matrix(c(1:5), nrow=1, ncol=5) ; print(mat2)
mat3 <- matrix(c(2:6), nrow=1, ncol=5) ; print(mat3)
mat4 <- matrix(c(3:7), nrow=1, ncol=5) ; print(mat4)
mat5 <- matrix(c(4:8), nrow=1, ncol=5) ; print(mat5)
MATNew <- matrix(cbind(mat1,mat2,mat3,mat4,mat5), 5, 5) ; print(MATNew)
outer(0:4, 0:4, `+`)
# [,1] [,2] [,3] [,4] [,5]
# [1,] 0 1 2 3 4
# [2,] 1 2 3 4 5
# [3,] 2 3 4 5 6
# [4,] 3 4 5 6 7
# [5,] 4 5 6 7 8
You can use the row() and col() functions (if this is homework, make sure to cite your sources ...)
m <- matrix(NA, 5, 5)
row(m) + col(m)-2
A matrix-only solution
matrix( rep(0:8,5), 5 )[,1:9%%2==1]
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 2 3 4
[2,] 1 2 3 4 5
[3,] 2 3 4 5 6
[4,] 3 4 5 6 7
[5,] 4 5 6 7 8
Try this?
> embed(0:8, 5)[, 5:1]
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 2 3 4
[2,] 1 2 3 4 5
[3,] 2 3 4 5 6
[4,] 3 4 5 6 7
[5,] 4 5 6 7 8
Benchmark for kicks:
microbenchmark::microbenchmark(
outer = outer(0:4, 0:4, `+`),
rowcol = {m <- matrix(NA, 5, 5); row(m) + col(m)-2},
matrix1 = matrix(rep(0:8,5), 5)[,1:9%%2==1],
matrix2 = matrix(rep(0:8,5), 5)[,c(TRUE, FALSE)],
matrix3 = matrix(rep(0:4, each = 5) + 0:4, 5),
sequence = matrix(sequence(rep(5, 5), 0:4), 5), times = 1e5)
#> Unit: microseconds
#> expr min lq mean median uq max neval
#> outer 5.100 6.200 8.706730 6.501 7.202 6628.401 1e+05
#> rowcol 2.900 3.801 5.097179 4.002 4.402 4985.501 1e+05
#> matrix1 2.900 3.701 5.159770 4.000 4.400 3621.901 1e+05
#> matrix2 2.400 3.002 4.063637 3.201 3.601 2395.001 1e+05
#> matrix3 2.000 2.600 3.535451 2.701 3.001 2517.101 1e+05
#> sequence 3.701 4.601 6.179183 4.901 5.401 3303.102 1e+05
Related
I have a matrix M:
n = 3
x=c(0.85, 0.1, 0.05)
M <- matrix(NA, n, n);
for(i in 1:n){
for(j in 1:n){
M[i,j] = x[i] * x[j]
}}
# [,1] [,2] [,3]
# [1,] 0.7225 0.085 0.0425
# [2,] 0.0850 0.010 0.0050
# [3,] 0.0425 0.005 0.0025
I need to find the sum of all anti-diagonals include M[1,1] and M[n, n]. My attemp is
d <-matrix(c(0, 1, 2, 1, 2, 3, 2, 3, 4), n)
tapply(M, d, sum)
0 1 2 3 4
0.7225 0.1700 0.0950 0.0100 0.0025
The result is correct for me.
Question. How to define the entries of matrix d? May be as function over col(M) and row(M).
As you mention in your question, row(M) and col(M) can be used, although they start rows/columns at 1 rather than zero, so you need to subtract 2 (1 for each) giving:
tapply(M, row(M) + col(M) - 2, sum)
# 0 1 2 3 4
#0.7225 0.1700 0.0950 0.0100 0.0025
First note that outer can produce the matrix d without explicitly listing its elements.
matrix(c(0, 1, 2, 1, 2, 3, 2, 3, 4), 3)
#> [,1] [,2] [,3]
#> [1,] 0 1 2
#> [2,] 1 2 3
#> [3,] 2 3 4
outer(0:2, 0:2, `+`)
#> [,1] [,2] [,3]
#> [1,] 0 1 2
#> [2,] 1 2 3
#> [3,] 2 3 4
Created on 2022-03-24 by the reprex package (v2.0.1)
And use it in a function.
sumAntiDiag <- function(M){
nr <- nrow(M)
nc <- ncol(M)
d <- outer(seq.int(nr), seq.int(nc), `+`)
tapply(M, d, sum)
}
n <- 3
x <- c(0.85, 0.1, 0.05)
M <- matrix(NA, n, n);
for(i in 1:n){
for(j in 1:n){
M[i,j] = x[i] * x[j]
}}
sumAntiDiag(M)
#> 2 3 4 5 6
#> 0.7225 0.1700 0.0950 0.0100 0.0025
Created on 2022-03-24 by the reprex package (v2.0.1)
You could do:
sapply(seq(3), function(x) seq(3) + x - 2)
#> [,1] [,2] [,3]
#> [1,] 0 1 2
#> [2,] 1 2 3
#> [3,] 2 3 4
Or more generally,
anti_diagonal <- function(n) sapply(seq(n), function(x) seq(n) + x - 2)
For example:
anti_diagonal(6)
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 0 1 2 3 4 5
#> [2,] 1 2 3 4 5 6
#> [3,] 2 3 4 5 6 7
#> [4,] 3 4 5 6 7 8
#> [5,] 4 5 6 7 8 9
#> [6,] 5 6 7 8 9 10
Try the code below by defining a function f using embed from base R, i.e.,
f <- function(n) embed(seq(2 * n - 1) - 1, n)[, n:1]
such that
> f(3)
[,1] [,2] [,3]
[1,] 0 1 2
[2,] 1 2 3
[3,] 2 3 4
> f(4)
[,1] [,2] [,3] [,4]
[1,] 0 1 2 3
[2,] 1 2 3 4
[3,] 2 3 4 5
[4,] 3 4 5 6
> f(5)
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 2 3 4
[2,] 1 2 3 4 5
[3,] 2 3 4 5 6
[4,] 3 4 5 6 7
[5,] 4 5 6 7 8
You can use sequence:
function(n) matrix(sequence(rep(n, n), seq(n) - 1), nrow = n)
output
f <- function(n) matrix(sequence(rep(n, n), seq(n) - 1), nrow = n)
f(3)
[,1] [,2] [,3]
[1,] 0 1 2
[2,] 1 2 3
[3,] 2 3 4
f(5)
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 2 3 4
[2,] 1 2 3 4 5
[3,] 2 3 4 5 6
[4,] 3 4 5 6 7
[5,] 4 5 6 7 8
Using indexing instead of tapply will speed things up a bit. Or Rcpp:
sumdiags <- function(mat, minor = TRUE) {
m <- ncol(mat)
if (minor) {
n <- nrow(mat)
lens <- c(pmin(1:n, m), pmin((m - 1L):1, n))
c(mat[1], diff(cumsum(mat[sequence(lens, c(1:n, seq(2L*n, by = n, length.out = m - 1L)), n - 1L)])[cumsum(lens)]))
} else {
Recall(mat[,m:1])
}
}
# compare to tapply solution
sumdiags2 <- function(mat, minor = TRUE) {
if (minor) {
as.numeric(tapply(mat, row(mat) + col(mat), sum))
} else {
Recall(mat[,ncol(mat):1])
}
}
# or Rcpp
Rcpp::cppFunction('NumericVector sumdiagsRcpp(const NumericMatrix& mat) {
const int n = mat.nrow();
const int m = mat.ncol();
NumericVector x (n + m - 1);
for(int row = 0; row < n; row++) {
for(int col = 0; col < m; col++) {
x[row + col] += mat(row, col);
}
}
return x;
}')
# OP data
x <- c(0.85, 0.1, 0.05)
m <- outer(x, x)
sumdiags(m)
#> [1] 0.7225 0.1700 0.0950 0.0100 0.0025
sumdiags2(m)
#> [1] 0.7225 0.1700 0.0950 0.0100 0.0025
sumdiagsRcpp(m)
#> [1] 0.7225 0.1700 0.0950 0.0100 0.0025
# bigger matrix for benchmarking
m <- matrix(runif(1e6), 1e3)
microbenchmark::microbenchmark(sumdiags = sumdiags(m),
sumdiags2 = sumdiags2(m),
sumdiagsRcpp = sumdiagsRcpp(m),
check = "equal")
#> Unit: milliseconds
#> expr min lq mean median uq max neval
#> sumdiags 9.985302 10.266350 13.686723 10.803401 17.5274 22.387601 100
#> sumdiags2 55.790402 65.140051 78.763478 67.120051 70.4165 183.936801 100
#> sumdiagsRcpp 2.192201 2.378651 2.599326 2.631751 2.7050 4.038301 100
The What
Given some matrix:
mat <- matrix(1:10,ncol=2)
I want to transform it to the following triplet format: (i,j,v) where i is the row index, j is the column index and v is the value at i,j (you can see why at the bottom)
What I have tried:
matrixToTriplet <- function(mat) {
i <- 1:nrow(mat)
nj <- ncol(mat)
j <- 1:nj
output <- matrix(numeric(0), ncol=3)
for(i_ in i) {
curr <- c(rep(i_, times=nj),j,mat[i_,])
output <- rbind(output, matrix(curr, ncol=3))
}
output
}
The output should be:
> matrixToTriplet(mat)
[,1] [,2] [,3]
[1,] 1 1 1
[2,] 1 2 6
[3,] 2 1 2
[4,] 2 2 7
[5,] 3 1 3
[6,] 3 2 8
[7,] 4 1 4
[8,] 4 2 9
[9,] 5 1 5
[10,] 5 2 10
I also had another version using apply and sapply instead of for but those would explode very quickly. The kind of sizes I am working on is quite large, 1600x1600 matrices.
The Why
One might ask "why"?, the reason for this is that I need the is and js as features for a model to predict v. If there is a better way to do this I am interested to hear.
For those who really like expand.grid:
cbind(expand.grid(seq(nrow(mat)), seq(ncol(mat))), as.vector(mat))
You can do this with row and col:
x <- t(mat)
cbind(c(col(x)), c(row(x)), c(x))
# [,1] [,2] [,3]
# [1,] 1 1 1
# [2,] 1 2 6
# [3,] 2 1 2
# [4,] 2 2 7
# [5,] 3 1 3
# [6,] 3 2 8
# [7,] 4 1 4
# [8,] 4 2 9
# [9,] 5 1 5
# [10,] 5 2 10
If the row order does not matter in the final output, we can also do it with cbind(c(row(mat)), c(col(mat)), c(mat)) directly.
A benchmark will be helpful when talking about efficiency:
library(microbenchmark)
bmf <- function(mat, ...){
microbenchmark(
a = {x <- t(mat);cbind(c(col(x)), c(row(x)), c(x))},
a2 = {cbind(c(row(mat)), c(col(mat)), c(mat))},
b = {cbind(which(mat > 0, arr.ind = TRUE), val = c(mat))},
c = {cbind(expand.grid(seq(nrow(mat)), seq(ncol(mat))), as.vector(mat))},
...)
}
mat <- matrix(seq_len(10*10), 10, 10)
bmf(mat, times = 10)
# Unit: microseconds
# expr min lq mean median uq max neval
# a 7.985 9.239 18.2556 15.0415 22.756 47.065 10
# a2 4.310 4.681 5.5257 5.2405 5.755 9.099 10
# b 17.032 21.672 35.8950 28.7505 59.170 68.436 10
# c 216.101 228.736 267.7217 243.9465 288.455 380.096 10'
mat <- matrix(seq_len(1000*1000), 1000, 1000)
bmf(mat, times = 10)
# Unit: milliseconds
# expr min lq mean median uq max neval
# a 17.70805 20.51167 36.73432 21.79357 24.56775 111.6796 10
# a2 14.61793 20.95486 37.70526 25.58968 30.91322 98.44344 10
# b 41.74630 45.49698 76.61307 47.86678 122.90142 178.8363 10
# c 14.40912 17.84025 25.39672 19.29968 20.12222 85.2515 10
The simplest way would be to use which argument with arr.ind= TRUE parameter which exactly does what you want however, the issue is it expects a logical value. So we need to find a condition in which all the values turn out to be TRUE. In this case I see all values are greater than 0. So we can do
#as.vector suggested by #snoram and verified by #mt1022 that it is faster
cbind(which(mat > 0, arr.ind = TRUE), val = as.vector(mat))
# row col val
# [1,] 1 1 1
# [2,] 2 1 2
# [3,] 3 1 3
# [4,] 4 1 4
# [5,] 5 1 5
# [6,] 1 2 6
# [7,] 2 2 7
# [8,] 3 2 8
# [9,] 4 2 9
#[10,] 5 2 10
If you are not able to find any such condition which would make all the values to be TRUE we could just create a new matrix with same dimensions as mat with all values as TRUE using relist
cbind(which(relist(TRUE, mat), arr.ind = TRUE), value = as.vector(mat))
# row col value
# [1,] 1 1 1
# [2,] 2 1 2
# [3,] 3 1 3
# [4,] 4 1 4
# [5,] 5 1 5
# [6,] 1 2 6
# [7,] 2 2 7
# [8,] 3 2 8
# [9,] 4 2 9
#[10,] 5 2 10
Just for fun, here is an option using the Matrix package.
mat <- matrix(1:10,ncol=2)
#create sparse matrix
library(Matrix)
M <- Matrix(mat, sparse = TRUE)
#turn into triplet representation
M <- as(M, "TsparseMatrix")
#indices are zero-based within Matrix package
m <- cbind(M#i + 1, M#j + 1, M#x) #do you really need a matrix as output?
m[order(m[,1]),] #probably you don't need this step
# [,1] [,2] [,3]
# [1,] 1 1 1
# [2,] 1 2 6
# [3,] 2 1 2
# [4,] 2 2 7
# [5,] 3 1 3
# [6,] 3 2 8
# [7,] 4 1 4
# [8,] 4 2 9
# [9,] 5 1 5
#[10,] 5 2 10
I want to sort this matrix row-wise to descending order
> set.seed(123); a <- matrix(rbinom(100,10,0.3),ncol=10)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 2 6 5 6 1 1 4 4 2 1
[2,] 4 3 4 5 3 3 1 3 4 4
[3,] 3 4 3 4 3 4 3 4 3 2
[4,] 5 3 7 4 2 1 2 0 4 4
[5,] 5 1 4 0 2 3 4 3 1 2
[6,] 1 5 4 3 1 2 3 2 3 2
[7,] 3 2 3 4 2 1 4 2 6 4
[8,] 5 1 3 2 3 4 4 3 5 1
[9,] 3 2 2 2 2 5 4 2 5 3
[10,] 3 6 1 2 5 2 3 1 2 3
but
> do.call(order,as.list(a[1,],a[2,]))
[1] 1
How can you sort the matrix with the do.call and order?
Edit. Fixed above matrix to conform with the above code.
Two alternatives:
# Jaap
do.call(rbind, lapply(split(a, row(a)), sort, decreasing = TRUE))
# adaption of lmo's solution in the comments
for(i in 1:nrow(a)) a[i,] <- a[i,][order(a[i,], decreasing = TRUE)]
gives:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
1 6 6 5 4 4 2 2 1 1 1
2 5 4 4 4 4 3 3 3 3 1
3 4 4 4 4 3 3 3 3 3 2
4 7 5 4 4 4 3 2 2 1 0
5 5 4 4 3 3 2 2 1 1 0
6 5 4 3 3 3 2 2 2 1 1
7 6 4 4 4 3 3 2 2 2 1
8 5 5 4 4 3 3 3 2 1 1
9 5 5 4 3 3 2 2 2 2 2
10 6 5 3 3 3 2 2 2 1 1
A benchmark with:
library(microbenchmark)
microbenchmark(dc.lapply.sort = do.call(rbind, lapply(split(a, row(a)), sort, decreasing = TRUE)),
t.apply.sort = t(apply(a, 1, sort, decreasing = TRUE)),
for.order = for(i in 1:nrow(a)) a[i,] <- a[i,][order(a[i,], decreasing = TRUE)],
for.sort = for(i in 1:nrow(a)) a[i,] <- sort(a[i,], decreasing = TRUE),
for.sort.list = for(x in seq_len(nrow(a))) a[x,] <- a[x,][sort.list(a[x,], decreasing = TRUE, method="radix")])
gives:
Unit: microseconds
expr min lq mean median uq max neval cld
dc.lapply.sort 189.811 206.5890 222.52223 217.8070 228.0905 332.034 100 c
t.apply.sort 185.474 200.4515 212.59608 210.4930 220.0025 286.288 100 bc
for.order 82.631 91.1860 98.66552 97.8475 102.9680 176.666 100 a
for.sort 167.939 187.5025 192.90728 192.1195 198.8690 256.494 100 b
for.sort.list 187.617 206.4475 230.82960 215.7060 221.6115 1541.343 100 c
It should be noted however that benchmarks are only meaningful on larger datasets, so:
set.seed(123)
a <- matrix(rbinom(10e5, 10, 0.3), ncol = 10)
microbenchmark(dc.lapply.sort = do.call(rbind, lapply(split(a, row(a)), sort, decreasing = TRUE)),
t.apply.sort = t(apply(a, 1, sort, decreasing = TRUE)),
for.order = for(i in 1:nrow(a)) a[i,] <- a[i,][order(a[i,], decreasing = TRUE)],
for.sort = for(i in 1:nrow(a)) a[i,] <- sort(a[i,], decreasing = TRUE),
for.sort.list = for(x in seq_len(nrow(a))) a[x,] <- a[x,][sort.list(a[x,], decreasing = TRUE, method="radix")],
times = 10)
gives:
Unit: seconds
expr min lq mean median uq max neval cld
dc.lapply.sort 6.790179 6.924036 7.036330 7.013996 7.121343 7.351729 10 d
t.apply.sort 5.032052 5.057022 5.151560 5.081459 5.177159 5.538416 10 c
for.order 1.368351 1.463285 1.514652 1.471467 1.583873 1.736544 10 a
for.sort 5.028314 5.102993 5.317597 5.154104 5.348614 6.123278 10 c
for.sort.list 2.417857 2.464817 2.573294 2.519408 2.726118 2.815964 10 b
Conclusion: the for-loop in combination with order is still the fastest solution.
Using the order2 and sort2 functions of the grr-package can give a further improvement in speed. Comparing them with the fastest solution from above:
set.seed(123)
a <- matrix(rbinom(10e5, 10, 0.3), ncol = 10)
microbenchmark(for.order = for(i in 1:nrow(a)) a[i,] <- a[i,][order(a[i,], decreasing = TRUE)],
for.order2 = for(i in 1:nrow(a)) a[i,] <- a[i,][rev(grr::order2(a[i,]))],
for.sort2 = for(i in 1:nrow(a)) a[i,] <- rev(grr::sort2(a[i,])),
times = 10)
giving:
Unit: milliseconds
expr min lq mean median uq max neval cld
for.order 1243.8140 1263.4423 1316.4662 1305.1823 1378.5836 1404.251 10 c
for.order2 956.1536 962.8226 1110.1778 1090.9984 1233.4241 1368.416 10 b
for.sort2 830.1887 843.6765 920.5668 847.1601 972.8703 1144.135 10 a
t(apply(a, 1, sort, decreasing = TRUE)) gives:
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
# [1,] 6 6 5 4 4 2 2 1 1 1
# [2,] 5 4 4 4 4 3 3 3 3 1
# [3,] 4 4 4 4 3 3 3 3 3 2
# [4,] 7 5 4 4 4 3 2 2 1 0
# [5,] 5 4 4 3 3 2 2 1 1 0
# [6,] 5 4 3 3 3 2 2 2 1 1
# [7,] 6 4 4 4 3 3 2 2 2 1
# [8,] 5 5 4 4 3 3 3 2 1 1
# [9,] 5 5 4 3 3 2 2 2 2 2
# [10,] 6 5 3 3 3 2 2 2 1 1
I did also microbenchmarking and it seems that the order solutions win :)
> microbenchmark(jaap1 = do.call(rbind, lapply(split(a, row(a)), sort, decreasing = TRUE)),
+ apom = t(apply(a, 1, sort, decreasing = TRUE)),
+ jaap2 = for(i in 1:nrow(a)) a[i,] <- a[i,][order(a[i,], decreasing = TRUE)],
+ jaap3 = for(i in 1:nrow(a)) a[i,] <- sort(a[i,], decreasing = TRUE),
+ alpha = t(apply(a, 1, function(x) order(x, decreasing = T))),
+ times = 1000L)
Unit: microseconds
expr min lq mean median uq max neval
jaap1 318.193 364.6125 404.3224 389.5845 417.6405 1422.087 1000
apom 276.764 340.2740 389.1302 364.9650 398.3680 2854.710 1000
jaap2 121.332 158.4845 189.5616 182.2070 202.2390 1170.602 1000
jaap3 247.387 309.2445 351.6959 332.2710 365.3640 1361.720 1000
alpha 139.244 178.7460 209.6122 202.8580 226.7585 1092.301 1000
I am trying to create a block circulant matrix in R. The structure of a block circulant matrix is given below.
C0 C1 ... Cn-1
Cn-1 C0 C1 ... Cn-2
Cn-2 Cn-1 .... Cn-3
and so on
I have the blocks
C0 .... Cn-1
What is the easiest way to create the matrix. Is there a function already available?
Thanks for a challenging question! Here is a solution summing kronecker products of your matrices with sub- and super-diagonals.
Sample data, a list of matrices:
C <- lapply(1:3, matrix, nrow = 2, ncol = 2)
My solution:
bcm <- function(C) {
require(Matrix)
n <- length(C)
Reduce(`+`, lapply((-n+1):(n-1),
function(i) kronecker(as.matrix(bandSparse(n, n, -i)),
C[[1 + (i %% n)]])))
}
bcm(C)
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 1 1 3 3 2 2
# [2,] 1 1 3 3 2 2
# [3,] 2 2 1 1 3 3
# [4,] 2 2 1 1 3 3
# [5,] 3 3 2 2 1 1
# [6,] 3 3 2 2 1 1
I don't know if this is particularly efficient, but as I interpret your question it does what you want.
rotList <- function(L,n) {
if (n==0) return(L)
c(tail(L,n),head(L,-n))
}
rowFun <- function(n,matList) do.call(rbind,rotList(matList,n))
bcMat <- function(matList) {
n <- length(matList)
do.call(cbind,lapply(0:(n-1),rowFun,matList))
}
Example:
bcMat(list(diag(3),matrix(1:9,nrow=3),matrix(4,nrow=3,ncol=3)))
I think what you are looking for is circulant.matrix from the lgcp package.
If x is a matrix whose columns are the bases of the sub-blocks of a
block circulant matrix, then this function returns the block circulant
matrix of interest.
eg
x <- matrix(1:8,ncol=4)
circulant(x)
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
# [1,] 1 2 3 4 5 6 7 8
# [2,] 2 1 4 3 6 5 8 7
# [3,] 7 8 1 2 3 4 5 6
# [4,] 8 7 2 1 4 3 6 5
# [5,] 5 6 7 8 1 2 3 4
# [6,] 6 5 8 7 2 1 4 3
# [7,] 3 4 5 6 7 8 1 2
# [8,] 4 3 6 5 8 7 2 1
Alternative approach
Here is a highly inefficient approach using kronecker and Reduce
bcirc <- function(list.blocks){
P <- lapply(seq_along(list.blocks), function(x,y) x ==y, x = circulant(seq_along(list.blocks)))
Reduce('+',Map(P = P, A=list.blocks, f = function(P,A) kronecker(P,A)))
}
benchmarking with #flodel and #Ben Bolker
lbirary(microbenchmark)
microbenchmark(bcm(C), bcirc(C), bcMat(C))
Unit: microseconds
expr min lq median uq max neval
bcm(C) 10836.719 10925.7845 10992.8450 11141.1240 21622.927 100
bcirc(C) 444.983 455.7275 479.5790 487.0370 569.105 100
bcMat(C) 288.558 296.4350 309.8945 348.4215 2190.231 100
Is something like this what you are looking for?
> vec <- 1:4
> sapply(rev(seq_along(vec)),function(x) c(tail(vec,x),head(vec,-x)) )
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 3 4 1
[3,] 3 4 1 2
[4,] 4 1 2 3
So I am trying to sum the rows of a matrix, and there are inf's within it. How do I sum the row, omitting the inf's?
Multiply your matrix by the result of is.finite(m) and call rowSums on the product with na.rm=TRUE. This works because Inf*0 is NaN.
m <- matrix(c(1:3,Inf,4,Inf,5:6),4,2)
rowSums(m*is.finite(m),na.rm=TRUE)
A[is.infinite(A)]<-NA
rowSums(A,na.rm=TRUE)
Some benchmarking for comparison:
library(microbenchmark)
rowSumsMethod<-function(A){
A[is.infinite(A)]<-NA
rowSums(A,na.rm=TRUE)
}
applyMethod<-function(A){
apply( A , 1 , function(x){ sum(x[!is.infinite(x)])})
}
rowSumsMethod2<-function(m){
rowSums(m*is.finite(m),na.rm=TRUE)
}
rowSumsMethod0<-function(A){
A[is.infinite(A)]<-0
rowSums(A)
}
A1 <- matrix(sample(c(1:5, Inf), 50, TRUE), ncol=5)
A2 <- matrix(sample(c(1:5, Inf), 5000, TRUE), ncol=5)
microbenchmark(rowSumsMethod(A1),rowSumsMethod(A2),
rowSumsMethod0(A1),rowSumsMethod0(A2),
rowSumsMethod2(A1),rowSumsMethod2(A2),
applyMethod(A1),applyMethod(A2))
Unit: microseconds
expr min lq median uq max neval
rowSumsMethod(A1) 13.063 14.9285 16.7950 19.3605 1198.450 100
rowSumsMethod(A2) 212.726 220.8905 226.7220 240.7165 307.427 100
rowSumsMethod0(A1) 11.663 13.9960 15.3950 18.1940 112.894 100
rowSumsMethod0(A2) 103.098 109.6290 114.0610 122.9240 159.545 100
rowSumsMethod2(A1) 8.864 11.6630 12.5960 14.6955 49.450 100
rowSumsMethod2(A2) 57.380 60.1790 63.4450 67.4100 81.172 100
applyMethod(A1) 78.839 84.4380 92.1355 99.8330 181.005 100
applyMethod(A2) 3996.543 4221.8645 4338.0235 4552.3825 6124.735 100
So Joshua's method wins! And apply method is clearly slower than two other methods (relatively speaking of course).
I'd use apply and is.infinite in order to avoid replacing Inf values by NA as in #Hemmo's answer.
> set.seed(1)
> Mat <- matrix(sample(c(1:5, Inf), 50, TRUE), ncol=5)
> Mat # this is an example
[,1] [,2] [,3] [,4] [,5]
[1,] 2 2 Inf 3 5
[2,] 3 2 2 4 4
[3,] 4 5 4 3 5
[4,] Inf 3 1 2 4
[5,] 2 5 2 5 4
[6,] Inf 3 3 5 5
[7,] Inf 5 1 5 1
[8,] 4 Inf 3 1 3
[9,] 4 3 Inf 5 5
[10,] 1 5 3 3 5
> apply(Mat, 1, function(x) sum(x[!is.infinite(x)]))
[1] 12 15 21 10 18 16 12 11 17 17
Try this...
m <- c( 1 ,2 , 3 , Inf , 4 , Inf ,5 )
sum(m[!is.infinite(m)])
Or
m <- matrix( sample( c(1:10 , Inf) , 100 , rep = TRUE ) , nrow = 10 )
sums <- apply( m , 1 , FUN = function(x){ sum(x[!is.infinite(x)])})
> m
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 8 9 7 Inf 9 2 2 6 1 Inf
[2,] 8 7 4 5 9 5 8 4 7 10
[3,] 7 9 3 4 7 3 3 6 9 4
[4,] 7 Inf 2 6 4 8 3 1 9 9
[5,] 4 Inf 7 5 9 5 3 5 9 9
[6,] 7 3 7 Inf 7 3 7 3 7 1
[7,] 5 7 2 1 Inf 1 9 8 1 5
[8,] 4 Inf 10 Inf 8 10 4 9 7 2
[9,] 10 7 9 7 2 Inf 4 Inf 4 6
[10,] 9 4 6 3 9 6 6 5 1 8
> sums
[1] 44 67 55 49 56 45 39 54 49 57
This is a "non-apply" and non-destructive approach:
rowSums( matrix(match(A, A[is.finite(A)]), nrow(A)), na.rm=TRUE)
[1] 2 4
Although it is reasonably efficient, it is not as fast as Johsua's multiplication method.