So here is a matrix A which shows if point 1 to 10 is connected with each other. 1 means they are connected and 0 means they are not. I would like to find out if there is a path from one point to the other. Let's say the start point is 1 and the end point is 3. The number of points involved in between doesn't matter. Points can be used repeatedly. I just want to know if 1 can reach 3. How can I do this?
From what we can see, one of the possible paths is 1-8-6-2-3. But how to do it with R? Thanks a lot. Any help is appreciated.
A
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 0 0 0 0 0 0 1 0 0
[2,] 0 0 1 0 1 1 0 0 0 0
[3,] 0 1 0 0 0 0 0 0 0 0
[4,] 0 0 0 0 0 0 0 1 0 0
[5,] 0 1 0 0 0 0 0 0 0 0
[6,] 0 1 0 0 0 0 1 1 0 0
[7,] 0 0 0 0 0 1 0 0 0 1
[8,] 1 0 0 1 0 1 0 0 0 0
[9,] 0 0 0 0 0 0 0 0 0 0
[10,] 0 0 0 0 0 0 1 0 0 0
For this task I think that igraph will make your life easier
require(igraph)
dat <- read.table(text =
'0 0 0 0 0 0 0 1 0 0
0 0 1 0 1 1 0 0 0 0
0 1 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 1 0 0
0 1 0 0 0 0 0 0 0 0
0 1 0 0 0 0 1 1 0 0
0 0 0 0 0 1 0 0 0 1
1 0 0 1 0 1 0 0 0 0
0 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 1 0 0 0', header = FALSE)
dat <- as.matrix(dat)
g <- graph.adjacency(dat, mode = "undirected")
get.shortest.paths(g, 1, 3)
## [[1]]
## [1] 1 8 6 2 3
If you just want to test if a path exist you can create your own function like this one
test_paths <- function(g, from, to, ...) {
is.finite(c(shortest.paths(g, from, to, ...)))
}
test_paths(g, 1, 9)
## [1] FALSE
test_paths(g, 1, 8)
## [1] TRUE
The idea behind this code is simple : shortest.path return Inf when there's no path between two node (and the path length when it exists) so we can just test whether the number returned is finite (is.finite).
You can do this by repetitive matrix multiplication, until the matrix stays the same:
# generate symetric matrix
set.seed(123)
m <- matrix(rbinom(100, 1, 0.2), nrow = 10)
m <- m * upper.tri(m)
m <- m + t(m)
m0 <- m
m0
Generated matrix:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 1 1 1 0 0 0 0 0 0
[2,] 1 0 0 1 0 0 0 0 0 0
[3,] 1 0 0 0 0 0 0 0 0 0
[4,] 1 1 0 0 0 0 0 0 0 0
[5,] 0 0 0 0 0 0 1 0 0 0
[6,] 0 0 0 0 0 0 0 0 0 0
[7,] 0 0 0 0 1 0 0 0 1 0
[8,] 0 0 0 0 0 0 0 0 1 0
[9,] 0 0 0 0 0 0 1 1 0 0
[10,] 0 0 0 0 0 0 0 0 0 0
Now multiply, until its stabilized:
m <- m0
while (TRUE) {
new_m <- sign(m + m %*% m)
if (all(new_m == m))
break;
m <- new_m
}
m
The resultant matrix contains 1 if there is a path between those nodes:
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 1 1 1 0 0 0 0 0 0
[2,] 1 1 1 1 0 0 0 0 0 0
[3,] 1 1 1 1 0 0 0 0 0 0
[4,] 1 1 1 1 0 0 0 0 0 0
[5,] 0 0 0 0 1 0 1 1 1 0
[6,] 0 0 0 0 0 0 0 0 0 0
[7,] 0 0 0 0 1 0 1 1 1 0
[8,] 0 0 0 0 1 0 1 1 1 0
[9,] 0 0 0 0 1 0 1 1 1 0
[10,] 0 0 0 0 0 0 0 0 0 0
Related
I have tried to write a function for this part of code and I can not mange because I am new to R
can someone help me?
I made a function like this :
m <- matrix(0, nrow=10, ncol=10) # Create an adjacency matrix
and I have changed the the element of it like below :
m[1,2] <- m[2,3] <- m[3,4] <-m[4,5]<-m[5,6]<-m[6,7]<-m[7,8] <-m[8,9]<-m[9,10]<-m[1,10] <- 1
but how can i do it automatically inside a function? to automatically iterate and change value?
I am not very sure about the logic for why m[1,10] is assigned one, for the others, you can do:
m <- matrix(0, nrow=10, ncol=10)
m[row(m) == col(m)-1] <- 1
m
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 1 0 0 0 0 0 0 0 0
[2,] 0 0 1 0 0 0 0 0 0 0
[3,] 0 0 0 1 0 0 0 0 0 0
[4,] 0 0 0 0 1 0 0 0 0 0
[5,] 0 0 0 0 0 1 0 0 0 0
[6,] 0 0 0 0 0 0 1 0 0 0
[7,] 0 0 0 0 0 0 0 1 0 0
[8,] 0 0 0 0 0 0 0 0 1 0
[9,] 0 0 0 0 0 0 0 0 0 1
[10,] 0 0 0 0 0 0 0 0 0 0
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 2 years ago.
Improve this question
I want to make a "global" ID of 2D/3D nuclear masks across a list of images.
When i segment my cells they are numbered from 1:numberOfCellsInEachImage. but I would like to have an uniqe Id for each cells across all images.
I have already tried to make a forloop with a global counter and assigned IDs acording to the counter, but It became a messy large thing that I do not trust compleatly
# minimal exampe
img1 = matrix(data = 0, nrow = 15, ncol = 15)
img1[2:3, 2:3] = 1
img1[9:10, 5:6] = 2
img1[2:4, 11:13] = 3
img1
# Example indexed image 1
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15]
# [1,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# [2,] 0 1 1 0 0 0 0 0 0 0 3 3 3 0 0
# [3,] 0 1 1 0 0 0 0 0 0 0 3 3 3 0 0
# [4,] 0 0 0 0 0 0 0 0 0 0 3 3 3 0 0
# [5,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# [6,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# [7,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# [8,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# [9,] 0 0 0 0 2 2 0 0 0 0 0 0 0 0 0
#[10,] 0 0 0 0 2 2 0 0 0 0 0 0 0 0 0
#[11,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
#[12,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
#[13,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
#[14,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
#[15,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
img2 = matrix(data = 0, nrow = 15, ncol = 15)
img2[3:4, 2:4] = 1
img2[10:11, 5:7] = 2
img2[3:5, 11:14] = 3
img2
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15]
# [1,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# [2,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# [3,] 0 1 1 1 0 0 0 0 0 0 3 3 3 3 0
# [4,] 0 1 1 1 0 0 0 0 0 0 3 3 3 3 0
# [5,] 0 0 0 0 0 0 0 0 0 0 3 3 3 3 0
# [6,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# [7,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# [8,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# [9,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
#[10,] 0 0 0 0 2 2 2 0 0 0 0 0 0 0 0
#[11,] 0 0 0 0 2 2 2 0 0 0 0 0 0 0 0
#[12,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
#[13,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
#[14,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
#[15,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# This is the data structure I have
#
listOfImages2D = list(img1, img2)
#x = listOfImages2D[[1]]
listOfImages3D = lapply(listOfImages2D, function(x){
x_out = array(data = 0, dim = c(15, 15, 3) )
x_out[,,2] = x
return(x_out)
})
#What I want
# I want all numbers to become an uniqe ID across images
# All zeros should remain zero
# I use img1[img1 == 0 ] = 0 #after giving uniqe IDs
# Image one should ideally start at 1
# ## desired output
# listOfImages2D_global_index[[1]]
# # same as above
#
# listOfImages2D_global_index[[2]]
# # [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15]
# # [1,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# # [2,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# # [3,] 0 4 4 4 0 0 0 0 0 0 6 6 6 6 0
# # [4,] 0 4 4 4 0 0 0 0 0 0 6 6 6 6 0
# # [5,] 0 0 0 0 0 0 0 0 0 0 6 6 6 6 0
# # [6,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# # [7,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# # [8,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# # [9,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# #[10,] 0 0 0 0 5 5 5 0 0 0 0 0 0 0 0
# #[11,] 0 0 0 0 5 5 5 0 0 0 0 0 0 0 0
# #[12,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# #[13,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# #[14,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
# #[15,] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
#
# # the code should also work for 3 dimensions
Something like this? It's a little crude in that not every successive index is used (7 is skipped in this case), but the relative difference between values within each array is maintained, which might be useful. If you want to use every index, that wouldn't be too difficult, but would slow down processing.
z <- 0 # need this to initiate the loop
a <- c(0, 0, 1, 1, 0, 0, 2, 2, 0, 3, 3, 3)
b <- c(0, 3, 3, 3, 0, 2, 2, 2, 0, 0, 0, 0)
g <- c(1, 1, 1, 1, 0, 0, 3, 3, 0, 0, 0, 0)
l <- list(z=z, a=a, b=b, g=g)
# l[-1] <- lapply(l[-1], `dim<-`, c(2, 6)) # 2D
# l[-1] <- lapply(l[-1], `dim<-`, c(2, 2, 3)) # 3D
for (i in 2:length(l)) {
lnz <- l[[i]] != 0
# l[[i]][lnz] <- as.numeric(factor(l[[i]][lnz])) # force successive
d <- max(l[[i-1]]) - min(l[[i]][lnz])
l[[i]][lnz] <- l[[i]][lnz] + d + 1
}
l[-1]
# $a
# [1] 0 0 1 1 0 0 2 2 0 3 3 3
#
# $b
# [1] 0 5 5 5 0 4 4 4 0 0 0 0
#
# $g
# [1] 6 6 6 6 0 0 8 8 0 0 0 0
I am trying to use the matrix() and diag() functions to create the following pattern, but with a 100 x 100 matrix rather than 5 x 5.
5 x 5 matrix:
| 0 1 0 0 0 |
| 1 0 1 0 0 |
| 0 1 0 1 0 |
| 0 0 1 0 1 |
| 0 0 0 1 0 |
In other words, I want to have two diagonals with values of 1, one to the left of the main diagonal, and one to the right of the main diagonal.
The diag() function (actually the diag<- function) can be used for assignment:
mat <- matrix( 0, 100,100)
diag(mat) <- 1
mat[1:10,1:10]
#-----------
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 1 0 0 0 0 0 0 0 0 0
[2,] 0 1 0 0 0 0 0 0 0 0
[3,] 0 0 1 0 0 0 0 0 0 0
[4,] 0 0 0 1 0 0 0 0 0 0
[5,] 0 0 0 0 1 0 0 0 0 0
[6,] 0 0 0 0 0 1 0 0 0 0
[7,] 0 0 0 0 0 0 1 0 0 0
[8,] 0 0 0 0 0 0 0 1 0 0
[9,] 0 0 0 0 0 0 0 0 1 0
[10,] 0 0 0 0 0 0 0 0 0 1
You, however, want the sub-diagonal and super-diagonal to be assigned values, so use logical expressions with col and row:
mat <- matrix( 0, 100,100)
mat[row(mat)==col(mat)-1] <- 1
mat[row(mat)==col(mat)+1] <- 1
mat[1:10,1:10]
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 1 0 0 0 0 0 0 0 0
[2,] 1 0 1 0 0 0 0 0 0 0
[3,] 0 1 0 1 0 0 0 0 0 0
[4,] 0 0 1 0 1 0 0 0 0 0
[5,] 0 0 0 1 0 1 0 0 0 0
[6,] 0 0 0 0 1 0 1 0 0 0
[7,] 0 0 0 0 0 1 0 1 0 0
[8,] 0 0 0 0 0 0 1 0 1 0
[9,] 0 0 0 0 0 0 0 1 0 1
[10,] 0 0 0 0 0 0 0 0 1 0
(This method does not depend on having a square matrix. I have a vague memory that there is a faster method that does not require using row and col. For very large objects each of those functions returns a matrix of the same dimensions as their arguments.)
For the main diagonal, the row and column indices are the same. For the other diagonals, there is a difference of 1 between the row index and column index. Generate those indices directly and assign values in those indices.
sz = 5
m = matrix(0, sz, sz)
inds1 = cbind(r = 1:(sz-1), c = 2:sz)
inds2 = cbind(r = 2:sz, c = 1:(sz-1))
m[inds1] = 1
m[inds2] = 1
m
# OR, to make it concise
m = matrix(0, sz, sz)
inds = rbind(cbind(1:(sz-1), 2:sz), cbind(2:sz, 1:(sz-1)))
replace(m, inds, 1)
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 1 0 0 0
#[2,] 1 0 1 0 0
#[3,] 0 1 0 1 0
#[4,] 0 0 1 0 1
#[5,] 0 0 0 1 0
We could create a function using a math trick which would work for all square matrix.
get_off_diagonal_1s <- function(n) {
#Create a matrix with all 0's
mat <- matrix(0, ncol = n, nrow = n)
#Subtract row indices by column indices
inds = row(mat) - col(mat)
#Replace values where inds is 1 or -1
mat[inds == 1 | inds == -1] = 1
mat
}
get_off_diagonal_1s(5)
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 1 0 0 0
#[2,] 1 0 1 0 0
#[3,] 0 1 0 1 0
#[4,] 0 0 1 0 1
#[5,] 0 0 0 1 0
get_off_diagonal_1s(8)
# [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
#[1,] 0 1 0 0 0 0 0 0
#[2,] 1 0 1 0 0 0 0 0
#[3,] 0 1 0 1 0 0 0 0
#[4,] 0 0 1 0 1 0 0 0
#[5,] 0 0 0 1 0 1 0 0
#[6,] 0 0 0 0 1 0 1 0
#[7,] 0 0 0 0 0 1 0 1
#[8,] 0 0 0 0 0 0 1 0
I have a large dataframe with each column containing one flag from the set {-1,1}, all the rest of the values are set to zero. I want to fill up or down the rest of the column entries with a value corresponding to that flag value. for example, given a vector to represent 1 column, I have
v <- rep(0,15)
v[12] <- 1
#I'd want a function that is something like:
f <- function(v,flag){
for(i in 2:length(v)){ if(v[i-1]==flag) v[i] <- flag else v[i]<-v[i]}
v
}
> v
[1] 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0
> f(v,1)
[1] 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1
The example works fine for filling forward some v and a flag 1. I'd also want to be able to fill backwards with 1 based on a -1 flag. The obvious solution that comes to mind is na.locf, except I can't get it to work with a 1 in the middle and filling forward and backwards. Even if I populate the 0 elements with NA, it will still not partially fill up or down based on a flag.
Are there any simple and fast vectorized functions that could do this with a matrix or zoo object populated with all zeros, except where there is one element with 1 or -1 in each column, telling it to fill down or up with 1s depending on the value?
edit: thinking about it a bit more, I came up with a possible solution, that along with an illustration, (hopefully) makes it more clear what I want.
Also, the overall goal is to create a mask for Additions/Deletions to a fund index, by date, that fill forwards for additions (+1) and fill backwards for removals (-1). Also, why I thought of na.locf right away. Still not sure if this is the best approach for this block, though. Any thoughts appreciated.
#generate random matrix of flags
v.mtx <- matrix(0,15,10)
for(i in 1:10){
v.mtx[sample(1:15,1),i] <- sample(c(-1,1),1)
}
fill.flag <- function(v) {
if(any(-1 %in% v)) {v[1:which(v!=0)] <- 1}
else
if(any(1 %in% v)) {v[which(v!=0):length(v)] <- 1}
v
}
> v.mtx
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 0 0 0 0 1 0 0 0 0
[2,] 0 0 0 0 0 0 0 0 0 0
[3,] 0 0 0 0 0 0 0 0 0 0
[4,] 0 0 0 0 0 0 0 0 0 0
[5,] 0 0 0 0 0 0 0 0 0 0
[6,] 0 0 0 0 1 0 -1 0 0 0
[7,] 0 0 0 -1 0 0 0 0 0 0
[8,] 0 0 0 0 0 0 0 0 0 0
[9,] 0 0 0 0 0 0 0 1 0 -1
[10,] 0 0 0 0 0 0 0 0 -1 0
[11,] 0 0 0 0 0 0 0 0 0 0
[12,] 0 0 0 0 0 0 0 0 0 0
[13,] 0 0 1 0 0 0 0 0 0 0
[14,] 0 0 0 0 0 0 0 0 0 0
[15,] 1 -1 0 0 0 0 0 0 0 0
> apply(v.mtx,2,fill.flag)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 1 0 1 0 1 1 0 1 1
[2,] 0 1 0 1 0 1 1 0 1 1
[3,] 0 1 0 1 0 1 1 0 1 1
[4,] 0 1 0 1 0 1 1 0 1 1
[5,] 0 1 0 1 0 1 1 0 1 1
[6,] 0 1 0 1 1 1 1 0 1 1
[7,] 0 1 0 1 1 1 0 0 1 1
[8,] 0 1 0 0 1 1 0 0 1 1
[9,] 0 1 0 0 1 1 0 1 1 1
[10,] 0 1 0 0 1 1 0 1 1 0
[11,] 0 1 0 0 1 1 0 1 0 0
[12,] 0 1 0 0 1 1 0 1 0 0
[13,] 0 1 1 0 1 1 0 1 0 0
[14,] 0 1 1 0 1 1 0 1 0 0
[15,] 1 1 1 0 1 1 0 1 0 0
As #G. Grothendieck commented, you can try cummax and cummin, i.e.
f1 <- function(x){
if(sum(x) == 1){
return(cummax(x))
}else{
return(rev(cummin(rev(x)))* -1)
}
}
#apply as usual
apply(v.mtx, 2, f1)
How can I randomly add a value to a matrix?
say I have:
mat <- matrix(0, 10, 10)
v = 5
how can I add randomly v to mat, 2 positions at a time? The output should look like this after a single iteration:
out
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 0 0 0 0 0 0 0 0 0
[2,] 5 0 0 0 0 0 0 0 0 0
[3,] 0 0 0 0 0 0 0 0 0 0
[4,] 0 0 0 0 5 0 0 0 0 0
[5,] 0 0 0 0 0 0 0 0 0 0
[6,] 0 0 0 0 0 0 0 0 0 0
[7,] 0 0 0 0 0 0 0 0 0 0
[8,] 0 0 0 0 0 0 0 0 0 0
[9,] 0 0 0 0 0 0 0 0 0 0
[10,] 0 0 0 0 0 0 0 0 0 0
After another iteration, mat should have 2 more positions filled with the value in 'v'
You could use ?sample to randomly index your matrix:
idx <- sample(length(mat), size=2)
mat[idx] <- mat[idx] + v