strange matrix result from if else loop - r

The code below to fill a matrix with 1 if the vertex is adjacent to another vertex and 0 otherwise. I used this function for comparison but the resulted matrix is strange !!
R
library(igraph)
#prepare random data
random<-matrix(c(1,2,2,3,3,4),ncol=2,byrow=TRUE)
graph<-graph.data.frame(random, directed = FALSE)
v1<-c()
v2<-c()
for (edge in 1:length(E(graph))){
ver1<-ends(graph = graph, es = edge)[1]
v1[edge]<-ver1
ver2<-ends(graph = graph, es = edge)[2]
v2[edge]<-ver2
}
v1
[1] "1" "2" "3"
#Construct the matrix
n1<-matrix(,nrow=length(v1), ncol=length(V(graph)))
for(i in 1:length(v1)){
for(j in 1:length(V(graph))){
are_adjacent(graph, v1[i], V(graph)[j])
if(TRUE){
n1[i,j]<-1
}
else{
n1[i,j]<-0
}
}
}
n1
[,1] [,2] [,3] [,4]
[1,] 1 1 1 1
[2,] 1 1 1 1
[3,] 1 1 1 1
While the resulted matrix should be:
n1
[,1] [,2] [,3] [,4]
[1,] 0 1 0 0
[2,] 1 0 1 0
[3,] 0 1 0 1
since 1 is adjacent only to 2, 2 is adjacent to 1 & 3, 3 is adjacent to 2 & 4, 4 is adjacent only to 3
Thanks in advance

The error is your if statement:
Try this:
n1<-matrix(,nrow=length(v1), ncol=length(V(graph)))
for(i in 1:length(v1)){
for(j in 1:length(V(graph))){
adjacent_test <- are_adjacent(graph, v1[i], V(graph)[j])
if(adjacent_test == TRUE){
n1[i,j]<-1
}
else{
n1[i,j]<-0
}
}
}

Related

Arranging vector x as an anti-diagonal matrix

I am trying to input a vector x onto a matrix where values of x are located on the anti-diagonal of the matrix
x = c(1,2,3,4,5)
ID = function(x){
n = length(x)
A = matrix(0, nrow = n, ncol = n)
for ( i in 1:n){
A[i, n-i+1] = x[i]
}
print(A) # Why did my code not work when I did not include this
}
Z = ID(x)
I was wondering why does my code not work when I do not include the print(A) within the function. When I don't include Print(A), my z turns out to be NULL.
Thank you in advance.
If a return statement is not encountered before the end of the function body, then the function returns the value of the last "top level" expression. When you exclude print(A), the last top level expression is the for call, which returns NULL invisibly, as documented in ?`for`.
I would modify your function in three ways:
Replace matrix(0, n, n) with matrix(vector(typeof(x), n * n), n, n) so that the type of the matrix result matches the type of the vector argument.
Replace the for loop with a vectorized subassignment.
Replace print(A) with A so that print(ID(x)) doesn't print the matrix twice.
Hence my version of your function would look something like this:
antidiag <- function(x) {
n <- length(x)
A <- matrix(vector(typeof(x), n * n), n, n)
if (n > 0L) {
A[cbind(n:1, 1:n)] <- x
}
A
}
antidiag(1:4)
## [,1] [,2] [,3] [,4]
## [1,] 0 0 0 4
## [2,] 0 0 3 0
## [3,] 0 2 0 0
## [4,] 1 0 0 0
antidiag(1:4 > 0L)
## [,1] [,2] [,3] [,4]
## [1,] FALSE FALSE FALSE TRUE
## [2,] FALSE FALSE TRUE FALSE
## [3,] FALSE TRUE FALSE FALSE
## [4,] TRUE FALSE FALSE FALSE
antidiag(letters[1:4])
## [,1] [,2] [,3] [,4]
## [1,] "" "" "" "d"
## [2,] "" "" "c" ""
## [3,] "" "b" "" ""
## [4,] "a" "" "" ""
I would do this without a loop -
x = c(1,2,3,4,5)
ID = function(x){
n = length(x)
A = matrix(0, nrow = n, ncol = n)
diag(A[nrow(A):1, ]) <- x
A
}
ID(x)
# [,1] [,2] [,3] [,4] [,5]
#[1,] 0 0 0 0 5
#[2,] 0 0 0 4 0
#[3,] 0 0 3 0 0
#[4,] 0 2 0 0 0
#[5,] 1 0 0 0 0

Changing particular cells of a Matrix iteratively in R

