How to create a matrix with zeroes in blocks within the diagonal? - r

So I'm trying to create a 2000 * 2000 matrix that has 50*50 blocks of zeroes along the diagonal, and 1's everywhere else.
Here is a miniature example of what I mean. a is a 6x6 matrix with 1's and each block is a 2*2 matrix with zeroes along the diagonal
a <- matrix(rep(1, times = 36), nrow = 6, byrow = TRUE)
a[1:2,1:2] <- 0
a[3:4,3:4] <- 0
a[5:6,5:6] <- 0
giving
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 1 1 1 1
[2,] 0 0 1 1 1 1
[3,] 1 1 0 0 1 1
[4,] 1 1 0 0 1 1
[5,] 1 1 1 1 0 0
[6,] 1 1 1 1 0 0
Of course my choice of code is bad for creating such a big matrix, as I would have to repeat the bottom part 50 times.
What would be a much better code to create this type of matrix?

rawr is correct,
a <- +!kronecker(diag(1, 3), matrix(1, 2, 2))
gives
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 1 1 1 1
[2,] 0 0 1 1 1 1
[3,] 1 1 0 0 1 1
[4,] 1 1 0 0 1 1
[5,] 1 1 1 1 0 0
[6,] 1 1 1 1 0 0
and +!kronecker(diag(1, 40), matrix(1, 50, 50)) solves my original question with the 2000*2000 matrix

Related

Making a chess matrix

So I'm using r and I'd like to make a code that takes a value of n, creates a n x n matrix that has alternating 1's and 0's.
E.g:
I can't seem to do this without getting an error or warning and it won't work for all integers of n, any help would be appreciated, thanks.
what about this?
n <- 5L
matrix(seq(1:n^2) %% 2, nrow = n)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 1 0 1
[2,] 0 1 0 1 0
[3,] 1 0 1 0 1
[4,] 0 1 0 1 0
[5,] 1 0 1 0 1
Try the code below
m <- matrix(rep_len(c(1, 0), n^2), n)
or
m <- replace(m <- diag(n), !((row(m) - col(m)) %% 2), 1)
which gives
> m
[,1] [,2] [,3] [,4] [,5]
[1,] 1 0 1 0 1
[2,] 0 1 0 1 0
[3,] 1 0 1 0 1
[4,] 0 1 0 1 0
[5,] 1 0 1 0 1

Extracting indices from an R matrix to form a new matrix, using for-loops

I am learning R, and currently am learning about loops.
I have a task to create a function ans(A) which:
1) Takes as input a 10x10 matrix A, with values 1 and 0. (so like "true and false")
2) Takes the elements which are value 1, and saves them in a new 2-column matrix. The first column is the row index, and the second column is the column index. It then returns this new index matrix. The index matrix is formed with matrix().
The task suggests the use of two nested for-loops
I'm not really sure how to do this task, particularly with for-loops. The input matrix A can be created for example by a simple diag(10), before the function itself, and then used as the input for the function for testing purposes.
The function would using for-loops take the diagonal indices and insert them into a new matrix and then return it as the answer.
For the case you describe there is no need for any kind of loop:
set.seed(42)
mat <- matrix(sample(0:1, 100, replace = T), ncol=10)
mat.ind <- which(mat==T, arr.ind=T)
> mat
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 0 1 1 0 0 1 0 1 1
[2,] 1 1 0 1 0 0 1 0 0 0
[3,] 0 1 1 0 0 0 1 0 0 0
[4,] 1 0 1 1 1 1 1 0 1 1
[5,] 1 0 0 0 0 0 1 0 1 1
[6,] 1 1 1 1 1 1 0 1 1 1
[7,] 1 1 0 0 1 1 0 0 0 0
[8,] 0 0 1 0 1 0 1 0 0 1
[9,] 1 0 0 1 1 0 1 1 0 1
[10,] 1 1 1 1 1 1 0 0 0 1
> mat.ind
row col
[1,] 1 1
[2,] 2 1
[3,] 4 1
[4,] 5 1
[5,] 6 1
[6,] 7 1
... ... ...

producing a full adjacency matrix from partial information

