How to capture html output as png in R - 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)

Related

How to avoid the double arrows in igraph

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
)

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

Arguments for `vpList` from `grid` package

This is probably silly but how do I dynamically create a vpTree like
library(grid)
grid.newpage()
vpTree( viewport(layout=grid.layout(2,2), name = "body"), vpList(viewport(name= "a"), viewport(name ="b"), viewport(name = "c"), viewport(name = "d")))
#> viewport[body]->(viewport[a], viewport[b], viewport[c], viewport[d])
I cannot pass a list of viewports:
library(grid)
grid.newpage()
n <- c(viewport(name= "a"), viewport(name ="b"), viewport(name = "c"), viewport(name = "d"))
vpTree( viewport(layout=grid.layout(2,2), name = "body"), vpList(n))
#> Error in vpListFromList(vps): only viewports allowed in 'vpList'
Any ideas?
The first thing vpList does is to convert its argument in a list. I needed to overwrite the vpList function from grid with a custom function to bypass the list from
> vpList
function (...)
{
vps <- list(...)
vpListFromList(vps)
}
<bytecode: 0x000002e14a815a60>
<environment: namespace:grid>
to
vpList <- function (vps)
{
grid:::vpListFromList(vps)
}
Like this:
library(grid)
grid.newpage()
vpListX <- function (vps)
{
grid:::vpListFromList(vps)
}
n <- list(viewport(name= "a"), viewport(name ="b"), viewport(name = "c"), viewport(name = "d"))
vpTree( viewport(layout=grid.layout(2,2), name = "body"), vpListX(n))
The way you create vpList is incorrect.
Try this-
##Supply same list to variable and then pass it in function
library(grid)
grid.newpage()
n <- vpList(viewport(name= "a"), viewport(name ="b"), viewport(name = "c"), viewport(name = "d"))
vpTree( viewport(layout=grid.layout(2,2), name = "body"), n)

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')

Embedding networkD3 in R Markdown, why this error?

I'm trying to add a network graph to an R Markdown file write a paper. I'm able to make the graph just fine using NetworkD3 to visualise it. I'd like to create an interactive HTML, but I keep getting errors. Here is an example:
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r}
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)
simpleNetwork(networkData)
```
I then get this error, which is very similar to the errors I get when trying to embed my own graph.
processing file: w.Rmd
|........ | 12%
ordinary text without R code
|................ | 25%
label: setup (with options)
List of 1
$ include: logi FALSE
|........................ | 38%
label: unnamed-chunk-1
Quitting from lines 12-16 (w.Rmd)
Error in eval(expr, envir, enclos) :
could not find function "simpleNetwork"
Calls: <Anonymous> ... handle -> withCallingHandlers -> withVisible -> eval
-> eval
Execution halted
You need to load the networkD3 package in your setup, like this...
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(networkD3)
```
```{r}
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)
simpleNetwork(networkData)
```
I figured out what I was doing wrong. I have to load my data into the Markdown file. I found the answer here https://support.rstudio.com/hc/en-us/community/posts/200631198-data-set-not-found-when-knitting-HTML.

Resources