I'm trying to create a graph and then write it with the function write.graph (package igraph). Hence, I create the distance matrix
require(vegan)
data(dune)
dis <- vegdist(dune)
and then I define explicitly the rownames:
x <- c("dune1")
for (i in 1: 20){
n <- paste("dune", i, sep="")
x <- append(x, n)
}
rownames(dune) <- x
With the following procedure I create an undirected graph through the minimum spanning tree algorithm.
gg <- graph.adjacency(as.matrix(dis), weighted=TRUE)
gg_mst <- as.undirected(mst(gg))
At this point I want to represent it such to open it with pajek. In order to do that I use write.graph:
write.graph(gg_mst, "graph.net", format="pajek")
obtaining the following graph:
The names are lost!
Nevertheless, if i use the same function using a different format:
write.graph(gg_mst, "graph.txt", format="ncol")
I obtain a file keeping the rownames:
dune1 dune3 0.448275862068966
dune2 dune3 0.341463414634146
dune2 dune10 0.294117647058824
dune3 dune4 0.270588235294118
... ... ...
Is it a bug related to the use of write.graph with the format "pajek"?
You need to assign id attributes of the vertices in order to be able to have the vertices' names shown in a pajek viewer such as this one http://vlado.fmf.uni-lj.si/pub%20/networks/pajek/default.htm or gephi. Need to modify a few lines of your code like the following:
dis <- vegdist(dune)
x <- c()
for (i in 1: 20){
n <- paste("dune", i, sep="")
x <- append(x, n)
}
gg <- graph.adjacency(as.matrix(dis), weighted=TRUE)
gg_mst <- as.undirected(mst(gg))
V(gg_mst)$id <- x # assign the ids
write.graph(gg_mst, "graph.net", format="pajek")
Opening with pajek shows the vertex ids correctly.
Related
In my previous question I have used the convex_hull() function. We have a graph, where all nodes have zero degree and (x,y) coordinats. We need to create graph as sequence of convex hulls. We can stop the loop if only just one node has zero degree.
My attempt is:
library(igraph)
######################################################################
set.seed(5)
n=15
g <- graph.empty(n)
xy <- cbind(runif(n), runif(n))
in_points <- V(g)[degree(g)==0]
repeat {
cp <- convex_hull(xy[in_points, ])$resverts+1
g <- as.undirected(add_edges(g, c(t(embed(cp, 2)), cp[1], cp[length(cp)])))
in_points <- V(g)[degree(g)==0]
if (length(in_points)=1) {break}
}
plot(g, vertex.size=10, layout=xy)
One can see in the repeate loop the node 3 used twice.
Expected result is:
Question. How are correctly use output of convex_hull() function for sequential adding edges in the loop?
You can iteratively use chull and add_edges. You just need to make sure that input to add_edges is of correct format and track which nodes are not already part of outer convex hull.
xy <- cbind(seq_len(n), xy)
while(nrow(xy) > 1){
current_hull <- chull(xy[,2], xy[,3])
current_hull <- c(current_hull, current_hull[[1]])
g <- add_edges(g, as.vector(t(embed(xy[,1][current_hull], 2)[,2:1])))
xy <- xy[-current_hull,,drop = FALSE]
}
I'm trying to simulate herding behavior in R.
Here's the code
library(raster)
library(sp)
library(foreach)
K=100
sig=0.2
G=0.3
x <- raster(ncol=2000,nrow=2000)
values(x) <- sign(rnorm(4000000,mean=0,sd=0.3))
y <- raster(ncol=2000,nrow=2000)
values(y) <- sign(rnorm(4000000,mean=0,sd=0.3))
#plot(x)
ei <- rnorm(4000000)
j=0
while(j < 30) {
for(i in 1:4000000){
ad <- adjacent(x,cell=c(i))[,2]
y[i] <- sign(K*sum(x[ad])+sig*ei[i]+G)
}
x <- y
plot(x)
j = j+1
}
The classic loop approach is too slow.
If I use a foreach loop instead of a classic for loop it doesn't change the values of y in every iteration.
I can't fix it at all.
Can someone please help about this?
Thank you
You have a dynamic model in which the output of each (time) step is input for the next step. It is not possible to do that in parallel. But that does not mean you cannot make the model run faster.
Looping over raster cells in R is always going to be slow, so we need to avoid that. Normally a problem like this could be solved with focal (see code a the bottom) --- but in this case it is difficult because you effectively use two rasters (x and ei) --- I will look at implementing multi-layer focal operations in the terra package.
Here is an approach with getFocalValues. It is much faster (and I use Sys.sleep to slow it down a bit).
library(raster)
set.seed(0)
x <- raster(ncol=200, nrow=200)
values(x) <- sign(rnorm(ncell(x),mean=0,sd=0.3))
y <- raster(x)
values(y) <- sign(rnorm(ncell(x),mean=0,sd=0.3))
ei <- rnorm(ncell(x))
K=100
sig=0.2
G=0.3
for (j in 1:29) {
# with large rasters, you may need to do the below in chunks
v <- getValuesFocal(x, 1, nrow(x), c(3,3))
# only keep the rook neighbors
v <- v[, c(2,4,6,8)]
v <- rowSums(v, na.rm=TRUE)
values(x) <- sign(K*v+sig*ei+G)
plot(x)
Sys.sleep(0.1)
}
This how you could use focal in similar cases
w <- matrix(c(0,1,0,1,0,1,0,1,0), 3, 3)
y <- focal(x, w, fun=function(i)sign(K*sum(i)+sig+G))
Also see the cellular automata examples in ?focal
I have stack raster dataset with several layers, however, I want to calculate the sum of each cell with for different layer selection, and finally generate a new layer, anyone has some good suggestion by using calc or overlay or some other raster calculation in R?
I can do by loops and make the calculation, but it will consume many times when I have many layers, and also use many of the storage, my script as follows,
## library(raster)
make_calc <- function(rr, start, end) {
rr <- as.array(rr)
start <- as.array(start)
end <- as.array(end)
dms <- dim(raster)
tmp <- array(NA, dim = dms[1:2])
for (i in 1:dms[1]) {
for (j in 1:dms[2]) {
tmp[i,j] <- sum(raster[i,j,start[i,j,1]:end[i,j,1]], na.rm = TRUE)
}
}
return(tmp)
}
rr <- raster(res = 10)
rr[] <- 1
rr <- stack(rr, rr, rr, rr)
start <- raster(res = 10)
start[] <- sample(1:2, ncell(start), replace = TRUE)
end <- raster(res = 10)
end[] <- sample(3:4, ncell(end), replace = TRUE)
result <- make_calc(rr, start, end)
Why are you coercing into arrays? You can easily collapse a raster into a vector but, that does not even seem necessary here. In the future, please try to be more clear on what your expected outcome is.
Based on your code, I really don't know what you are getting at. I am going to take a few guesses on summing specified rasters in the stack, drawing a random sample, across rasters to be summed and finally, drawing a random sample of cells to be summed.
For a sum on specified rasters in a stack, you can just index what you are after in the stack using a double bracket. In this case, rasters 1 and 3 in the stack would be the only ones summed.
library(raster)
rr <- raster(res = 10)
rr[] <- 1
rr <- stack(rr, rr, rr, rr)
( sum_1_3 <- calc(rr[[c(1,3)]], sum) )
If you are wanting a random sample of the values across rasters, for every cell, you could write a function that is passed to calc. Here is an example that grabs a random sample of n size, across the raster layers values and sums them.
rs.sum <- function(x, n=2) {sum( x[sample(1:length(x),n)], na.rm=TRUE)}
rs.sum.raster <- calc(rr, rs.sum)
If you are wanting to apply a function to a limited random selection of cells, you could create a random sample of the raster that would be used as an index. Here we create a random sample of cells, create an empty raster and pipe the sum of rasters 1 and 2 (in the stack) based on the random sample cell index. A raster in the stack is indexed using the double bracket and the raster values are indexed using a single bracket so, for raster 1 in the stack with limiting to the values in the random sample you would use: rr[[1]][rs]
rs <- sample(1:ncell(rr[[1]]), 300)
r.sum <- rr[[1]]
r.sum[] <- NA
r.sum[rs] <- rr[[1]][rs] + rr[[2]][rs]
plot(r.sum)
I am relatively new to using R and working with GIS data.
I am trying to create a function to overlay two Raster layers, only when one of the rasters (in this case raster1) is at a certain value (in this case 0). I have tried numerous options in doing this but they don't seem to work. My last attempt is provided below, and it runs but the output just says NULL and it does not plot.
library(raster)
raster1 <- raster(ncols=10,nrows=10)
raster2 <- raster(ncols=10,nrows=10)
values(raster1) <- round(runif(ncell(raster1)))
values(raster2) <- round(runif(ncell(raster2)))
plot(raster1)
plot(raster2)
overlay_zero <- function (x, y) {
if (isTRUE(x == 0)) {
overlay(x, y, fun=function(x,y) {return(x+y)})}
}
z <- overlay_zero(raster1, raster2)
z
plot(z)
overlay_ras <- function(ras1,ras2,value=0){
result <- ras1
result[ras1==value] <- ras1[ras1==value] + ras2[ras1==value]
return(result)
}
overlaid <- overlay_ras(raster1,raster2,0)
This will do the trick. The function takes two rasters and a value which will be used to determine the cells affected by the overlay (addition).
This is my Initial Data
library(igraph)
From <- c(1,2,3,4,5,6,7,8)
To <- c("NULL",1,2,3,2,"NULL",6,7)
Value<-c(4,2,2,7,1,2,7,2)
Data <- data.frame(From,To,Value)
Network <- graph.data.frame(Data[,c("From","To")],directed=TRUE)
Network<- Network - "NULL"
plot(Network)
I want to create a condition which adds a characterization of the Datapoints.
So far i was capable of creating, the first and 2nd Degree of Condition, but i'm not capable of finding an Solution on how to create the 3rd condition to finalize the whole Construct.
I was capable of creating the Condition for the Root and the Starter, my Problem is how could i construct the condition for the connectors of the Starters. In this case the Connectors should be number 2 and 3. And Finally who didn't got characterized should be called Follower.
Root: Writes to no NULL
Starter: Value>X
Connector: Connects the starters(There will always be only one way of connecting them)
Follower= Rest
Some code here
cond<-Data$To=="NULL"
ToP<-ifelse(cond,"Root","Follower")
cond<-Data$Value>3
ToP<- ifelse(cond,"Starter",ToP)
NewData<-cbind(Data,ToP)
View(NewData)
My FinalData should kinda look like this:
From <- c(1,2,3,4,5,6,7,8)
To <- c("NULL",1,2,3,2,"NULL",6,7)
Value<-c(4,2,2,7,1,2,7,2)
ToP<-c(Starter,Connector,Connector,Starter,Follower,Root,Starter,Follower)
Data <- data.frame(From,To,Value, ToP)
It's still a bit messier than I would like, bit this appears to assing the correct lables to the vertices
V(Network)$ToP <- ifelse(Data$To=="NULL","Root","Follower")
V(Network)$ToP[Data$Value>3] <- "Starter"
vs <- V(Network)[ToP=="Starter"]
sp <- shortest.paths(Network, vs,vs)
cx <- which(is.finite(sp) & lower.tri(sp), arr.ind=T)
for(i in nrow(cx)) {
pp <- get.shortest.paths(Network, c(vs)[cx[i,1]], c(vs)[cx[i,2]])
fidx <- tail(head(pp$vpath[[1]], -1), -1)
if(length(fidx)>0) {
V(Network)[fidx]$ToP<-"Connector"
}
}
#verify with plot
V(Network)$color <- as.numeric(factor(V(Network)$ToP))+1
plot(Network)
legend(.5, -.5, levels(factor(V(Network)$ToP)), col=2:5, pch=20)