I've tried to draw a spiral plot for my data.
Here is my igraph network:
https://bulut.omu.edu.tr/index.php/s/WoSFKhMV7Rxtgem
So far, I've created this script which creates a circle plot. My problem is that the color of node should change according k-core. It means that outside of circle should be lighter and the center should be darker!:
# Load Library
library(igraph)
library(RColorBrewer)
# Classic palette for red, with 5 colors
coul01 = brewer.pal(5, "RdPu")
# I can add more tones to this palette :
coul01 = colorRampPalette(coul01)(60)
# Load igraph object
g <- readRDS("~g.rds")
# Plot coreness
CorenessLayout <- function(g) {
coreness <- V(g)$kCore;#graph.coreness(g);
xy <- array(NA, dim=c(length(coreness), 2));
shells <- sort(unique(coreness));
for(shell in shells) {
v <- 1 - ((shell-1) / max(shells));
nodes_in_shell <- sum(coreness==shell);
angles <- seq(0,360,(360/nodes_in_shell));
angles <- angles[-length(angles)]; # remove last element
xy[coreness==shell, 1] <- sin(angles) * v;
xy[coreness==shell, 2] <- cos(angles) * v;
}
return(xy);
}
# create layout
ll <- CorenessLayout(g);
# plot
plot(g, layout=ll, vertex.size=1, vertex.color=coul01,
edge.width=.001,edge.arrow.size=.001,vertex.label=NA,
vertex.frame.color=coul01)
Thanks in advance for any suggestion.
PS: If you couldn't see the end result, please use this link
https://bulut.omu.edu.tr/index.php/s/sQpxqIOH04x9wtW
Related
I'm trying to plot a graph with R and igraph, using a mix of shapes and raster images for the vertices. I've modified the igraph example below to reproduce my problem. Can someone see what is wrong? You'll need a png file to test the script.
library(png)
library(igraph)
img.1 <- readPNG(system.file("img", "Rlogo.png", package="png"))
shapes <- setdiff(shapes(), "")
g <- make_ring(length(shapes))
V(g)$shape <- shapes
#change the rectangle variants to raster
V(g)$shape[grepl("rect",V(g)$shape)] <- "raster"
#give every vertex the same image, regardless of shape
V(g)$raster <- replicate(vcount(g), img.1, simplify=FALSE)
plot(g,
vertex.size=15, vertex.size2=15,
vertex.pie=lapply(shapes, function(x) if (x=="pie") 2:6 else 0),
vertex.pie.color=list(heat.colors(5)))
This seems to be one way, but it needs a bit of manual tweaking to fit the rasters.
library(png)
library(igraph)
# Your code
img.1 <- readPNG(system.file("img", "Rlogo.png", package="png"))
shapes <- setdiff(shapes(), "")
g <- make_ring(length(shapes))
V(g)$shape <- shapes
# Change some shapes to user defined
V(g)$shape[grepl("rect",V(g)$shape)] <- "myimg"
# Using idea from http://igraph.org/r/doc/shapes.html
# define function for image
# manually tweaked the x any y to increase size of image
myimg <- function(coords, v=NULL, params) {
vertex.size <- 1/200 * params("vertex", "size")
if (length(vertex.size) != 1 && !is.null(v)) {
vertex.size <- vertex.size[v]
}
rasterImage(img.1,
coords[,1]-vertex.size, coords[,2]-vertex.size,
coords[,1]+vertex.size, coords[,2]+vertex.size)
}
# add shape
add_shape("myimg", plot=myimg)
# plot
plot(g, vertex.size=seq(5, 5*length(shapes), 5), vertex.size2=seq(5, 5*length(shapes), 5)
vertex.pie=lapply(shapes, function(x) if (x=="pie") 2:6 else 0),
vertex.pie.color=list(heat.colors(5)))
To give
I dare say there is a more igraph approach to this
I am trying to create pretty figures of clustered points. Is there a package which will create the divide chain between tessellations of points? Ideally it would be fit for plotting in ggplot.
Here is some example code:
#DivideLineExample
library(spatstat)
W=owin(c(0,1),c(0,1)) # Set up the Window
p<-runifpoint(42, win=W) # Get random points
ll=cbind(p$x,p$y) # get lat/long for each point
zclust=kmeans(ll,centers=4) # Cluster the points spatially into 4 clusters
K<-pp<-D<-list()
plot(W,main="Clustered Points")
for (i in 1:4){ # this breaks up the points into separate ppp objects for each cluster
K[[i]]=ll[zclust$cluster==i,]
pp[[i]]=as.ppp(K[[i]],W)
plot(pp[[i]],col=i,add=TRUE,cex=1.5,pch=16)
D[[i]]=dirichlet(pp[[i]]) # This performs the Dirichlet Tessellation and plots
plot(D[[i]],col=i,add=TRUE)
}
This outputs as such:
http://imgur.com/CCXeOEB
What I'm looking for is this:
http://imgur.com/7nmtXjo
I know an algorithm exists.
Any ideas/alternatives?
I have written a function that I think will do what you want:
divchain <- function (X) {
stopifnot(is.ppp(X))
if(!is.multitype(X)) {
whinge <- paste(deparse(substitute(X)),
"must be a marked pattern with",
"factor valued marks.\n")
stop(whinge)
}
X <- unique(X, rule = "deldir", warn = TRUE)
w <- Window(X)
require(deldir)
dd <- deldir(X,z=marks(X),rw=c(w$xrange,w$yrange))
if (is.null(dd))
return(NULL)
ddd <- dd$dirsgs
sss <- dd$summary
z <- sss[["z"]]
rslt <- list()
nsgs <- nrow(ddd)
K <- 0
for (i in 1:nsgs) {
i1 <- ddd[i,5]
i2 <- ddd[i,6]
c1 <- z[i1]
c2 <- z[i2]
if(c1 != c2) {
K <- K+1
rslt[[K]] <- unlist(ddd[i,1:4])
}
}
class(rslt) <- "divchain"
attr(rslt,"rw") <- dd$rw
rslt
}
I have also written a plot method for class "divchain":
plot.divchain <- function(x,add=FALSE,...){
if(!add) {
rw <- attr(x,"rw")
plot(0,0,type="n",ann=FALSE,axes=FALSE,xlim=rw[1:2],ylim=rw[3:4])
bty <- list(...)$bty
box(bty=bty)
}
lapply(x,function(u){segments(u[1],u[2],u[3],u[4],...)})
invisible()
}
E.g.:
require(spatstat)
set.seed(42)
X <- runifpoint(50)
z <- factor(kmeans(with(X,cbind(x,y)),centers=4)$cluster)
marks(X) <- z
dcX <- divchain(X)
plot(dirichlet(X),border="brown",main="")
plot(X,chars=20,cols=1:4,add=TRUE)
plot(dcX,add=TRUE,lwd=3)
Let me know whether this is satisfactory. Sorry I can't help you with ggplot stuff; I don't do ggplot.
You could try point in polygon test for example like kirkpatrick data structure. Much easier is to divide the polygon in horizontal or vertical. Source:http://www.personal.kent.edu/~rmuhamma/Compgeometry/MyCG/Voronoi/DivConqVor/divConqVor.htm
I'm having some issues when using persp3d() function in R. Here is my code:
library(rgl)
vero=function(mu,sigma,datos)
{
n=length(datos)
media=mean(datos)
S2=sd(datos)^2
lvero=(-n/2)*log(2*pi*sigma)-(n/(2*sigma))*S2-(n/(2*sigma))*(media-mu)^2
return(exp(lvero))
}
nbebes=rnorm(20, mean=75, sd=2.5)
mu.seq <- seq(60,100,length=2000)
sigma.seq <- seq(1,20,length=2000)
f <- Vectorize(vero,vectorize.args=c("mu","sigma"))
z <- outer(mu.seq,sigma.seq,f,datos=nbebes)
zlim <- range(z[!is.na(z)])
palette <- rev(rainbow(20))
colors <- palette[19*(z-zlim[1])/diff(zlim) + 1]
persp3d(mu.seq,sigma.seq,z,col=colors)
And the output of the code is this graph:
What am I doing wrong? Sometimes I get another result which is a rainbow colored function like this one:
But as you can see it is not completely colored and I don't know what to change or rewrite to get the proper result.
I can't say eaxactly why this is an issue, but it seems to have to do with the limits of your z-axis. When I rescale z to z2 <- z / max(z) then it ranges between 0 and 1 and plots well. This might be an issue with rgl. Here's an example:
nbebes=rnorm(20, mean=75, sd=2.5)
mu.seq <- seq(60,100,length=500)
sigma.seq <- seq(1,20,length=500)
f <- Vectorize(vero,vectorize.args=c("mu","sigma"))
z <- outer(mu.seq,sigma.seq,f,datos=nbebes)
z2 <- z/max(z)
colors <- rev(rainbow(20))
breaks <- seq(zlim[1], zlim[2], length.out=(length(colors)+1))
CUT <- cut(z2, breaks=breaks, include.lowest = TRUE)
colorlevels <- colors[match(CUT, levels(CUT))] # assign colors to heights for each point
persp3d(mu.seq,sigma.seq,z2,color=colorlevels)
autocurve.edges does an amazing job of curving edges in igraph plots so that they don't overlap when they point in the same direction. However, when they point in opposite directions, no curvature is applied.
d <- data.frame(start=c("a","a","b","c"),end=c("b","b","c","b"))
graph <- graph.data.frame(d, directed=T)
plot(graph,
vertex.color="white")
The issue is for the arrows between b and c (or c and b).
Other than specifying curvature manually, any suggestions?
I would use the edge.curved option with the same seq call that autocurve.edges uses.
plot(graph,
vertex.color="white", edge.curved=seq(-0.5, 0.5, length = ecount(graph)))
EDIT:
As Étienne pointed out, this solution also curves edges for unique observations. The solution is then to modify the autocurve.edges function. This is my modified function called autocurve.edges2. Basically, it generates a vector, which curves only non-unique edges.
autocurve.edges2 <-function (graph, start = 0.5)
{
cm <- count.multiple(graph)
mut <-is.mutual(graph) #are connections mutual?
el <- apply(get.edgelist(graph, names = FALSE), 1, paste,
collapse = ":")
ord <- order(el)
res <- numeric(length(ord))
p <- 1
while (p <= length(res)) {
m <- cm[ord[p]]
mut.obs <-mut[ord[p]] #are the connections mutual for this point?
idx <- p:(p + m - 1)
if (m == 1 & mut.obs==FALSE) { #no mutual conn = no curve
r <- 0
}
else {
r <- seq(-start, start, length = m)
}
res[ord[idx]] <- r
p <- p + m
}
res
}
And here's the result when adding a single, non-mutual edge (C->D):
library(igraph)
d <- data.frame(start=c("a","a","b","c","c"),end=c("b","b","c","b","d"))
graph <- graph.data.frame(d, directed=T)
curves <-autocurve.edges2(graph)
plot(graph, vertex.color="white", edge.curved=curves)
It seems that a statistical problem that I am working on requires doing something known in computational geometry as "offline orthogonal range counting":
Suppose I have a set of n points (for the moment, in the plane). For every pair of points i and j, I would like to count the number of remaining points in the set that are in the rectangle whose diagonal is the segment with endpoints i and j. The overall output then is a vector of n(n-1) values each in [0, 1, 2, ... , n-2].
I've seen that a rich literature on the problem (or at least a very similar problem) exists, but I cannot find an implementation. I would prefer an R (a statistical computing language) package, but I guess that's asking too much. An open source C/C++ implementation will also work.
Thanks.
I hope I understand well your proble. Here an implementation in R using package geometry. I use
mesh.drectangle function which compute a signed distance from points p to boundary of rectangle.
I create a combination for all points using combn
for each point p of combination , I compute the distance from the rectangle rect_p to the others points
if distance < 0 I choose the points.
For example
library(geometry)
## I generate some data
set.seed(1234)
p.x <- sample(1:100,size=30,replace=T)
p.y <- sample(1:100,size=30,replace=T)
points <- cbind(p.x,p.y)
## the algortithm
ll <- combn(1:nrow(points),2,function(x){
x1<- p.x[x[1]]; y1 <- p.y[x[1]]
x2<- p.x[x[2]]; y2 <- p.y[x[2]]
p <- points[-x,]
d <- mesh.drectangle(p,x1,y1,x2,y2)
res <- NA
if(length(which(d <0))){
points.in = as.data.frame(p,ncol=2)[ d < 0 , ]
res <- list(n = nrow(points.in),
rect = list(x1=x1,x2=x2,y1=y1,y2=y2),
points.in = points.in)
}
res
},simplify=F)
ll <- ll[!is.na(ll)]
## the result
nn <- do.call(rbind,lapply(ll,'[[','n'))
To visualize the results, I plots rectangles with 5 points for example.
library(grid)
grid.newpage()
vp <- plotViewport(xscale = extendrange(p.x),
yscale = extendrange(p.y))
pushViewport(vp)
grid.xaxis()
grid.yaxis()
grid.points(x=points[,'p.x'],y=points[,'p.y'],pch='*')
cols <- rainbow(length(ll))
ll <- ll[nn == 5] ## here I plot only the rectangle with 5 points
lapply(seq_along(ll),function(i){
x <- ll[[i]]
col <- sample(cols,1)
x1<- x$rect$x1; x2<- x$rect$x2
y1<- x$rect$y1; y2<- x$rect$y2
grid.rect(x=(x1+x2)*.5,y=(y1+y2)*.5,
width= x2-x1,height = y2-y1,
default.units ='native',
gp=gpar(fill=col,col='red',alpha=0.2)
)
grid.points(x=x$points.in$p.x,y=x$points.in$p.y,pch=19,
gp=gpar(col=rep(col,x$n)))
}
)
upViewport()