I am trying to generate a neighbors list, specifically an asymmetrical site-by-edge matrix (See below for paper). However, I am having a hard time creating multiple origins and have tried multiple different ways.
**1st attempt**
>nb <- cell2nb(3,2, "queen")
>xy <- coordinates
>xy
> no lat long
>1 1 30.20924 -97.49967
>2 2 30.11203 -97.32514
>3 3 29.70528 -96.53542
>4 4 29.53580 -97.88101
>5 5 29.48454 -97.44769
>6 6 28.82390 -97.03054
>edge.mat <- aem.build.binary(nb, xy)
This generates the following:
enter image description here
and edges are the following:
enter image description here
I want 0 (origin) to branch to both 1 and 4 separately. I also do not want 1:3 and 4:6 to cross. I want 1 to go to 2, 2 to go to 3 and then 4 to go to 5 and 5 to go to 6.
**2nd attempt**
I also tried to construct my own edges matrix and build a binary matrix that way, but 4 still does not branch from 0.
edges file
> Var1 Var2
>1 0 1
>2 1 2
>3 2 3
>4 0 4
>5 4 5
>6 5 6
>xy
> no lat long
>1 1 30.20924 -97.49967
>2 2 30.11203 -97.32514
>3 3 29.70528 -96.53542
>4 4 29.53580 -97.88101
>5 5 29.48454 -97.44769
>6 6 28.82390 -97.03054
>bin.mat <- aem.build.binary(coords = xy, link = edges)
>bin.mat
>$se.mat
> [,1] [,2] [,3] [,4] [,5]
> [1,] 0 0 0 0 0
> [2,] 0 1 0 0 0
> [3,] 0 1 1 0 0
> [4,] 0 0 0 0 0
> [5,] 0 0 0 1 0
> [6,] 0 0 0 1 1
> [7,] 1 0 0 0 0
> [8,] 0 0 0 0 0
> [9,] 0 0 0 0 0
>[10,] 0 0 0 0 0
>[11,] 0 0 0 0 0
>[12,] 0 0 0 0 0
>[13,] 0 0 0 0 0
>[14,] 0 0 0 0 0
>[15,] 0 0 0 0 0
>$edges
> from to
> 0 7
>2 1 2
>3 2 3
>5 4 5
>6 5 6
enter image description here
Any suggestions? I would greatly appreciate it. Thanks!
Blanchet, F. G., Legendre, P., Maranger, R., Monti, D., & Pepin, P. (2011). Modelling the effect of directional spatial ecological processes at different scales. Oecologia, 166(2), 357-368.
Related
I would like to know which positions of one matrix intersect with another matrix and which values, for example
lab <- as.matrix(read.table(text="[1,] 0 0 0 0 0 0 0 0 0 1
[2,] 2 0 2 2 2 2 2 2 2 0
[3,] 2 0 2 0 0 0 0 0 2 2
[4,] 2 2 2 0 0 0 0 0 2 2
[5,] 2 0 2 0 0 0 0 0 0 0
[6,] 2 0 2 0 0 0 0 0 0 0
[7,] 2 0 2 0 0 0 0 0 0 0
[8,] 2 0 2 0 0 0 0 3 3 3
[9,] 2 0 2 0 0 0 0 0 3 3
[10,] 2 0 2 0 0 0 0 0 0 3")[,-1])
str(lab)
la1 <- as.matrix(read.table(text="[1,] 0 1 0 0 0 0 0 0 0 2
[2,] 3 0 4 4 4 4 4 4 4 0
[3,] 3 0 4 0 0 0 0 0 4 4
[4,] 3 0 4 0 5 5 0 0 4 4
[5,] 3 0 4 0 5 5 0 0 0 0
[6,] 3 0 4 0 0 0 0 0 0 0
[7,] 3 0 4 0 0 0 0 0 0 0
[8,] 3 0 4 0 0 0 0 6 6 6
[9,] 3 0 4 0 0 0 0 6 6 6
[10,] 3 0 4 0 0 0 0 0 0 6")[,-1])
Then, these numbers represent patches, patch 3 of la1 intersect patch 3 and 4 of la1, patch 1 of lab intersect 0 (no other patch), patch 3 of lab intersect patch 6 of la1. I am using the following code
require(dplyr)
tuples <- tibble()
dx <- dim(lab)[1]
for( i in seq_len(dx))
for( j in seq_len(dx))
{
ii <- tibble(l0=lab[i,j],l1=la1[i,j])
tuples <- bind_rows(tuples,ii)
}
tuples %>% distinct()
As I will use big 3000x3000 matrices so I am thinking if there is any faster way, maybe with rcpp or raster, of doing it.
Without a double for loop, we can transpose the matrixes into a two column tibble and get the distinct rows
out <- tibble(l0 = c(t(lab)), l1 = c(t(la1))) %>%
distinct
-checking with OP's output
out_old <- tuples %>%
distinct()
all.equal(out, out_old, check.attributes = FALSE)
#[1] TRUE
Benchmarks
lab2 <- matrix(sample(0:9, size = 3000 * 3000, replace = TRUE), 3000, 3000)
la2 <- matrix(sample(0:9, size = 3000 * 3000, replace = TRUE), 3000, 3000)
system.time({out2 <- tibble(l0 = c(t(lab2)), l1 = c(t(la2))) %>%
distinct})
# user system elapsed
# 0.398 0.042 0.440
If you just want to speed up, you can try unique over data.table, e.g.,
unique(data.table(c(lab), c(la)))
Here comes a base R solution.
as.vector might be faster than c.
unique(cbind(as.vector(lab), as.vector(la1)))
# [,1] [,2]
# [1,] 0 0
# [2,] 2 3
# [3,] 0 1
# [4,] 2 0
# [5,] 2 4
# [6,] 0 5
# [7,] 3 6
# [8,] 0 6
# [9,] 1 2
I would like to create the following vector sequence.
0 1 0 0 2 0 0 0 3 0 0 0 0 4
My thought was to create 0 first with rep() but not sure how to add the 1:4.
Create a diagonal matrix, take the upper triangle, and remove the first element:
d <- diag(0:4)
d[upper.tri(d, TRUE)][-1L]
# [1] 0 1 0 0 2 0 0 0 3 0 0 0 0 4
If you prefer a one-liner that makes no global assignments, wrap it up in a function:
(function() { d <- diag(0:4); d[upper.tri(d, TRUE)][-1L] })()
# [1] 0 1 0 0 2 0 0 0 3 0 0 0 0 4
And for code golf purposes, here's another variation using d from above:
d[!lower.tri(d)][-1L]
# [1] 0 1 0 0 2 0 0 0 3 0 0 0 0 4
rep and rbind up to their old tricks:
rep(rbind(0,1:4),rbind(1:4,1))
#[1] 0 1 0 0 2 0 0 0 3 0 0 0 0 4
This essentially creates 2 matrices, one for the value, and one for how many times the value is repeated. rep does not care if an input is a matrix, as it will just flatten it back to a vector going down each column in order.
rbind(0,1:4)
# [,1] [,2] [,3] [,4]
#[1,] 0 0 0 0
#[2,] 1 2 3 4
rbind(1:4,1)
# [,1] [,2] [,3] [,4]
#[1,] 1 2 3 4
#[2,] 1 1 1 1
You can use rep() to create a sequence that has n + 1 of each value:
n <- 4
myseq <- rep(seq_len(n), seq_len(n) + 1)
# [1] 1 1 2 2 2 3 3 3 3 4 4 4 4 4
Then you can use diff() to find the elements you want. You need to append a 1 to the end of the diff() output, since you always want the last value.
c(diff(myseq), 1)
# [1] 0 1 0 0 1 0 0 0 1 0 0 0 0 1
Then you just need to multiply the original sequence with the diff() output.
myseq <- myseq * c(diff(myseq), 1)
myseq
# [1] 0 1 0 0 2 0 0 0 3 0 0 0 0 4
unlist(lapply(1:4, function(i) c(rep(0,i),i)))
# the sequence
s = 1:4
# create zeros vector
vec = rep(0, sum(s+1))
# assign the sequence to the corresponding position in the zeros vector
vec[cumsum(s+1)] <- s
vec
# [1] 0 1 0 0 2 0 0 0 3 0 0 0 0 4
Or to be more succinct, use replace:
replace(rep(0, sum(s+1)), cumsum(s+1), s)
# [1] 0 1 0 0 2 0 0 0 3 0 0 0 0 4
I have a interaction datframe in R, like this:
> interaction
x y z
[1,] 4 1 112
[2,] 3 1 104
[3,] 2 4 19
[4,] 1 3 154
[5,] 3 5 332
[6,] 4 1 187
[7,] 5 5 489
[8,] 2 2 149
i want to covert it into a matrix, take x as rownames, take y as colnames, and take z as their interaction value, x,y can take same value.
anybody knows how to convert? maybe just one step in R. Please.
thank you very much!
-------------------2017/3/31---------------------------------------
or there is another edition of my question:
interactions <-data.frame(x=c(40,30,20,10,30,40,50,80),y=c(50,10,40,30,50,10,50,90),z=c(112,104,19,154,332,187,489,149))
m <- matrix(0,10,10)
colnames(m)<-c(10,20,30,40,50,60,70,80,90,100)
rownames(m)<-c(10,20,30,40,50,60,70,80,90,100)
how to covert the interactions data into matrix "m".
thank you!
Is this the sort of thing...? It assumes you want to add duplicates - such as rows 1 and 6 (both (4,1)). (See much better solution in comment below!)
intn <- data.frame(x=c(4,3,2,1,3,4,5,2),y=c(1,1,4,3,5,1,5,2),z=c(112,104,19,154,332,187,489,149))
m <- matrix(0,nrow=max(intn$x),ncol=max(intn$y))
for(i in seq_len(nrow(intn))) {
m[intn$x[i],intn$y[i]] <- m[intn$x[i],intn$y[i]] + intn$z[i]
}
m
[,1] [,2] [,3] [,4] [,5]
[1,] 0 0 154 0 0
[2,] 0 149 0 19 0
[3,] 104 0 0 0 332
[4,] 299 0 0 0 0
[5,] 0 0 0 0 489
In response to follow-up question - if there are more possible values of x and y, you can still use xtabs but add in some dummy data with the valid x and y values. The row and column names will be the combined dummy and actual values (as characters rather than numeric). Something like this...
xvals <- c(-2,0,1,2,3,4,5,2.5,7) #possible x values
yvals <- c(-1,1,2,2.5,3,4,5,6,7) #possible y values
dum <- data.frame(x=xvals,y=yvals) #xvals and yvals need to be same length
dum$z <- 0
m2 <- xtabs(z~x+y,rbind(dum,intn))
m2
y
x -1 1 2 2.5 3 4 5 6 7
-2 0 0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0
1 0 0 0 0 154 0 0 0 0
2 0 0 149 0 0 19 0 0 0
2.5 0 0 0 0 0 0 0 0 0
3 0 104 0 0 0 0 332 0 0
4 0 299 0 0 0 0 0 0 0
5 0 0 0 0 0 0 489 0 0
7 0 0 0 0 0 0 0 0 0
I would like to say thank you in advance for anyone who looks at my question and shares their thoughts and experiences. I am trying to run a quadratic assignment procedure (QAP) on correlations of behaviors between a community of five individuals. I have ten matrices that represent frequencies of behavior between individuals, and I calculated correlations (pearson's r) between pairs of matrices. For example, I found the correlation between matrix 1 and matrix 2, matrix 2 and matrix 3, matrix 3 and matrix 4... and so on. I then wanted to assess the significance of these correlations using the qaptest function from the R package sna. As per the R documentation on qaptest, I placed all of my matrices into an array. I then calculated the QAP p-value between pairs of matrices (matrix 1 and matrix 2, matrix 2 and matrix 3... etc.). However, I noticed that if I changed the number of matrices in the array (for example, if I only placed the first five into the array), the QAP p-values for the first set of matrices changed dramatically. Based on my understanding of arrays and QAP, this should not happen because the removed matrices have nothing to do with running a QAP test on matrix 1 and matrix 2. Has anyone else ran into this problem before? I included my matrices and my script below.
Here are my matrices in a list format (in the code below, this is the step where I made filelist1. The second half of the code only uses matrices 1-5):
[[1]]
1 2 3 4 5
1 1 0 0 0 0
2 5 0 3 5 0
3 0 0 0 0 0
4 0 0 0 0 0
5 2 0 1 0 0
[[2]]
1 2 3 4 5
1 0 0 1 0 0
2 3 6 10 1 2
3 0 0 0 0 0
4 0 5 0 0 0
5 0 0 5 0 0
[[3]]
1 2 3 4 5
1 0 1 0 0 0
2 2 0 5 7 0
3 0 0 0 0 3
4 1 0 0 0 0
5 1 2 2 3 0
[[4]]
1 2 3 4 5
1 0 6 0 0 2
2 2 0 8 5 0
3 0 5 0 0 0
4 1 0 0 0 0
5 0 0 1 3 2
[[5]]
1 2 3 4 5
1 0 0 0 0 0
2 1 0 2 5 1
3 0 0 0 0 0
4 1 2 3 0 1
5 0 3 3 1 0
[[6]]
1 2 3 4 5
1 0 0 0 0 0
2 2 0 3 0 3
3 0 0 0 0 0
4 1 0 4 0 0
5 1 5 7 0 0
[[7]]
1 2 3 4 5
1 0 0 0 0 0
2 2 0 6 0 3
3 0 0 0 0 0
4 6 0 4 0 0
5 1 0 2 0 0
[[8]]
1 2 3 4 5
1 0 0 0 1 0
2 2 0 1 6 0
3 0 0 0 0 0
4 0 0 0 0 0
5 6 0 2 2 0
[[9]]
1 2 3 4 5
1 0 0 0 0 0
2 0 0 2 3 2
3 0 0 0 0 0
4 0 0 0 0 0
5 1 0 2 0 0
[[10]]
1 2 3 4 5
1 0 0 0 0 0
2 1 0 1 1 0
3 0 0 0 0 0
4 0 0 0 0 0
5 6 0 1 2 0
This is my R script:
# read in all ten of the matrices
a<-read.csv("test1.csv")
b<-read.csv("test2.csv")
c<-read.csv("test3.csv")
d<-read.csv("test4.csv")
e<-read.csv("test5.csv")
f<-read.csv("test6.csv")
g<-read.csv("test7.csv")
h<-read.csv("test8.csv")
i<-read.csv("test9.csv")
j<-read.csv("test10.csv")
filelist<-list(a,b,c,d,e,f,g,h,i,j) #place files in a list
filelist1<-lapply(filelist,function(x){
x<-x[1:5, 2:6] #choose only columns in the matrix
colnames(x)<-1:5 #rename columns according to identity
x<-as.matrix(x) #make a matrix
return(x)
})
ee<-array(dim=c(5,5,10)) #create an empty array
array<-function(files) {
names(files) <- c("c1","c2","c3", "c4", "c5", "c6", "c7", "c8", "c9", "c10") #name the matrices
invisible(lapply(names(files), function(x) assign(x,files[[x]],envir=.GlobalEnv))) #place the matrices in a global environment
ee[,,1]<-c(c1) #place each matrix in order into the array
ee[,,2]<-c(c2)
ee[,,3]<-c(c3)
ee[,,4]<-c(c4)
ee[,,5]<-c(c5)
ee[,,6]<-c(c6)
ee[,,7]<-c(c7)
ee[,,8]<-c(c8)
ee[,,9]<-c(c9)
ee[,,10]<-c(c10)
return(ee) #return the completely filled in array
}
a.array<-array(filelist1) # apply the function to the list of matrices
q1.2<-qaptest(a.array,gcor,g1=1,g2=2) #run the qaptest funtion
#a.array is the array with the matrices,gcor tells the function that we want a correlation
#g1=1 and g2=2 indicates that the qap analysis should be run between the first and second matrices in the array.
summary.qaptest(q1.2) #provides a summary of the qap results
#in this case, the p-value is roughly: p(f(perm) >= f(d)): 0.176
############ If I take out the last five matrices, the q1.2 p-value changes dramatically
#first clear the memory or R will not create another blank array
rm(list = ls())
a<-read.csv("test1.csv") #read in all five files
b<-read.csv("test2.csv")
c<-read.csv("test3.csv")
d<-read.csv("test4.csv")
e<-read.csv("test5.csv")
filelist<-list(a,b,c,d,e) #create a list of the files
filelist1<-lapply(filelist,function(x){
x<-x[1:5, 2:6] #include only the matrix
colnames(x)<-1:5 #rename the columns
x<-as.matrix(x) #make it a matrix
return(x)
})
ee<-array(dim=c(5,5,5)) #this time the array only has five slots
array<-function(files) {
names(files) <- c("c1","c2","c3", "c4", "c5")
invisible(lapply(names(files), function(x) assign(x,files[[x]],envir=.GlobalEnv)))
ee[,,1]<-c(c1)
ee[,,2]<-c(c2)
ee[,,3]<-c(c3)
ee[,,4]<-c(c4)
ee[,,5]<-c(c5)
return(ee)
}
a.array<-array(filelist1)
q1.2<-qaptest(a.array,gcor,g1=1,g2=2)
#in this case, the p-value is roughly: p(f(perm) >= f(d)): 0.804
summary.qaptest(q1.2)
I cannot think of a reason why the p-values would be so different when I am analyzing the exact same pair of matrices. The only difference is the number of additional matrices placed in the array. Has anyone else experienced this issue?
Thank you!
qaptest() reads graphs from the first dimension of the array, not the last. So ee[,,1]<-c(c1) (etc.) should read ee[1,,]<-c(c1) (etc.). When you place all the graph in the first dimension, the qaptests should yield identical results. Personally, I prefer using list() instead of array() with qaptest.
Hi I'm pretty much stumped on on trying to figure this out and could use a little help. Basically, I have a n x n matrix where the diagonal is set to a value k and every other value is 0.
1 2 3 4 5
1 k 0 0 0 0
2 0 k 0 0 0
3 0 0 k 0 0
4 0 0 0 k 0
5 0 0 0 0 k
Basically, I need to be able to make two other diagonals in this matrix with the value of 1 so it ends up looking like this:
1 2 3 4 5
1 k 1 0 0 0
2 1 k 1 0 0
3 0 1 k 1 0
4 0 0 1 k 1
5 0 0 0 1 k
So far all I have for code is being able to make the diagonal matrix
m=diag(k,n,n) but I have no idea on how to add the two other diagonals. Would I use apply() and cbind() or rbind()?
You can use col and row to create and index to subset and assign the upper and lower diagonals.
k=3
m <- k* diag(6)
m[abs(row(m) - col(m)) == 1] <- 1
m
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] 3 1 0 0 0 0
#[2,] 1 3 1 0 0 0
#[3,] 0 1 3 1 0 0
#[4,] 0 0 1 3 1 0
#[5,] 0 0 0 1 3 1
#[6,] 0 0 0 0 1 3
If you wanted reverse diagonals you could use col(m) - row(m)
Try this function, it will make a matrix of dimensions row X col and diagonal of the numeric n.
matfun <- function(diag=n, row=4,col=4){
x = diag(1,row,col)
diag*x+rbind(as.vector(rep(0,col)),x[1:(row-1),])+cbind(as.vector(rep(0,row)),x[,1:(col-1)])
}
HTH