Summing rows of rolling columns - r

I need to apply a rolling function that sums the rows of every two columns, so the rows of columns 1&2 will be summed, 3&4, etc.
m<-matrix(c(1,2,3,4,5,3,4,5,6,2,4,6,6,7,3,2,4,4,5,7),nrow=2,byrow=T)
I have looked at many functions including apply, rollapply, aggregate, etc. but cant seem to find one that roll sums the rows of specified columns.
I am more than capable of writing the code out the long way however am looking for an efficient solution which most likely involves a function.
sum1<-(m[,1]+m[,2])
sum2<-(m[,3]+m[,4])
sum3<-(m[,5]+m[,6])
sum4<-(m[,7]+m[,8])
sum5<-(m[,9]+m[,10])
cbind(sum1,sum2,sum3,sum4,sum5)
Thanks!

You can use this approach:
m[,seq(1, ncol(m),2)] + m[,seq(2, ncol(m), 2)]
# [,1] [,2] [,3] [,4] [,5]
#[1,] 3 7 8 9 8
#[2,] 10 13 5 8 12

You can use a matrix multiply:
> n <- ncol(m)/2
> S <- diag(n)[rep(1:n, each=2),]
> S
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 0 0 0
[2,] 1 0 0 0 0
[3,] 0 1 0 0 0
[4,] 0 1 0 0 0
[5,] 0 0 1 0 0
[6,] 0 0 1 0 0
[7,] 0 0 0 1 0
[8,] 0 0 0 1 0
[9,] 0 0 0 0 1
[10,] 0 0 0 0 1
> m %*% S
[,1] [,2] [,3] [,4] [,5]
[1,] 3 7 8 9 8
[2,] 10 13 5 8 12

Another approach would be to convert m to a 3 dimensional array, then sum over the columns:
> X <- m
> dim(X) <- c(2,2,5)
> colSums(aperm(X, c(2,1,3)))
[,1] [,2] [,3] [,4] [,5]
[1,] 3 7 8 9 8
[2,] 10 13 5 8 12

Related

Transform Identity Matrix

I have identity matrix which can be generated via diag(5)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 0 0 0
[2,] 0 1 0 0 0
[3,] 0 0 1 0 0
[4,] 0 0 0 1 0
[5,] 0 0 0 0 1
I want to convert it to the matrix wherein series starts after 1. For example 1st column, values 1 through 5. Second column - values 1 through 4.
Desired Output
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 0 0 0
[2,] 2 1 0 0 0
[3,] 3 2 1 0 0
[4,] 4 3 2 1 0
[5,] 5 4 3 2 1
Try the code below (given m <- diag(5))
> (row(m) - col(m) + 1)*lower.tri(m,diag = TRUE)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 0 0 0
[2,] 2 1 0 0 0
[3,] 3 2 1 0 0
[4,] 4 3 2 1 0
[5,] 5 4 3 2 1
Another option is using apply + cumsum
> apply(lower.tri(m, diag = TRUE), 2, cumsum)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 0 0 0
[2,] 2 1 0 0 0
[3,] 3 2 1 0 0
[4,] 4 3 2 1 0
[5,] 5 4 3 2 1
1) If d <- diag(5) is the identity matrix then:
pmax(row(d) - col(d) + 1, 0)
giving:
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 0 0 0
[2,] 2 1 0 0 0
[3,] 3 2 1 0 0
[4,] 4 3 2 1 0
[5,] 5 4 3 2 1
2) This alternative is slightly longer (though still a one-liner) but also works if the columns of d are rearranged and/or some columns are missing. For example,
dd <- d[, 4:1] # test data
pmax(outer(1:nrow(dd) + 1, max.col(t(dd)), `-`), 0)
giving the same result for d and this for dd:
[,1] [,2] [,3] [,4]
[1,] 0 0 0 1
[2,] 0 0 1 2
[3,] 0 1 2 3
[4,] 1 2 3 4
[5,] 2 3 4 5
A solution based on nested cumsum:
n <- 5
m <- diag(n)
apply(m, 2, function(x) cumsum(cumsum(x)))
#> [,1] [,2] [,3] [,4] [,5]
#> [1,] 1 0 0 0 0
#> [2,] 2 1 0 0 0
#> [3,] 3 2 1 0 0
#> [4,] 4 3 2 1 0
#> [5,] 5 4 3 2 1
One option could be:
x <- 1:5
embed(c(rep(0, length(x) - 1), x), length(x))
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 0 0 0
[2,] 2 1 0 0 0
[3,] 3 2 1 0 0
[4,] 4 3 2 1 0
[5,] 5 4 3 2 1

Expand a matrix with filler values

Suppose I have a matrix like
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
I would like to expand it, to, say, 5x5, and fill the new cells with some given value (say 0), so that the new matrix looks like:
[,1] [,2] [,3] [,4] [,5]
[1,] 1 4 7 0 0
[2,] 2 5 8 0 0
[3,] 3 6 9 0 0
[4,] 0 0 0 0 0
[5,] 0 0 0 0 0
How could I do this with basic R functions?
We can create a matrix of 0s and assign
m2 <- matrix(0, 5, 5)
m2[seq_len(nrow(m1)), seq_len(ncol(m1))] <- m1
Or another option is bdiag
library(Matrix)
as.matrix(bdiag(m1, diag(2) * 0))
# [,1] [,2] [,3] [,4] [,5]
#[1,] 1 4 7 0 0
#[2,] 2 5 8 0 0
#[3,] 3 6 9 0 0
#[4,] 0 0 0 0 0
#[5,] 0 0 0 0 0
data
m1 <- matrix(1:9, 3, 3)

