Putting a sequence into a matrix around existing values - r

I want to generate a symmetric matrix around a diagonal of zeroes and a predetermined sequence around them. In theory the lines should show as
0 1 3 5 7 9
1 0 3 5 7 9
I've tried tweaking with the conditionals, but I suspect that it's wonky because of indexing, which I am nowhere near skilled enough to fix.
bend <- function(n){
m <- seq(1, n, by=2)
a <- length(m)
y <- matrix(nrow= a, ncol = a, byrow= TRUE)
y <- ifelse(row(y) == col(y), 0, m)
y
}
Assuming that the input is a 9, expected output is
0 1 3 5 7 9
1 0 3 5 7 9
1 3 0 5 7 9
1 3 5 0 7 9
1 3 5 7 0 9
1 3 5 7 9 0
Actual output is
0 3 5 7 9 1
3 0 7 9 1 3
5 7 0 1 3 5
7 9 1 0 5 7
9 1 3 5 0 9
1 3 5 7 9 0

There's a simpler way to do what you need. You can start off by creating a matrix of length(x) + 1 columns and rows with all elements as a logical TRUE. Then make the diagonal FALSE using diag(). Now you can replace the TRUEs with your desired vector. The diagonal being FALSE is not affected. Since the values are replaced column-wise you need a final transpose t() to get correct result.
This way, you don't need to worry about tracking indices.
x <- c(1,3,5,7,9)
make_matrix <- function(x) {
m <- matrix(TRUE, ncol = length(x) + 1, nrow = length(x) + 1)
diag(m) <- FALSE
m[m] <- x
t(m)
}
make_matrix(x)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 1 3 5 7 9
[2,] 1 0 3 5 7 9
[3,] 1 3 0 5 7 9
[4,] 1 3 5 0 7 9
[5,] 1 3 5 7 0 9
[6,] 1 3 5 7 9 0
Here's another way with sapply. This creates the necessary row elements in each iteration and puts them in a matrix by column. Again, you need a t() to get correct results. -
sapply(0:length(x), function(a) append(x, 0, after = a)) %>% t()
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 1 3 5 7 9
[2,] 1 0 3 5 7 9
[3,] 1 3 0 5 7 9
[4,] 1 3 5 0 7 9
[5,] 1 3 5 7 0 9
[6,] 1 3 5 7 9 0
Benchmarks -
sapply is slower, likely because it's creating the matrix elements one row at a time and calls append for every row. All this overhead is avoided in the make_matrix() approach.
x <- sample(100)
microbenchmark(
make_matrix = make_matrix(x),
sapply = t(sapply(0:length(x), function(a) append(x, 0, after = a))),
akrun_forloop = {
n <- length(x) + 1
m1 <- matrix(0, n, n)
for(i in seq_len(nrow(m1))) m1[i, -i] <- x
},
times = 1000
)
Unit: microseconds
expr min lq mean median uq max neval
make_matrix 111.495 117.5610 128.3135 126.890 135.7540 225.323 1000
sapply 520.620 551.1765 592.2642 573.335 602.2585 10477.221 1000
akrun_forloop 3380.292 3526.3080 3837.1570 3648.765 3812.5075 20943.245 1000

Using a simple for loop
n <- length(x) + 1
m1 <- matrix(0, n, n)
for(i in seq_len(nrow(m1))) m1[i, -i] <- x
m1
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] 0 1 3 5 7 9
#[2,] 1 0 3 5 7 9
#[3,] 1 3 0 5 7 9
#[4,] 1 3 5 0 7 9
#[5,] 1 3 5 7 0 9
#[6,] 1 3 5 7 9 0
data
x <- c(1,3,5,7,9)

Related

