How to avoid the double arrows in igraph - r

With the following code
library(igraph)
actors <- data.frame(name=c("a","b","c","d","e","f","g","h"))
relations <- data.frame(from=c("a", "a", "b", "b",
"b", "c", "d","d",
"g","e","g","d"),
to =c("d", "e", "c", "e",
"g", "f", "f", "g",
"h","b","d","a"),
weight = c(14,30,25,3,5,6,4,13,2,6,10,10))
g <- graph_from_data_frame(relations, directed=TRUE, vertices=actors)
test.layout <- layout_(g,with_dh(weight.edge.lengths = edge_density(g)/1000))
plot(g,vertex.size=30,edge.arrow.size= 0.5,edge.label = relations$weight,
layout = test.layout)
I produce the weighted directed graph
I would like to avoid the double arrows at the end of some edges. I would like to see, instead, two different edges (for example from d to a and from a to d).

You did not set the random seed before generating your layout so I do not get exactly your layout. Nervertheless, you can get two separate edges, by using the edge.curved argument to igraph.plot.
ENDS = ends(g, E(g))
Curv = rep(F, nrow(ENDS))
for(i in 1:nrow(ENDS)) {
Curv[i] = are.connected(g, ENDS[i,2], ENDS[i,1]) }
plot(g,vertex.size=30,edge.arrow.size=0.5,edge.label = relations$weight,
layout = test.layout, edge.curved=Curv)

You can use edge.curved=TRUE directly if you don't mind all curved edges (but you can customize your plot as you want, and the answer by #G5W looks nicer)
plot(g,
vertex.size = 30, edge.arrow.size = 0.5, edge.label = relations$weight,
layout = test.layout,
edge.curved = TRUE
)

Related

Formatting p-value cut-off line in a volcano plot in R

I am using the following function in R to develop a simple volcano plot:
EnhancedVolcano(all_genes, x = "logFC", y = "adjust.p.value", lab = all_genes$Gene.ID,
pCutoff = 10e-2, FCcutoff = 1)
I would like my pCutoff line to appear to represent p = 0.05 which on a log scale for this figure would appear as 1.3 on the y-axis. However, changing "10e-2" to say "10e-2.5" generates an error
Error: unexpected numeric constant in: "EnhancedVolcano(all_genes, x =
"logFC", y = "adjust.p.value", lab = all_genes$Gene.ID,
pCutoff = 10e-2.5"
Any suggestions on how I can get a horizontal p-value cut-off line at exactly 1.3 (currently appears at 1.2). Here is some reproducible data:
structure(list(X = 1:14, Gene.ID = c("A", "B", "C", "D", "E", "F",
"G", "H", "I", "J", "K", "L", "M", "N"), logFC = c(1.5,
0.17212922, 0.145542174, 0.304348578, 0.124636936, 0.247841044,
0.160818268, 0.123741518, 0.148530876, 0.148960225, 0.114135472,
-0.147118359, 0.095549291, 0.138521594), AveExpr = c(5.426424957,
4.289728233, 4.901134193, 4.742864705, 5.447030699, 4.539641767,
4.650750102, 5.901020922, 5.365944907, 5.818788787, 4.837214384,
7.017656548, 4.531897822, 5.192294452), t = c(6.15098624, 5.452898247,
4.979246654, 4.949519834, 4.818043279, 4.73403717, 4.701937811,
4.522692175, 4.518518374, 4.281900066, 4.247981727, -4.194421592,
4.10350597, 4.088357671), p.value = c(1.27e-09, 6.8e-08, 7.99e-07,
9.26e-07, 1.77e-06, 2.65e-06, 3.09e-06, 7.13e-06, 7.27e-06, 2.1e-05,
2.44e-05, 3.07e-05, 4.53e-05, 4.83e-05), adjust.p.value = c(1.64e-05,
0.000438854, 0.002987004, 0.002987004, 0.004558267, 0.005687325,
0.005687325, 0.010422933, 0.010422933, 0.027128901, 0.028601707,
0.033061438, 0.04452146, 0.04452146), B = c(11.2786109, 7.664706936,
5.439886439, 5.306497286, 4.725465519, 4.361868581, 4.224515919,
3.473656504, 3.45649938, 2.508304771, 2.376338878, 2.169980059,
1.825392322, 1.76867543)), class = "data.frame", row.names = c(NA,
-14L))
I think you want the following code where the p-value is calculated like p=10^-s where s is your 1.3 like this:
library(EnhancedVolcano)
EnhancedVolcano(all_genes, x = "logFC", y = "adjust.p.value", lab = all_genes$Gene.ID,
pCutoff = 10^-1.3, FCcutoff = 1)
Output:

make Owin object from list of coordinates