I have a matrix that contains all the info necessary to construct 5x5 adjacency matrices. Each row represents one matrix:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 1 1 1 1 1 1 0 1 0
[2,] 0 0 0 1 1 1 1 0 1 0
...
I want to create an adjacency matrix from the nth row of data. For the first row of have, the want matrix would look like this:
[,1] [,2] [,3] [,4] [,5]
[1,] 0 1 1 1 1
[2,] 1 0 1 1 1
[3,] 1 1 0 0 1
[4,] 1 1 0 0 0
[5,] 1 1 1 0 0
How do I get from have to want?
Here is an option using lower.tri and upper.tri
unlist(apply(mat, 1, function(x) {
m <- matrix(0, nrow = 5, ncol = 5)
m[lower.tri(m)] <- x
m[upper.tri(m)] <- x
list(m)
}), recursive = F)
#[[1]]
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 1 1 1 1
#[2,] 1 0 1 1 0
#[3,] 1 1 0 1 1
#[4,] 1 1 0 0 0
#[5,] 1 1 1 0 0
#
#[[2]]
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 0 0 1 1
#[2,] 0 0 0 1 0
#[3,] 0 1 0 1 1
#[4,] 0 1 0 0 0
#[5,] 1 1 1 0 0
The unlist(..., recursive = F) part seems somewhat awkward but is necessary to prevent apply from simplifying the result and dropping dims. An alternative would be to use lapply on a data.frame instead of a matrix:
lapply(as.data.frame(t(mat)), function(x) {
m <- matrix(0, nrow = 5, ncol = 5)
m[lower.tri(m)] <- x
m[upper.tri(m)] <- x
return(m)
})
giving the same result.
Sample data
mat <- as.matrix(read.table(text =
"1 1 1 1 1 1 1 0 1 0
0 0 0 1 1 1 1 0 1 0", header = F))
colnames(mat) <- NULL

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.

How to modify matrix multiplication to sum only positives or negatives values in R

I want to do a matrix multiplication with a twist.
I have this matrix:
A <- matrix(c(1,-1,-1,0,-1,0,1,0,0,1,0,0,0,1,-1,1,-1,0,0,-1,1,0,1,0,1,-1,-1,1,-1,1), nrow = 6, ncol = 5)
A
[,1] [,2] [,3] [,4] [,5]
[1,] 1 1 0 0 1
[2,] -1 0 1 -1 -1
[3,] -1 0 -1 1 -1
[4,] 0 1 1 0 1
[5,] -1 0 -1 1 -1
[6,] 0 0 0 0 1
And I want to get two different matrices. The first matrix is this:
C
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 0 0 2 0 1
[2,] 0 0 2 1 2 0
[3,] 0 2 0 0 4 0
[4,] 2 1 0 0 0 1
[5,] 0 2 4 0 0 0
[6,] 1 0 0 1 0 0
This "convergence matrix" is something like the multiplication of A for its transpose (in R is something like this A%*%t(A)), but with a little twist, during the sum to obtain each cell I only want de sum of the positives values. For example, for the cell C23 the regular sum would be:
(-1)(-1) + (0)(0) + (1)(-1) + (-1)(1) + (-1)(-1) = 0
, but I only want the sum of the positive products, in this example the first [(-1)(-1)] and the last [(-1)(-1)] to obtain 2.
The second matrix is this:
D
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 2 2 0 2 0
[2,] 2 0 2 1 2 1
[3,] 2 2 0 2 0 1
[4,] 0 1 2 0 2 0
[5,] 2 2 0 2 0 1
[6,] 0 1 1 0 1 0
This "divergence matrix" is similar to the previous one, with the difference that I only want to sum de absolute values of the negative values. For example, for the cell D23 the regular sum would be:
(-1)(-1) + (0)(0) + (1)(-1) + (-1)(1) + (-1)(-1) = 0
, but I only want the sum of the absolute values of negative products, in this example the third abs [(1)(-1)] and the fourth abs[(-1)(-1)] to obtain 2.
I've been trying with apply, sweep and loops but I can't get it.
Thanks for your responses.
Another take:
D <- A
D[D<0] = -1i*D[D<0]
D <- Im(tcrossprod(D))
C <- tcrossprod(A) + D
A is defined in the question.
Output:
> D
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 2 2 0 2 0
[2,] 2 0 2 1 2 1
[3,] 2 2 0 2 0 1
[4,] 0 1 2 0 2 0
[5,] 2 2 0 2 0 1
[6,] 0 1 1 0 1 0
> C
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 3 0 0 2 0 1
[2,] 0 4 2 1 2 0
[3,] 0 2 4 0 4 0
[4,] 2 1 0 3 0 1
[5,] 0 2 4 0 4 0
[6,] 1 0 0 1 0 1
This is a try in base R. So basically you follow the matrix cross-product approach but you try to manage the sum step manually:
f <- function(A, convergence=TRUE){
sapply(seq_len(nrow(A)), function(i) {
r <- t(matrix(A[i,],ncol(A),nrow(A)))*A
if(convergence)
r[r<0] <- 0
else
r[r>0] <- 0
rowSums(abs(r))
})
}
> f(A, convergence = TRUE)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 3 0 0 2 0 1
[2,] 0 4 2 1 2 0
[3,] 0 2 4 0 4 0
[4,] 2 1 0 3 0 1
[5,] 0 2 4 0 4 0
[6,] 1 0 0 1 0 1
> f(A, convergence = FALSE)
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0 2 2 0 2 0
[2,] 2 0 2 1 2 1
[3,] 2 2 0 2 0 1
[4,] 0 1 2 0 2 0
[5,] 2 2 0 2 0 1
[6,] 0 1 1 0 1 0
It will be significantly less efficient, but you could break the matrix into a list of row vectors, which are easier to calculate with. Using purrr, which is handy for lists,
library(purrr)
A <- matrix(c(1,-1,-1,0,-1,0,1,0,0,1,0,0,0,1,-1,1,-1,0,0,-1,1,0,1,0,1,-1,-1,1,-1,1),
nrow = 6, ncol = 5)
C <- seq(nrow(A)) %>% # generate a sequence of row indices
map(~A[.x, ]) %>% # subset matrix into a list of rows
cross2(., .) %>% # do a Cartesian join to get pairs of rows
# calculate products, then subset before summing. Simplify to vector
map_dbl(~{ij <- .x[[1]] * .x[[2]]; sum(ij[ij >= 0])}) %>%
matrix(nrow(A)) # reassemble to matrix
C
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 3 0 0 2 0 1
#> [2,] 0 4 2 1 2 0
#> [3,] 0 2 4 0 4 0
#> [4,] 2 1 0 3 0 1
#> [5,] 0 2 4 0 4 0
#> [6,] 1 0 0 1 0 1
# same except subsetting and `-` to make negatives positive
D <- seq(nrow(A)) %>%
map(~A[.x, ]) %>%
cross2(., .) %>%
map_dbl(~{ij <- .x[[1]] * .x[[2]]; sum(-ij[ij <= 0])}) %>%
matrix(nrow(A))
D
#> [,1] [,2] [,3] [,4] [,5] [,6]
#> [1,] 0 2 2 0 2 0
#> [2,] 2 0 2 1 2 1
#> [3,] 2 2 0 2 0 1
#> [4,] 0 1 2 0 2 0
#> [5,] 2 2 0 2 0 1
#> [6,] 0 1 1 0 1 0

Resources