How can I create this exact 5x5 matrix using only for loops?

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 I was given this matrix and was told to create it using only for loops. What i have done so far is using cbind(0:4,1+(0:4),2+(0:4),3+(0:4),4+(0:4)) but i cant figure out a way to do so with the for function.
You were on the right track. If you rewrite your current
cbind(0:4,1+(0:4),2+(0:4),3+(0:4),4+(0:4))
as
cbind(0+(0:4),1+(0:4),2+(0:4),3+(0:4),4+(0:4))
you might notice that the thing that you are adding to 0:4 is implicitly a loop index.
Make it explicit:
m = c()
for(i in 0:4){
m = cbind(m,i+(0:4))
}
print(m)
Output:
[,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
One way:
mat <- matrix(0L, nrow=5, ncol=5)
for (i in 0:4) {
for (j in 0:4) {
mat[i + 1, j + 1] <- i + j
}
}
# [,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
And technically *apply functions are loops as well:
sapply(0:4, \(x) 0:4 + x)
You can just create an empty matrix first and then fill it with two for-loops iterating over rows and columns. Playing a little bit around with the variable to write into the matrix (count) I figured out that this is a suitable solution.
matrix2fill <- matrix(NA, 5,5)
count = 0
for (i in 1:5){
for (j in 1:5){
matrix2fill[j,i] = count
count = count + 1
}
count = i
}
matrix2fill
[,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
Yet another way:
mymat <- matrix(NA, nrow = 5, ncol = 5)
i_mat <- 1
for (i in 0:4) {
mymat[seq(i_mat, i_mat + 4)] <- seq(i, i + 4)
i_mat <- i_mat + 5
}
mymat
[,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:
a = matrix(1:25, nrow=5, ncol=5)
for (i in 1:5) {
for (j in 1:5) {
a[i][j] = (i-1) + (j-1)
}
}
print(a)

Applying a function that takes columns and rows of matrices as input with a matrix as output without using loop

I would like to write a function that takes columns and rows of matrices as arguments and gives a matrix as an output.
For example, a function that takes rows i of an m by k matrix A and columns j of a k by n matrix B, and return a matrix M with elements m_i,j that equals to min(A[i,] * B[,j]) (element-wise multiplication):
Is there any simple way to avoid using loops? Does an sapply equivalent for matrices exists?
> matrix_A
[,1] [,2] [,3] [,4] [,5]
[1,] 1 2 3 4 5
[2,] 2 3 4 5 6
[3,] 3 4 5 6 7
[4,] 0 1 2 3 4
[5,] 5 6 7 8 9
> matrix_B
[,1] [,2] [,3] [,4] [,5]
[1,] 7 6 5 4 3
[2,] 6 5 4 3 2
[3,] 1 2 3 4 5
[4,] 8 7 6 5 4
[5,] 9 8 7 6 5
>
> output_matrix <- matrix(, nrow=nrow(matrix_A), ncol=ncol(matrix_B))
> for (row_i in 1:nrow(matrix_A)) {
+ for (col_j in 1:ncol(matrix_B)) {
+ output_matrix[row_i, col_j] <- min(matrix_A[row_i,]*matrix_B[,col_j])
+ }
+ }
> output_matrix
[,1] [,2] [,3] [,4] [,5]
[1,] 3 6 5 4 3
[2,] 4 8 10 8 6
[3,] 5 10 15 12 8
[4,] 0 0 0 0 0
[5,] 7 14 21 18 12
>
Using apply from base R,
apply(m2, 2, function(i) apply(m1, 1, function(j) min(j*i)))
which gives,
[,1] [,2] [,3] [,4] [,5]
[1,] 3 6 5 4 3
[2,] 4 8 10 8 6
[3,] 5 10 15 12 8
[4,] 0 0 0 0 0
[5,] 7 14 21 18 12
A fully vectorized solution can be,
t(matrix(do.call(pmin,
as.data.frame(
do.call(rbind, rep(split(m1, 1:nrow(m1)), each = 5)) * do.call(rbind, rep(split(t(m2), 1:nrow(m2)), 5)))),
nrow(m1)))
You can avoid R loops (*apply functions are loops too) for this specific example. Often an efficient solution is possible, but needs a specific algorithm as I demonstrate here. If you don't need to optimize speed, use loops. Your for loop offers the best readability and is easy to understand.
matrix_A <- matrix(c(1,2,3,0,5,
2,3,4,1,6,
3,4,5,2,7,
4,5,6,3,8,
5,6,7,4,9), 5)
matrix_B <- matrix(c(7,6,1,8,9,
6,5,2,7,8,
5,4,3,6,7,
4,3,4,5,6,
3,2,5,4,5), 5)
#all combinations of i and j
inds <- expand.grid(seq_len(nrow(matrix_A)), seq_len(ncol(matrix_B)))
#subset A and transposed B then multiply the resulting matrices
#then calculate rowwise min and turn result into a matrix
library(matrixStats)
matrix(rowMins(matrix_A[inds[[1]],] * t(matrix_B)[inds[[2]],]), nrow(matrix_A))
# [,1] [,2] [,3] [,4] [,5]
#[1,] 3 6 5 4 3
#[2,] 4 8 10 8 6
#[3,] 5 10 15 12 8
#[4,] 0 0 0 0 0
#[5,] 7 14 21 18 12
We use expand.grid to create all possible combinations of row and col pairs. We then use mapply to multiply all the row-column combination element wise and then select the min from it.
mat <- expand.grid(1:nrow(A),1:nrow(B))
mapply(function(x, y) min(matrix_A[x,] * matrix_B[, y]) , mat[,1], mat[,2])
#[1] 3 4 5 0 7 6 8 10 0 14 5 10 15 0 21 4 8 12 0 18 3 6 8 0 12
Assuming matrix_A, matrix_B and output_matrix all have the same dimensions we can relist the output from mapply to get the original dimensions.
output_matrix <- mapply(function(x, y) min(matrix_A[x,] * matrix_B[, y]),
mat[,1], mat[,2])
relist(output_matrix, matrix_A)
# [,1] [,2] [,3] [,4] [,5]
#[1,] 3 6 5 4 3
#[2,] 4 8 10 8 6
#[3,] 5 10 15 12 8
#[4,] 0 0 0 0 0
#[5,] 7 14 21 18 12
Here we use pmap to iterate over the rows and columns of A and B:
library(tidyverse)
pmap_dbl(expand.grid(1:nrow(A), 1:nrow(B)), ~ min(A[..1, ] * B[ , ..2])) %>%
matrix(nrow=5)
[,1] [,2] [,3] [,4] [,5]
[1,] 3 6 5 4 3
[2,] 4 8 10 8 6
[3,] 5 10 15 12 8
[4,] 0 0 0 0 0
[5,] 7 14 21 18 12

Individual shift of each column in a matrix

I look for a R-code that transform the matrix as follows (a: the original matrix, b: the desired output), example:
a <- matrix(c(1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6), nrow = 6, ncol = 4)
b <- matrix(c(1,2,3,4,5,6,2,3,4,5,6,0,3,4,5,6,0,0,4,5,6,0,0,0), nrow = 6, ncol = 4)
a
[,1] [,2] [,3] [,4]
[1,] 1 1 1 1
[2,] 2 2 2 2
[3,] 3 3 3 3
[4,] 4 4 4 4
[5,] 5 5 5 5
[6,] 6 6 6 6
b
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 3 4 5
[3,] 3 4 5 6
[4,] 4 5 6 0
[5,] 5 6 0 0
[6,] 6 0 0 0
Thus, the first column is not shifted, the second column is shifted up one step, the third column shifted up two steps, and so on. The shifted columns are padded with zeros.
The following links didn't help me (nor: double for-loop, a function with different variables, the codes diag or kronecker).
R: Shift values in single column of dataframe UP
r matrix individual shift operations of elements
Rotate a Matrix in R
Have you any ideas? Thanks.
This seems to work with data.table. Should perform well with a large matrix:
library(data.table)
# One way
dt[, shift(.SD, 0:3, 0, "lead", FALSE), .SDcols = 1]
# Alternatively
dt[, shift(dt, 0:3, 0, "lead", FALSE)][, 1:4]
Both return:
V1 V2 V3 V4
1: 1 2 3 4
2: 2 3 4 5
3: 3 4 5 6
4: 4 5 6 0
5: 5 6 0 0
6: 6 0 0 0
Using the following data:
a <- matrix(c(1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6), nrow = 6, ncol = 4)
dt <- setDT(as.data.frame(a))
I have a raw solution using sapply. You shift your column on each iteration of sapply, and then sapply concatenate all the output, that you can feed to matrix with the good size (the size of your initial matrix)
matrix(sapply(1:dim(a)[2], function(x){c(a[x:dim(a)[1], x], rep(0, (x - 1) ))}), ncol = dim(a)[2], nrow = dim(a)[1])
[,1] [,2] [,3] [,4]
[1,] 1 2 3 4
[2,] 2 3 4 5
[3,] 3 4 5 6
[4,] 4 5 6 0
[5,] 5 6 0 0
[6,] 6 0 0 0
You can shift the columns by filling a matrix which have one row more than "a" with the values from "a" (a Warning is generated during the recycling). Select the original number of rows. Replace the lower right triangle with zeros.
nr <- nrow(a)
a2 <- matrix(a, ncol = ncol(a), nrow = nr + 1)[1:nr, ]
a2[col(a2) + row(a2) > nr + 1] <- 0
a2
# [,1] [,2] [,3] [,4]
# [1,] 1 2 3 4
# [2,] 2 3 4 5
# [3,] 3 4 5 6
# [4,] 4 5 6 0
# [5,] 5 6 0 0
# [6,] 6 0 0 0
Building on tyluRp's answer, which almost worked for me, I suggest to loop through all columns and call shift on each, individually. Let's start with a matrix of random numbers here:
a <- matrix(floor(10*runif(24)), ncol=4)
a
[,1] [,2] [,3] [,4]
[1,] 8 4 8 3
[2,] 0 6 9 0
[3,] 1 6 0 7
[4,] 0 3 9 7
[5,] 2 4 2 9
[6,] 4 8 5 6
library(data.table)
dt <- setDT(as.data.frame(a))
Now the loop that does the job...
for (i in 2:length(dt)) dt[,i] <- shift(dt[,i,with=F],(i-1),0,"lead")
...by replacing columns with their shifted version.
The original answers replaced all columns by shifted copies of the first column, thus losing data. This is probably due to the group behaviour of data.table.

How do I convert this sparse matrix to the normal one?

I have a sparse matrix represented as
> (f <- data.frame(row=c(1,2,3,1,2,1,2,3,4,1,1,2),value=1:12))
row value
1 1 1
2 2 2
3 3 3
4 1 4
5 2 5
6 1 6
7 2 7
8 3 8
9 4 9
10 1 10
11 1 11
12 2 12
Here the first column is always present (in fact, the first few are present, the rest are not).
I want to get the data into the matrix format:
> t(matrix(c(1,2,3,NA,4,5,NA,NA,6,7,8,9,10,NA,NA,NA,11,12,NA,NA),nrow=4,ncol=5))
[,1] [,2] [,3] [,4]
[1,] 1 2 3 NA
[2,] 4 5 NA NA
[3,] 6 7 8 9
[4,] 10 NA NA NA
[5,] 11 12 NA NA
Here is what seems to be working:
> library(Matrix)
> as.matrix(sparseMatrix(i = cumsum(f[[1]] == 1), j=f[[1]], x=f[[2]]))
[,1] [,2] [,3] [,4]
[1,] 1 2 3 0
[2,] 4 5 0 0
[3,] 6 7 8 9
[4,] 10 0 0 0
[5,] 11 12 0 0
Except that I have to replace 0 with NA myself.
Is there a better solution?
You can do everything with base functions. The trick is to use indexing by a 2-col (row and col indices) matrix:
j <- f$row
i <- cumsum(j == 1)
x <- f$value
m <- matrix(NA, max(i), max(j))
m[cbind(i, j)] <- x
m
Whether it is better or not than using the Matrix package is subjective. Overkill in my opinion if you are not doing anything else with it. Also if your data had 0 in the f$value column, they would end up being converted as NA if you are not too careful.

Create a block circulant matrix in R

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

Resources