I'm trying to build species distribution polygons for use in the R program rase. The program requires an owin object but sample data also includes a SpatialPolygonDataFrame. You can get the data yourself with: data(rase_data, package = 'rase')
I'm starting with a list of coordinates (lat/long per species). Thanks to this answer here, I've been able to make a polygon per element of the list (each species). I need to get to an owin object. Here's the dput of some test data and then code I've used to get where I'm at.
#dput(specieslist)
specieslist <- structure(list(Species = c("A", "A", "A", "A", "A", "M", "A", "M", "A", "A", "A", "A", "A", "A", "M", "M", "A", "M", "A", "A", "A", "M", "M", "M", "A", "A", "A", "A", "A", "A", "A", "M", "A", "A", "M", "M", "A", "M", "M", "A"), lat = c(37.407002, 35.65242, 33.33891, 37.65105, 38.90657, 39.06893, 34.53998, 38.18311, 37.40006, 35.65242, 34.53998, 33.33891, 37.65105, 38.90657, 38.18311, 39.06893, 36.252183, 40.32555, 39.575983, 39.73548, 39.73548, 37.82096, 39.71557, 38.7222, 35.58556, 36.3075, 36.208, 33.967875, 35.375, 39.73589, 38.75774, 36.61058, 37.63605, 36.586111, 40.63344, 39.80565, 39.72601, 39.70529, 40.50957, 37.81238), long = c(-122.232016, -120.77931, -116.91402, -119.88513, -121.05138, -120.86546, -119.85962, -120.37691, -122.23219, -120.77931, -119.85962, -116.91402, -119.88513, -121.05138, -120.37691, -120.86546, -121.775867, -121.91209, -121.554167, -121.70126, -121.70126, -120.14661, -121.61181, -120.98745, -120.9122, -121.4806, -121.816, -120.097752, -120.6456, -121.70175, -120.8443, -119.05645, -119.8728, -121.914722, -121.87499, -121.71465, -121.76862, -121.53125, -122.10229, -120.42828)), class = "data.frame", row.names = c(NA, -40L))
Make the polygon per species/points by creating hull around points:
#create simple feature
library(sf)
df.sf <- specieslist %>%
st_as_sf( coords = c("long", "lat" ), crs = 4326 )
# perform fast visual check using mapview-package
#mapview::mapview( df.sf )
#group and summarise by species, and draw hulls
hulls <- df.sf %>%
group_by( Species ) %>%
summarise( geometry = st_combine( geometry ) ) %>%
st_convex_hull()
##result
#mapview::mapview( list(df.sf, hulls ) )
Now I think df.sf (sf points object) becomes the SpatialPolygonDataFrame and hulls (sf polygon object) becomes an owin object:
as(df.sf, "Spatial") -> df.sf_SPDF #this formats incorrectly though.
distribution <- st_transform(hulls, crs = 6345)
Dist_owin <- as.owin(as_Spatial(distribution))
#Error: Only projected coordinates may be converted to spatstat class objects
#OR
as.owin(distribution)
#Error: 'owin' is not an exported object from 'namespace:spatstat'
maptools::as.owin(distribution)
#Error: 'as.owin' is not an exported object from 'namespace:maptools'
The problems are: df.sf_SPDF seems to be formatted incorrectly and Dist_owin errors.
I find all this spatial work in R very confusing. I've been working on this for several days now.
UPDATE: If I try another way- convert geometry to polygon and then make the owin. This produces an error:
hulls_poly <- st_cast(distribution$geometry, "POLYGON") #.
Dist_owin <- as.owin(as_Spatial(hulls_poly))
#ERROR: no method or default for coercing “sfc_POLYGON” to “owin”
I do not know sf enough to fix this, so I show it via terra but the important part is the sequence of operations. You can implement that in sf again if you wish. There should be no need to revert to the old Spatial* objects
Your data
specieslist <- structure(list(Species = c("A", "A", "A", "A", "A", "M", "A", "M", "A", "A", "A", "A", "A", "A", "M", "M", "A", "M", "A", "A", "A", "M", "M", "M", "A", "A", "A", "A", "A", "A", "A", "M", "A", "A", "M", "M", "A", "M", "M", "A"), lat = c(37.407002, 35.65242, 33.33891, 37.65105, 38.90657, 39.06893, 34.53998, 38.18311, 37.40006, 35.65242, 34.53998, 33.33891, 37.65105, 38.90657, 38.18311, 39.06893, 36.252183, 40.32555, 39.575983, 39.73548, 39.73548, 37.82096, 39.71557, 38.7222, 35.58556, 36.3075, 36.208, 33.967875, 35.375, 39.73589, 38.75774, 36.61058, 37.63605, 36.586111, 40.63344, 39.80565, 39.72601, 39.70529, 40.50957, 37.81238), long = c(-122.232016, -120.77931, -116.91402, -119.88513, -121.05138, -120.86546, -119.85962, -120.37691, -122.23219, -120.77931, -119.85962, -116.91402, -119.88513, -121.05138, -120.37691, -120.86546, -121.775867, -121.91209, -121.554167, -121.70126, -121.70126, -120.14661, -121.61181, -120.98745, -120.9122, -121.4806, -121.816, -120.097752, -120.6456, -121.70175, -120.8443, -119.05645, -119.8728, -121.914722, -121.87499, -121.71465, -121.76862, -121.53125, -122.10229, -120.42828)), class = "data.frame", row.names = c(NA, -40L))
First I make a spatial object, a SpatVector in this case, and I transform it to a planar CRS --- to get that out of the way.
Your choice of epsg:6345, that is +proj=utm +zone=16 is inappropriate for your data. Zone 16 is for the longitude of Alabama. California covers two UTM zones so you cannot use that. Instead use e.g. "Teale Albers" if all your data are confined to the Golden State.
library(terra)
#terra version 1.2.5
v <- vect(specieslist, c("long", "lat"), crs="epsg:4326")
tacrs <- "+proj=aea +lat_1=34 +lat_2=40.5 +lat_0=0 +lon_0=-120 +x_0=0 +y_0=-4000000 +datum=NAD83 +units=m"
v <- project(v, tacrs)
To simplify things, I show a workflow for 1 species
usp <- unique(v$Species)
sp <- v[v$Species==usp[1]]
Make a convex hull, and I think you would want to add a buffer.
ch <- terra::convexhull(sp)
bch <- buffer(ch, 25000)
plot(bch)
points(sp)
Now make the owin via sf
library(sf)
library(spatstat)
sfobj <- st_as_sf(bch)
owin <- as.owin(sfobj)
You can extract the points in new CRS like this
pxy <- terra::coords(sp)
And now create a spatstat ppp object.
x <- ppp(pxy[,1], pxy[,2], window=owin)
#Warning message:
#data contain duplicated points
To avoid the above warning, you could use, at the start of the script, specieslist <- unique(specieslist)
x
#Planar point pattern: 27 points
#window: polygonal boundary
#enclosing rectangle: [-222286.97, 312378.62] x [-539742.6, 217425] units

