Given a random Bernoulli matrix with probability given, how do I check there exists a path starting from the centre point outwards?
Let n be the row and column dimension of the matrix m and use the code in the question to generate it. We use 3 here so we can show the results compactly. From this we will produce a graph whose node numbers are 1, 2, ..., n^2 which we show using the matrix function next. We then iterate colleage in mazeGen over the nodes to generate an adjacency list L, convert that to an undirected igraph g, plot it (graph is at very end) and show the distances between every pair of nodes.
In the plot the center cell (5) in the matrix is represented by a white circle, the zero cells are red and the remaining 1 cells are green.
In the distance matrix the distance is measured along edges of the graph, not by steps in the matrix itself and the edges of the graph only connected vertical or horizontal adjacent cells which are both 1.
We also show near the end the set of nodes that are reachable from 5 but it could also be derived from the distance matrix by looking at row (or column) 5.
library(igraph)
library(mazeGen)
set.seed(123)
n <- 3
m <- rndm_matrix(n, 0.8)
center <- (1+n^2)/2
m[center] <- 1 # force to be 1
m
## [,1] [,2] [,3]
## [1,] 1 0 1
## [2,] 1 1 0
## [3,] 1 1 1
attr(,"p")
[1] 0.8
im <- matrix(1:n^2, n, n) # correspondence between matrix entries and node nos
im
## [,1] [,2] [,3]
## [1,] 1 4 7
## [2,] 2 5 8
## [3,] 3 6 9
L <- lapply(seq_along(m), function(i) if (m[i] == 1) mazeGen:::colleage(i, n))
nodes <- seq_along(m)[m == 1]
L <- lapply(L, intersect, nodes)
g <- graph_from_adj_list(L)
g <- as.undirected(g)
We now show the distances between nodes.
distances(g)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
## [1,] 0 1 2 Inf 2 3 Inf Inf 4
## [2,] 1 0 1 Inf 1 2 Inf Inf 3
## [3,] 2 1 0 Inf 2 1 Inf Inf 2
## [4,] Inf Inf Inf 0 Inf Inf Inf Inf Inf
## [5,] 2 1 2 Inf 0 1 Inf Inf 2
## [6,] 3 2 1 Inf 1 0 Inf Inf 1
## [7,] Inf Inf Inf Inf Inf Inf 0 Inf Inf
## [8,] Inf Inf Inf Inf Inf Inf Inf 0 Inf
## [9,] 4 3 2 Inf 2 1 Inf Inf 0
This is all nodes reachable from the center node including itself:
center_comp <- subcomponent(g, center)
center_comp
## [1] 5 2 6 1 3 9
# boundary nodes
boundary <- c(im)[row(m) %in% c(1, n) | col(m) %in% c(1, n)]
# boundary nodes in center's component
intersect(center_comp, boundary)
## [1] 2 6 1 3 9
V(g)$color <- ifelse(m == 1, "green", "red")
V(g)$color[center] <- "white"
plot(g)
Related
Let's say I have a symmetric matrix A, for example:
> A <- matrix(runif(16),nrow = 4,byrow = T)
> ind <- lower.tri(A)
> A[ind] <- t(A)[ind]
> A
[,1] [,2] [,3] [,4]
[1,] 0.4212778 0.6874073 0.1551896 0.46757640
[2,] 0.6874073 0.5610995 0.1779030 0.54072946
[3,] 0.1551896 0.1779030 0.9515304 0.79429777
[4,] 0.4675764 0.5407295 0.7942978 0.01206526
I also have a 4 x 3 matrix B that gives specific positions of matrix A, for example:
> B<-matrix(c(1,2,4,2,1,3,3,2,4,4,1,3),nrow=4,byrow = T)
> B
[,1] [,2] [,3]
[1,] 1 2 4
[2,] 2 1 3
[3,] 3 2 4
[4,] 4 1 3
The B matrix represents the following positions of A: (1,1), (1,2), (1,4), (2,2), (2,1), (2,3), (3,3), (3,2), (3,4), (4,4), (4,1), (4,3).
I want to change the values of A that are NOT in the positions given by B, replacing them by Inf. The result I want is:
[,1] [,2] [,3] [,4]
[1,] 0.4212778 0.6874073 Inf 0.46757640
[2,] 0.6874073 0.5610995 0.1779030 Inf
[3,] Inf 0.1779030 0.9515304 0.79429777
[4,] 0.4675764 Inf 0.7942978 0.01206526
How can I do that quickly avoiding a for loop (which I'm able to code)? I've seen many similar posts, but no one gave me what I want. Thank you!
You want to do something like matrix subsetting (e.g., P[Q]) except that you can't use negative indexing in matrix subsetting (e.g., P[-Q] is not allowed). Here's a work-around.
Store the elements you want to retain from A in a 2-column matrix where each row is a coordinate of A:
Idx <- cbind(rep(1:4, each=ncol(B)), as.vector(t(B)))
Create a matrix where all values are Inf, and then overwrite the values you wanted to "keep" from A:
Res <- matrix(Inf, nrow=nrow(A), ncol=ncol(A))
Res[Idx] <- A[Idx]
Result
Res
# [,1] [,2] [,3] [,4]
#[1,] 0.9043131 0.639718071 Inf 0.19158238
#[2,] 0.6397181 0.601327568 0.007363378 Inf
#[3,] Inf 0.007363378 0.752123162 0.61428003
#[4,] 0.1915824 Inf 0.614280026 0.02932679
Here is a one-liner
A[cbind(1:nrow(A), sum(c(1:ncol(A))) - rowSums(B))] <- Inf
[,1] [,2] [,3] [,4]
[1,] 0.4150663 0.23440503 Inf 0.6665222
[2,] 0.2344050 0.38736067 0.01352211 Inf
[3,] Inf 0.01352211 0.88319263 0.9942303
[4,] 0.6665222 Inf 0.99423028 0.7630221
Another way would be to identify the cells with an apply and set then to inf.
cnum <- 1:ncol(A)
A[cbind(1:nrow(A), apply(B, 1, function(x) cnum[-which(cnum %in% x)]))] <- Inf
A
# [,1] [,2] [,3] [,4]
# [1,] 0.9148060 0.9370754 Inf 0.8304476
# [2,] 0.9370754 0.5190959 0.7365883 Inf
# [3,] Inf 0.7365883 0.4577418 0.7191123
# [4,] 0.8304476 Inf 0.7191123 0.9400145
Note: set.seed(42).
A <- matrix(runif(16),nrow = 4,byrow = T)
ind <- lower.tri(A)
A[ind] <- t(A)[ind]
## >A[]
## [,1] [,2] [,3] [,4]
## [1,] 0.07317535 0.167118857 0.0597721 0.2128698
## [2,] 0.16711886 0.008661005 0.6419335 0.6114373
## [3,] 0.05977210 0.641933514 0.7269202 0.3547959
## [4,] 0.21286984 0.611437278 0.3547959 0.4927997
The first thing to notice is that the matrix B is not very helpful in its current form, because the information we need is the rows and each value in B
B<-matrix(c(1,2,4,2,1,3,3,2,4,4,1,3),nrow=4,byrow = T)
> B
## [,1] [,2] [,3]
## [1,] 1 2 4
## [2,] 2 1 3
## [3,] 3 2 4
## [4,] 4 1 3
So we can create that simply by using melt and use Var1 and value.
>melt(B)
## Var1 Var2 value
## 1 1 1 1
## 2 2 1 2
## 3 3 1 3
## 4 4 1 4
## 5 1 2 2
## 6 2 2 1
## 7 3 2 2
## 8 4 2 1
## 9 1 3 4
## 10 2 3 3
## 11 3 3 4
## 12 4 3 3
We need to replace the non existing index in A by inf. This is not easy to do directly. So an easy way out would be to create another matrix of Inf and fill the values of A according to the index of melt(B)
> C<-matrix(Inf,nrow(A),ncol(A))
idx <- as.matrix(melt(B)[,c("Var1","value")])
C[idx]<-A[idx]
> C
## [,1] [,2] [,3] [,4]
## [1,] 0.07317535 0.167118857 0.0597721 0.2128698
## [2,] 0.16711886 0.008661005 0.6419335 Inf
## [3,] Inf 0.641933514 0.7269202 0.3547959
## [4,] 0.21286984 Inf 0.3547959 0.4927997
Another approach that accomplishes matrix subsetting (e.g., P[Q]) would be to create the index Q manually. Here's one approach.
Figure out which column index is "missing" from each row of B:
col_idx <- apply(B, 1, function(x) (1:nrow(A))[-match(x, 1:nrow(A))])
Create subsetting matrix Q
Idx <- cbind(1:nrow(A), col_idx)
Do the replacement
A[Idx] <- Inf
Of course, you can make this a one-liner if you really want to:
A[cbind(1:nrow(A), apply(B, 1, function(x) (1:nrow(A))[-match(x, 1:nrow(A))])]
I have a vector where the order of the elements are important, say
x <- c(1,2,3,4)
I would like to arrange my vector into a lower triangular matrix with a specific order where each row contains the preceding element of the vector. My goal is to obtain the following matrix
lower_diag_matrix
[,1] [,2] [,3] [,4]
[1,] 4 0 0 0
[2,] 3 4 0 0
[3,] 2 3 4 0
[4,] 1 2 3 4
I know I can fill the lower triangular area using lower_diag_matrix[lower.tri(lower_diag_matrix,diag = T)]<-some_vector but I can't seem to figure out the arrangement of the vector used to fill the lower triangular area. In practice the numbers will be random, so I would need a generic way to fill the area.
Here's one way:
x <- c(2, 4, 7)
M <- matrix(0, length(x), length(x))
M[lower.tri(M, diag = TRUE)] <- rev(x)[sequence(length(x):1)]
M
# [,1] [,2] [,3]
# [1,] 7 0 0
# [2,] 4 7 0
# [3,] 2 4 7
How can I sort matrix based on the nearest distance between two coordinates?
For example, I have this matrix :
> x
[,1] [,2]
[1,] 1 1
[2,] 3 9
[3,] 2 6
[4,] 2 8
I want the first row of the matrix will be somewhat an initial coordinate. After I calculate the distance manually between two coordinates, I found that x[1,] has the closest distance with x[3,]. Then, x[3,] has the closest distance with x[4,]. x[4,] has the closest distance with x[2,]. So the sorted matrix will be:
[,1] [,2]
[1,] 1 1
[2,] 2 6
[3,] 2 8
[4,] 3 9
I tried to write the R code below. But it did not work.
closest.pair <- c(NA,NA)
closest.distance <- Inf
for (i in 1:(n-1))
for (j in (i+1):n) {
dist <- sum((houses[i,]-houses[j,])^2)
if (dist<closest.distance) {
closest.pair <- c(i,j)
}
print(houses[closest.pair,])
}
Here is a possible solution using a loop:
## We determine the minimum distance between the coordinates at the current index cur
## and those at the remaining indexes ind
cur = 1;
ind = c(2:nrow(x));
## We put our resulting sorted indexes in sorted
sorted = 1;
while(length(ind)>=2){
pos = ind[which.min(rowSums((x[cur,]-x[ind,])^2))];
## At each iteration we remove the newly identified pos from the indexes in ind
## and consider it as the new current position to look at
ind = setdiff(ind,pos);
cur = pos;
sorted = c(sorted,pos)}
sorted = c(sorted,ind)
res = x[sorted,];
[,1] [,2]
[1,] 1 1
[2,] 2 6
[3,] 2 8
[4,] 3 9
You can use a for loop as shown below:
D=`diag<-`(as.matrix(dist(x)),NA)# Create the distance matrix, and give the diagonals NA values.
Then run a for loop
x[c(i<-1,sapply(1:(nrow(x)-1),function(j)i<<-which.min(D[i,]))),]
[,1] [,2]
[1,] 1 1
[2,] 2 6
[3,] 2 8
[4,] 3 9
This for-loop might seem weird! take a look:
m=c()
i=1
for(j in 1:(nrow(x)-1)){
i= which.min(D[i,])
m=c(m,i)
}
x[c(1,m),]
[,1] [,2]
[1,] 1 1
[2,] 2 6
[3,] 2 8
[4,] 3 9
you can also use Reduce
x[Reduce(function(i,j)which.min(D[,i]),1:(nrow(x)-1),1,,T),]
[,1] [,2]
[1,] 1 1
[2,] 2 6
[3,] 2 8
[4,] 3 9
So I have an NxN matrix, where some of the rows have inf for values. What I want to do is move them to their own separate matrix.
Here is an example
Matrix A
1 3 9
4 5 2
inf 6 7
0 inf 8
Remove rows with inf
Matrix A
1 3 9
4 5 2
Inf Matrix
inf 6 7
0 inf 8
Thanks
You can do this using standard subsetting and the function is.infinite:
##First create some data
m = matrix(1:12, ncol=3)
m[3,1] = Inf; m[4,2] = Inf
Then we calculate the condition on which to subset:
cond = apply(m, 1, function(i) any(is.infinite(i)))
Then subset as usual:
m[!cond,]
m[cond,]
Another way (but to me seems a bit more hacky) is to use row sums:
m[is.finitie(rowSums(m)),]
m[!is.finite(rowSums(m)),]
Not that if your matrix has NA, then these methods gives different results!
m[2,2] = NA
m[!is.finite(rowSums(m)),]
m[cond,]
since you are dealing with a matrix of numbers, abs() and == will be fast.
# Logical Vector
InfRows <- 0!=rowSums(abs(A) == Inf, na.rm=TRUE)
InfMat <- A[InfRows, ]
A.clean <- A[!InfRows, ]
Edit: If you need to allow for NA's just use the na.rm argument in rowSums()
# same as above, but using na.rm
InfRows <- 0 != rowSums(abs(A) == Inf, na.rm=TRUE)
EXAMPLE:
A[2:3, 2] <- NA
A
# [,1] [,2] [,3]
# [1,] 1 3 9
# [2,] 4 NA 2
# [3,] Inf NA 7
# [4,] 0 Inf 8
InfRows <- 0 != rowSums(abs(A) == Inf, na.rm=TRUE)
InfMat <- A[InfRows, ]
A.clean <- A[!InfRows, ]
InfMat
# [,1] [,2] [,3]
# [1,] Inf NA 7
# [2,] 0 Inf 8
A.clean
# [,1] [,2] [,3]
# [1,] 1 3 9
# [2,] 4 NA 2
I have a basic matrix mat and I hope to get an R object x = (mat, mat, ...) where mat is repeated for 100 times. If this is possible, then I can pass x to a function which takes a vector of matrix names. I tried rep(mat, 100) but it seems that the matrix class is no longer maintained. Any suggestions? Thanks!
Update: Basically I plan to use
grp.ids <- as.factor(c(rep(1,8), rep(2,4), rep(3,2)))
x <- model.matrix(~grp.ids)
do.call(blockMatrixDiagonal,
replicate(100, x, simplify=FALSE))
where the blockMatrixDiagonal function can be found here. Then R gives an error: number of items to replace is not a multiple of replacement length. What I really hope to get via these coding is a block diagonal matrix. Thanks :)
Your input matrix is not appropriate for building a block diagonal matrix since it's not a square matrix (i.e., the number of rows equals the number of columns).
Let me cite two resources on block diagonal matrices.
1) Wikipedia:
A block diagonal matrix is a block matrix which is a square matrix, and having main diagonal blocks square matrices
2) The description of the function blockMatrixDiagonal:
builds a block matrix whose diagonals are the square matrices provided.
You can combine your non-square matrices with the function adiag from the package magic. With your matrix x:
library(magic)
do.call(adiag, replicate(100, x, simplify = FALSE))
For a base R solution, check out kronecker
?kronecker
# For your block diagonal matrix:
kronecker(diag(1, 100), x)
# or with `%x%` alias
diag(1, 100) %x% x
# example 1
m <- matrix(1:6, nrow = 3)
kronecker(diag(1, 2), m)
# [,1] [,2] [,3] [,4]
# [1,] 1 4 0 0
# [2,] 2 5 0 0
# [3,] 3 6 0 0
# [4,] 0 0 1 4
# [5,] 0 0 2 5
# [6,] 0 0 3 6
# example 2
matrix(1, nrow = 2, ncol = 3) %x% m
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 1 4 1 4 1 4
# [2,] 2 5 2 5 2 5
# [3,] 3 6 3 6 3 6
# [4,] 1 4 1 4 1 4
# [5,] 2 5 2 5 2 5
# [6,] 3 6 3 6 3 6