Suppose that we have a (4,4) matrix. My goal is to change iteratively that cells (1,1),(2,1),(3,1),(1,2),(2,2),(1,3)
I wrote the following
for(i in 1:3){
for(j in 1:3){
if(i>j){
A[i,j] = A[i,j] + sample(c(-1,1),prob=c(0.5,0.5))
}
}
However, it doesn't change the correct cells and misses cells that have to be changed.
The matrix A can be of the form
A = matrix(c(1,1,1,1,1,1,1,0,1,1,0,0,1,0,0,0),4,4,byrow=T)
I think that the following chunk of code might be the solution, at least it gives the correct answer for a few runs that I did.
A = matrix(c(1,1,1,0,1,1,0,0,1,0,0,0,0,0,0,0),4,4,byrow=T)
k = 0
for(i in 1:3){
for(j in 1:(3-k)){
A[i,j] = A[i,j] + sample(c(-1,1),prob=c(0.5,0.5), size = 1)
}
k = k + 1
}
I think you simple forgot to set the size= parameter of sample to get one draw of the Rademacher universe.
set.seed(42)
for (i in 1:3) {
for (j in 1:3) {
if (i > j) {
A[i, j] <- A[i, j] + sample(c(-1, 1), size=1, prob=c(0.5, 0.5))
}
}
}
A
# [,1] [,2] [,3] [,4]
# [1,] 1 1 1 1
# [2,] 0 1 1 0
# [3,] 0 2 0 0
# [4,] 1 0 0 0
Another idea is to use a permutation matrix, which you may subset to your needs, and over which you may loop.
id <- RcppAlgos::permuteGeneral(ncol(B) - 1, ncol(B) - 2, repetition=T)
(id <- id[c(1, 4, 7, 2, 5, 3), ])
# [,1] [,2]
# [1,] 1 1
# [2,] 2 1
# [3,] 3 1
# [4,] 1 2
# [5,] 2 2
# [6,] 1 3
set.seed(42)
for (i in 1:nrow(id)) {
A[id[i, 1], id[i, 2]] <- A[id[i, 1], id[i, 2]] +
sample(c(-1, 1), size=1, prob=c(0.5, 0.5))
}
A
# [,1] [,2] [,3] [,4]
# [1,] 0 0 0 1
# [2,] 0 0 1 0
# [3,] 2 1 0 0
# [4,] 1 0 0 0
We can create a row/column index (vectorized approach) by cbinding the vector of index. Use the index to subset the cells of the matrix and assign (<-) after adding the sample output to those elements
n <- 3
j1 <- rep(seq_len(n), rev(seq_len(n)))
i1 <- ave(j1, j1, FUN = seq_along)
ind <- cbind(i1, j1)
ind
# i1 j1
#[1,] 1 1
#[2,] 2 1
#[3,] 3 1
#[4,] 1 2
#[5,] 2 2
#[6,] 1 3
A[ind] <- A[ind] + sample(c(-1,1),prob=c(0.5,0.5),
size = nrow(ind), replace= TRUE)

Create matrix with for-loop

I am trying to create the following matrix A for n rows and n+1 columns. n will likely be around 20 or 30, but for the purpose of the question I put it at 4 and 5.
Here is what I have so far:
N <- 5 # n+1
n <- 4 # n
columns <- list()
# first column:
columns[1] <- c(-1, 1, rep(0, N-2))
# all other columns:
for(i in N:2) {
columns[i] <- c((rep(0, N-i), 1, -2, 1, rep(0, i-3)))
}
# combine into matrix:
A <- cbind(columns)
I keep getting the following error msg:
In columns[1] <- c(-1, 1, rep(0, N - 2)) :
number of items to replace is not a multiple of replacement length
And later
"for(i in N:2) {
columns[i] <- c((rep(0, N-i),"
}
Error: unexpected '}' in "}"
I guess you can try the for loop below to create your matrix A:
N <- 5
n <- 4
A <- matrix(0,n,N)
for (i in 1:nrow(A)) {
if (i == 1) {
A[i,1:2] <- c(-1,1)
} else {
A[i,i+(-1:1)] <- c(1,-2,1)
}
}
such that
> A
[,1] [,2] [,3] [,4] [,5]
[1,] -1 1 0 0 0
[2,] 1 -2 1 0 0
[3,] 0 1 -2 1 0
[4,] 0 0 1 -2 1
Another solution is to use outer, and this method would be faster and looks more compact than the for loop approach, i.e.,
A <- `diag<-`(replace(z<-abs(outer(1:n,1:N,"-")),!z %in% c(0,1),0),
c(-1,rep(-2,length(diag(z))-1)))
I thought this would be fast compared to the loop, but when I tested on a 5000x5001 example, the loop in ThomasIsCoding's answer was about 5x faster. Go with that one!
N = 5
n = N - 1
A = matrix(0, nrow = n, ncol = N)
delta = row(A) - col(A)
diag(A) = -2
A[delta %in% c(1, -1)] = 1
A[1, 1] = -1
A
# [,1] [,2] [,3] [,4] [,5]
# [1,] -1 1 0 0 0
# [2,] 1 -2 1 0 0
# [3,] 0 1 -2 1 0
# [4,] 0 0 1 -2 1
You could use data.table::shift to shift the vector c(1, -2, 1, 0) by all increments from -1 (backwards shift / lead by 1) to n - 1 (forward shift / lagged by n - 1) and then cbind all the shifted outputs together. The first-row first-column element doesn't follow this pattern so that's fixed at the end.
library(data.table)
out <- do.call(cbind, shift(c(1, -2, 1, 0), seq(-1, n - 1), fill = 0))
out[1, 1] <- -1
out
# [,1] [,2] [,3] [,4] [,5]
# [1,] -1 1 0 0 0
# [2,] 1 -2 1 0 0
# [3,] 0 1 -2 1 0
# [4,] 0 0 1 -2 1

Raising a Power on Matrices

I'm trying to create a function that will give me the value of a matrix once it has been raised to a power. This is what I've done so far:
A <- matrix(c(1,2,3,4,0,1,2,3,0,0,1,2,0,0,0,1),nrow=4,ncol=4)
power <- function(A,n){
+ if(n == 0){
+ return(diag(4))
+ }else{
+ return(A%*%A^(n-1))
+ }
+ }
OUTCOME:
> power(A,4)
[,1] [,2] [,3] [,4]
[1,] 1 0 0 0
[2,] 10 1 0 0
[3,] 46 10 1 0
[4,] 146 46 10 1
This is giving a different value from what my calculator gets and I'm trying to figure what I'm doing wrong. Any help is appreciated!
We could use %^% from library(expm)
library(expm)
A%*%(A%^%3)
Using this in a function
power <- function(A,n){
if(n == 0){
return(diag(4))
}else{
return(A%*%(A%^%(n-1)))
}
}
power(A,4)
# [,1] [,2] [,3] [,4]
#[1,] 1 0 0 0
#[2,] 8 1 0 0
#[3,] 36 8 1 0
#[4,] 120 36 8 1
According to the description in ?matpow
Compute the k-th power of a matrix. Whereas ‘x^k’ computes
element wise powers, ‘x %^% k’ corresponds to k - 1 matrix
multiplications, ‘x %% x %% ... %*% x’.
Or a base R option is Reduce with %*% (but this would be slow compared to %^%.
Reduce(`%*%`,replicate(4, A, simplify=FALSE))
In a function,
power1 <- function(A,n){
if(n == 0){
return(diag(4))
}else{
Reduce(`%*%`,replicate(n, A, simplify=FALSE))
}
}
power1(A,4)
# [,1] [,2] [,3] [,4]
#[1,] 1 0 0 0
#[2,] 8 1 0 0
#[3,] 36 8 1 0
#[4,] 120 36 8 1
You have a problem with the way you are computing your matrix product. I use a while loop inside your power() function instead. It simply multiples the input matrix against itself n times and then returns the result. Here is a base R solution which is a continuation of the direction in which you were already going.
A <- matrix(c(1,2,3,4,0,1,2,3,0,0,1,2,0,0,0,1),nrow=4,ncol=4)
power <- function(A,n){
B <- diag(nrow(A))
if (n == 0) {
return(diag(nrow(A)))
} else {
while (n > 0) {
B <- A%*%B
n <- n - 1
}
return(B)
}
}
> power(A, 4)
[,1] [,2] [,3] [,4]
[1,] 1 0 0 0
[2,] 8 1 0 0
[3,] 36 8 1 0
[4,] 120 36 8 1
I assume you want to make the muliplication of the matrix.You have to first make the multiply the matrix and then try to multiply them using the same powers as you want ,so you can do two things
Write code to multiply the matrix .
Loop the code to multiply.

R index matrix with vector / create index matrix from index vector

I am looking for an easier way to do the following:
m <- matrix(0, nrow=3, 3)
v <- c(1, 3, 2)
for (i in 1:nrow(m)) {
m[[i, v[i]]] = 1
}
The above code creates the following index matrix:
[,1] [,2] [,3]
[1,] 1 0 0
[2,] 0 0 1
[3,] 0 1 0
There surely must be a better way to do this?!
One way to do it without pre-defining the matrix would be to use outer:
num.col <- 3
outer(v, seq_len(num.col), "==") * 1
# [,1] [,2] [,3]
# [1,] 1 0 0
# [2,] 0 0 1
# [3,] 0 1 0

Resources