Redirecting networkd3 node click to a dynamic url based on a value

I am trying to build interactive network visualizations of objects that are linked.
I have reviewed the code at:
https://christophergandrud.github.io/networkD3/
but was not able to locate a code sample that would help me to convert Nodes into clickable urls that would redirect user or would launch a new browser window.
Is this possible?
My question relates to the networkD3 charts that are saved as html using this code sample:
library(networkD3)
library(magrittr)
Source <- c("A", "A", "A", "A", "B", "B", "C", "C", "D")
Target <- c("B", "C", "D", "J", "E", "F", "G", "H", "I")
NetworkData <- data.frame(Source, Target)
simpleNetwork(NetworkData) %>% saveNetwork(file = 'Net1.html')
You will need to use the forceNetwork() function in order to get that capability, plus some extra work.
(example largely based on #timelyportfolio's code here: linking a node in networkD3 to a website using clickAction = NULL)
library(networkD3)
library(magrittr)
data(MisLinks)
data(MisNodes)
fn <- forceNetwork(
Links = MisLinks, Nodes = MisNodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
Group = "group", opacity = 0.4, zoom = TRUE
)
fn$x$nodes$hyperlink <- paste0(
'http://en.wikipedia.org/wiki/Special:Search?search=',
MisNodes$name
)
fn$x$options$clickAction = 'window.open(d.hyperlink)'
fn %>% saveNetwork(file = 'Net1.html')

How to construct bipartite graphs using igraph? [duplicate]

This question already has an answer here:
How to create a bipartite network in R with igraph or tnet
(1 answer)
Closed 5 years ago.
I need to create a bipartite graph for consumer-brand relationships.
This is my example data:
datf <- data.frame(Consumers = c("A", "B", "C", "D", "E"),
Brands = c("Costa", "Starbucks", "Cafe2U", "Costa", "Costa"))
The following code gives me a network. But I am not sure how I can add a node type attribute to label consumers and brands:
library(igraph)
dat=read.csv(file.choose(),header=TRUE)
el=as.matrix(dat)
el[,1]=as.character(el[,1])
el[,2]=as.character(el[,2])
g=graph.edgelist(el,directed=FALSE)
I would like to create a bipartite graph with edges that connect each consumer with the brand they like. Ideally, the nodes will be labeled with text.
Could you show me how to do this using library(igraph)?
This resource at Shizuka Lab is really useful for exploring bipartite networks in R with igraph. In short:
library(igraph)
# Your matrix containing consumer choice by brands
m = matrix(data = sample(0:1, 25, replace = TRUE), nrow = 5, ncol = 5)
colnames(m) = c("A", "B", "C", "D", "E")
rownames(m) = c("Costa", "Starbucks", "Cafe2U", "Petes", "Philz")
# Convert it to a bipartitie network
bg = igraph::graph.incidence(m)
bg
# See the vertex attributes
V(bg)$type
V(bg)$name
# Plot the network
shape = ifelse(V(bg)$type, "circle", "square") # assign shape by node type
col = ifelse(V(bg)$type, "red", "yellow") # assign color by node type
plot(bg, vertex.shape = shape, vertex.color = col)
Gives:

How to capture html output as png in R

I use interactive output created by networkD3 package in R. I know how to save the output as html page, but I also need to save the 'static' version of the diagram as .png file.
The code looks like this:
# Load package
library(networkD3)
# Create fake data
src <- c("A", "A", "A", "A", "B", "B", "C", "C", "D")
target <- c("B", "C", "D", "J", "E", "F", "G", "H", "I")
networkData <- data.frame(src, target)
# Plot
simpleNetwork(networkData)
I can save the output by clicking on 'Export' and then 'Save as Image'. However, I prefer to use some commands in my code to save the picture.
just an update to the possible solutions. There is a package called webshot (by W. Chang, et al.) that does this rendering and taking screenshots of html pages.
e.g usage:
webshot::webshot("file.html")
And to get the html file, you might want to check out htmlwidgets::saveWidget by R. Vaidyanathan, et al.
a fully reproducible example (saves simpleNetwork.png in your current working directory)
library(networkD3)
src <- c("A", "A", "A", "A", "B", "B", "C", "C", "D")
target <- c("B", "C", "D", "J", "E", "F", "G", "H", "I")
networkData <- data.frame(src, target)
sn <- simpleNetwork(networkData)
saveNetwork(sn, "sn.html")
library(webshot)
webshot("sn.html", "simpleNetwork.png")
I used function from this page https://github.com/hafen/trelliscope/blob/master/R/thumb.R and tried to simplify it.
You need to have PhantomJS installed from http://phantomjs.org/download.html and the path set in environment variables.
The function looks like this (param p is the html widget, thumbName is the name of new .png file):
library(htmlwidgets)
widgetThumbnail <- function(p, thumbName, width = 1024, height = 768) {
phantom <- findPhantom()
success <- FALSE
if(phantom == "") {
message("** phantomjs dependency could not be found - thumbnail cannot be generated (run phantomInstall() for details)")
} else {
res <- try({
ff <- paste0(thumbName, ".html")
ffjs <- paste0(thumbName, ".js")
# don't want any padding
p$sizingPolicy$padding <- 0
suppressMessages(saveWidget(p, ff, selfcontained = FALSE))
js <- paste0("var page = require('webpage').create();
page.viewportSize = { width: ", width,", height: ", height," };
page.clipRect = { top: 0, left: 0, width: ", width,", height: ", height," };
page.open('", ff, "', function(status) {
console.log(\"Status: \" + status);
if(status === \"success\") {
page.render('", thumbName, ".png');
}
phantom.exit();
});")
cat(js, file = ffjs)
system2(phantom, ffjs)
})
if(!inherits(res, "try-error")) {
success <- TRUE
}
if(!file.exists(paste0(thumbName, ".png"))) {
success <- FALSE
}
}
if(!success) {
message("** could not create htmlwidget thumbnail... creating an empty thumbnail...")
}
}
#' Get instructions on how to install phantomjs
#' #export
phantomInstall <- function() {
message("Please visit this page to install phantomjs on your system: http://phantomjs.org/download.html")
}
# similar to webshot
findPhantom <- function() {
phantom <- Sys.which("phantomjs")
if(Sys.which("phantomjs") == "") {
if(identical(.Platform$OS.type, "windows")) {
phantom <- Sys.which(file.path(Sys.getenv("APPDATA"), "npm", "phantomjs.cmd"))
}
}
phantom
}
It creates .js file, which takes your html widget, captures the screen and saves .js, .html and .png files into active directory:
# Load package
library(networkD3)
# Create fake data
src <- c("A", "A", "A", "A", "B", "B", "C", "C", "D")
target <- c("B", "C", "D", "J", "E", "F", "G", "H", "I")
networkData <- data.frame(src, target)
# Plot
plot = simpleNetwork(networkData)
# Save html as png
widgetThumbnail(p = plot, thumbName = "plot", height = 500)

Resources