Working with matrix in R. Place an element in matrix

I have a distance matrix. For example :
d<-matrix(c(0,2,3,7,11,0,13,6,8,5,0,12,6,53,12,0), nrow = 4, ncol = 4)
d
[,1] [,2] [,3] [,4]
[1,] 0 11 8 6
[2,] 2 0 5 53
[3,] 3 13 0 12
[4,] 7 6 12 0
I want to create a neighbor matrix where distance is less than or equal to 5. In matrix nb, 1 indicates not a neighbor. However, they have no neighbor (excluding itself, for example, row 1 and row 4. I would like the one with the smallest distance to be their neighbor.
> nb=(d>=5)
> nb*1
[,1] [,2] [,3] [,4]
[1,] 0 1 1 1
[2,] 0 0 1 1
[3,] 0 1 0 1
[4,] 1 1 1 0
Expected result
[,1] [,2] [,3] [,4]
[1,] 0 1 1 0
[2,] 0 0 1 1
[3,] 0 1 0 1
[4,] 1 0 1 0
I have tried and I don't know how to get it efficiently without using loop. This is just an example, my actual data has over 9000 rows. Any suggestion would be helpful. Thank you so much!
I believe the following function does what you want.
fun <- function(Dist, n = 5){
nb <- (Dist > n)*1L
for(i in seq_len(nrow(nb))) {
tmp <- Dist[i, ]
tmp[tmp == 0] <- Inf
nb[i, which.min(tmp)] <- 0L
}
nb
}
fun(d)
# [,1] [,2] [,3] [,4]
#[1,] 0 1 1 0
#[2,] 0 0 0 1
#[3,] 0 1 0 1
#[4,] 1 0 1 0
fun(d, 10)
# [,1] [,2] [,3] [,4]
#[1,] 0 1 0 0
#[2,] 0 0 0 1
#[3,] 0 1 0 1
#[4,] 0 0 1 0

How to find the smallest values of list of matrices by column

Suppose I have a list of matrices. Suppose further that I would like to find the smallest value across each value of the matrices. For example,
y <- c(3,2,4,5,6, 4,5,5,6,7)
x[lower.tri(x,diag=F)] <- y
> x
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 3 0 0 0 0
[3,] 2 6 0 0 0
[4,] 4 4 5 0 0
[5,] 5 5 6 7 0
k <- c(1,4,5,2,5,-4,4,4,4,5)
z[lower.tri(z,diag=F)] <- k
> z
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 1 0 0 0 0
[3,] 4 5 0 0 0
[4,] 5 -4 4 0 0
[5,] 2 4 4 5 0
d <- list(k, x)
The expected output:
dd <– matrix(0,5,5)
dd
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 0 0 0
[2,] 1 0 0 0 0
[3,] 2 5 0 0 0
[4,] 4 -4 4 0 0
[5,] 2 4 4 5 0
We could use pmin to get the corresponding min value for each element across the list
do.call(pmin, d)
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 0 0 0 0
#[2,] 1 0 0 0 0
#[3,] 2 5 0 0 0
#[4,] 4 -4 4 0 0
#[5,] 2 4 4 5 0
data
d <- list(z, x)

Change the values in binary matrix only couple of columns

Consider the 8 by 6 binary matrix, M:
M <- matrix(c(0,0,1,1,0,0,1,1,
0,1,1,0,0,1,1,0,
0,0,0,0,1,1,1,1,
0,1,0,1,1,0,1,0,
0,0,1,1,1,1,0,0,
0,1,1,0,1,0,0,1),nrow = 8,ncol = 6)
Here is the M
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 0 0 0 0
[2,] 0 1 0 1 0 1
[3,] 1 1 0 0 1 1
[4,] 1 0 0 1 1 0
[5,] 0 0 1 1 1 1
[6,] 0 1 1 0 1 0
[7,] 1 1 1 1 0 0
[8,] 1 0 1 0 0 1
The following matrix contains the column index of the 1's in matrix M
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 3 2 5 2 3 2
[2,] 4 3 6 4 4 3
[3,] 7 6 7 5 5 5
[4,] 8 7 8 7 6 8
Let's denote that
ind <- matrix(c(3,4,7,8,
2,3,6,7,
5,6,7,8,
2,4,5,7,
3,4,5,6,
2,3,5,8),nrow = 4, ncol=6)
I'm trying to change a single position of 1 into 0only in SOME columns of M.
For an example, consider the case for changing two ones in every two columns. One possibility is given changing two positions in first two columns. Let N be the resulting matrices. This will produce the following matrix N
N <- matrix(c(0,0,0,1,0,0,1,1,
0,1,1,0,0,0,1,0,
0,0,0,0,1,1,1,1,
0,1,0,1,1,0,1,0,
0,0,1,1,1,1,0,0,
0,1,1,0,1,0,0,1),nrow = 8,ncol = 6)
Here is that N
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 0 0 0 0
[2,] 0 1 0 1 0 1
[3,] 0 1 0 0 1 1
[4,] 1 0 0 1 1 0
[5,] 0 0 1 1 1 1
[6,] 0 0 1 0 1 0
[7,] 1 1 1 1 0 0
[8,] 1 0 1 0 0 1
For EACH of the resulting matrices of N, I do the following calculations.
X <- cbind(c(rep(1,nrow(N))),N)
ans <- sum(diag(solve(t(X)%*%X)[-1,-1]))
Then, I want to obtain the matrix N, which produce the smallest value of ans. This 8 by 6 matrix is just one example. How do I do this?
I asked a question similar to this one before which changes positions in every column. Here is the link to that.

Resources