I create the ring graph below with visNetwork. I would like to know if I can change its default layout to a series of horizontal nodes, with a large curvy arrow going from the last one back to the front, like this below. The first will be the 1 and the last the 4:
library(visNetwork)
nodes <- data.frame(id = 1:4,label=1:4)
edges <- data.frame(from = c(1,2,3,4), to = c(2,3,4,1))
edges$length<-c(90,90,90,750)
edges$smooth<-c(F,F,F,T)
edges$label<-c("","","","")
coords <- matrix(ncol=2, byrow=T, data=c(
-9,0,
-2,0,
7,0,
14,0.5
))
visNetwork(nodes, edges, width = "100%") %>%
visIgraphLayout(layout = "layout.norm", layoutMatrix = coords) %>%
visNodes(shape = "square",
color = list(background = "lightblue",
border = "darkblue",
highlight = "yellow"),
shadow = list(enabled = TRUE, size = 10)) %>%
visLayout(randomSeed = 12) # to have always the same network
Related
I tried the example proposed in the documentation of visNetwork R package regarding the usage of fontAwesome icons.
In the example below I use the option of passing the node properties via a data.frame. However, the color of the icons in the output gets a default blue color.
library(visNetwork)
nodes <- data.frame(id = 1:3,
shape = "icon",
icon.face = "FontAwesome",
color = c("#800000", "#0000ff", "#ffa500"), # doesn't have any effect on icon color
icon.code = c("f1ad", "f015", "f007"))
edges <- data.frame(from = c(1,2), to = c(2,3))
visNetwork(nodes, edges) %>%
addFontAwesome()
It seems that the alternative is to use the grouping option described in the documentation. However, I would want to have the data.frame option working as well and I can't figure out at the moment what I do wrong above.
nodes <- data.frame(id = 1:3,
shape = "icon",
group = c("A", "B", "C"))
edges <- data.frame(from = c(1,2), to = c(2,3))
visNetwork(nodes, edges) %>%
visGroups(groupname = "A", shape = "icon",
icon = list(code = "f1ad", color = "#800000")) %>%
visGroups(groupname = "B", shape = "icon",
icon = list(code = "f015", color = "#0000ff")) %>%
visGroups(groupname = "C", shape = "icon",
icon = list(code = "f007", color = "#ffa500")) %>%
addFontAwesome()
Change color to icon.color and everything works:
library(visNetwork)
nodes <- data.frame(id = 1:3,
shape = "icon",
icon.face = "FontAwesome",
icon.color = c("#800000", "#0000ff", "#ffa500"), # doesn't have any effect on icon color
icon.code = c("f1ad", "f015", "f007"))
edges <- data.frame(from = c(1,2), to = c(2,3))
visNetwork(nodes, edges) %>%
addFontAwesome()
In the tiny example shown below, I have two features associated with each country (polygons) in the map, namely: randomA, randomB. Each feature has its own legend, so I armed a group named "randomA" containing the polygons coloured with feature randomA and its corresponding legend. I did the same for group "randomB". When the map is depicted, leaflet correctly shows or hides polygons for features "randomA" and "randomB". However legends are always shown stacked on the bottom right corner.
This is the code:
library(rgdal)
library(leaflet)
# From http://data.okfn.org/data/datasets/geo-boundaries-world-110m
countries <- readOGR("json/countries.geojson")
n <- nrow(countries)
# Add two random fields
set.seed(15)
countries#data$randomA <- rnorm(n, 1000, 250)
countries#data$randomB <- rnorm(n, 10000, 3000)
map <- leaflet(countries) %>% addTiles()
pal <- colorNumeric(
palette = "YlGnBu",
domain = countries$randomA
)
map <- map %>%
addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1,
color = ~pal(randomA), group = "randomA"
) %>%
addLegend("bottomright", pal = pal, values = ~randomA,
title = "random A",
labFormat = labelFormat(prefix = "$"),
opacity = 1, group = "randomA"
)
qpal <- colorQuantile("RdYlBu", countries$gdp_md_est, n = 5)
map <- map %>%
addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1,
color = ~qpal(randomB), group = "randomB"
) %>%
addLegend(
"bottomright",
pal = qpal,
values = ~randomB,
opacity = 1, group = "randomB"
)
# Finally control layers:
map <- map %>%
addLayersControl(
baseGroups = c("randomA", "randomB"),
position = "bottomleft",
options = layersControlOptions(collapsed = F)
)
map
A snapshot of the result is shown in the image below:
Also, in the actual problem I have to represent nine of these groups, so I wish I had all the legends in the same place.
Do you have any suggestion?
Try using overlay groups instead of base groups:
addLayersControl(
overlayGroups = c("randomA", "randomB"),
position = "bottomleft",
options = layersControlOptions(collapsed = F)
)
How can I explicitly place nodes on a visNetwork graph?
Or: How can I recreate that graphic in R using visNetwork or an alternative?
Background: The ultimate goal is to represent Causal Loop Diagrams coming from Vensim files. Placing the nodes explicitly is just the first (crucial) step, because in Causal Loop Diagrams the visual mapping of nodes is part of the information (unlike in general graph theory). So if anybody has advice on the bigger picture aka. 'Bringing Causal Loop Diagram Modeling to R', I'll be more than happy.
What I tried:
library("visNetwork")
nodes <- data.frame(id = 1:3, label = c("one", "two", "three"))
edges <- data.frame(from = c(1,1,2), to = c(2,3,1))
visNetwork(nodes, edges, width = "100%", title = nodes$labels, stringsAsFactors = FALSE) %>% visEdges(arrows = "to")
which plots something like (exact layout will change, because of random seed):
With the Q&A from here I tried to place nodes manually by setting x and y values.
library("visNetwork")
nodes <- data.frame(id = 1:3, label = c("one", "two", "three"), x = c(0,1,2), y = c(0,1,2))
edges <- data.frame(from = c(1,1,2), to = c(2,3,1))
visNetwork(nodes, edges, width = "100%", title = nodes$labels, stringsAsFactors = FALSE) %>% visEdges(arrows = "to")
which plots:
..and I really don't understand what's the correspondance between x, y and the placing on the screen..
Also I could not find anything in the docs for visLayout.
It somehow turns out, that the x and y args are not working. Here a solution:
library("visNetwork")
nodes <- data.frame(id = 1:3, label = c("one", "two", "three"))
edges <- data.frame(from = c(1,1,2), to = c(2,3,1))
coords <- as.matrix(data.frame(x = c(0,1,2),
y = c(0,1,2),
stringsAsFactors = FALSE))
visNetwork(nodes, edges, width = "100%", title = nodes$labels) %>%
visNodes() %>%
visOptions(highlightNearest = TRUE) %>%
visInteraction(navigationButtons = TRUE,
dragNodes = TRUE, dragView = TRUE,
zoomView = FALSE) %>%
visEdges(arrows = 'to') %>%
visIgraphLayout(layout = "layout.norm", layoutMatrix = coords)
For history see also here.
Perhaps these links might be helpful for what you want to achive: causaleffect and plot.CLD
Using ggraph instead of visNetwork simplifies things.
library(ggraph)
library(igraph)
g <- make_graph(edges = c(1,2,2,1,1,3))
V(g)$name <- c('one', 'two', 'three')
ggraph(g, layout = 'manual', node.positions = data.frame(x = c(1,1,2), y = c(2,1,2.1))) +
geom_edge_arc(aes(start_cap = label_rect(node1.name),
end_cap = label_rect(node2.name)),
angle_calc = 'along',
label_dodge = unit(2.5, 'mm'),
arrow = arrow(length = unit(4, 'mm'))) +
geom_node_text(aes(label = name, x = x, y = y))
This plots
which is (apart from gridlines and colours) what I was searching for.
I am trying to change the color of the polygons drawn using leaflet and Mapzen. The colors are clearly visible with the current tiles but not as much with others, such as the addTiles(). How should I change the argument for the three polygons?
For the code to work you must enter a mapzen key.
library(rmapzen)
library(leaflet)
Sys.setenv(MAPZEN_KEY = "mapzen-******")
#https://tarakc02.github.io/rmapzen/#introduction
ucb <- mz_geocode("Via Giovanni Spadolini 7, Milan, Italy")
isos <- mz_isochrone(
ucb,
costing_model = mz_costing$auto(),
contours = mz_contours(c(5, 10, 15)),
polygons = TRUE
)
leaflet(as_sp(isos)) %>%
addProviderTiles("CartoDB.DarkMatter") %>%
addPolygons(color = ~color, weight = 1) %>%
addLegend(colors = ~color,
labels = ~paste(contour, "minutes"),
title = "Drive times from <br/> Centro Leoni")
I realized that the polygons should be added separately and instead of:
leaflet(as_sp(isos))
Solution:
iso10 <- as_sp(mz_isochrone(
ucb,
costing_model = mz_costing$auto(),
contours = mz_contours(10),
polygons = TRUE
))
iso30 <- as_sp(mz_isochrone(
ucb,
costing_model = mz_costing$auto(),
contours = mz_contours(30),
polygons = TRUE
))
iso60 <- as_sp(mz_isochrone(
ucb,
costing_model = mz_costing$auto(),
contours = mz_contours(60),
polygons = TRUE
))
m = leaflet() %>%
addProviderTiles("CartoDB.DarkMatter") %>%
addPolygons(data = iso10, color = "red", fillColor = "red")%>%
addPolygons(data = iso30, color = "green", fillColor = "green")%>%
addPolygons(data = iso60, color = "blue", fillColor = "blue")
I used leaflet package to creates a map widget, and then added two layers with the function addMarkers(). However, I found that the points on the map change their positions when zoom in and out. The relative scripts are as following:
First, create a function pchIcons with r shapes in leaflet
pchIcons <- function(pch = 0:14, width = 30, height = 30, col = 1:15, ...) {
pchLength <- length(pch)
pchFiles <- character(pchLength)
# create a sequence of png images
for (i in seq_len(pchLength)) {
pchTempFile <- tempfile(fileext = '.png')
png(pchTempFile, width = width, height = height, bg = 'transparent')
par(mar = c(0, 0, 0, 0))
plot.new()
points(.5, .5, pch = pch[i], cex = 1.5, col = col[i], ...)
dev.off()
pchFiles[i] = pchTempFile
}
pchFiles
}
Then create a base layer with Paris' position, and add two layers, each layer represents one group.
baseLayer <- leaflet(zero) %>%
addProviderTiles("Stamen.Toner") %>%
setView(posParis[["lng"]], posParis[["lat"]], zoom = 12)
addZeroLayer <- baseLayer %>%
addMarkers(popup = paste(paste(zero$Code, zero$Ecart),
zero$Address,
sep = "<br/>"),
lng = as.numeric(zero$Long),
lat = as.numeric(zero$Lat),
icon = ~ icons(
iconUrl = pchIcons(rep(magasinEcart[1], nrow(zero)),
40,
40,
col = colorZero,
lwd = 2)
),
group = '0')
addOneLayer <- addZeroLayer %>%
addMarkers(popup = paste(paste(one$Code, one$Ecart),
one$Address,
sep = "<br/>"),
lng = as.numeric(one$Long),
lat = as.numeric(one$Lat),
icon = ~ icons(
iconUrl = pchIcons(rep(magasinEcart[2], nrow(one)),
40,
40,
col = colorOne,
lwd = 2)
),
group = '1')
Next, add UI controls to switch layers on and off with addLayersControl() and add legend with addLegend().
mapTourist <- addOneLayer %>%
addLayersControl(overlayGroups = c('0', '1'),
options = layersControlOptions(collapsed = FALSE)) %>%
addLegend("bottomright",
pal = colorFactor(brewer.pal(9, 'Set1')[3:4],
unique(magasinBaseComp$Ecart)),
values = names(magasinEcart),
title = "Ecart",
opacity = 1)
Finally, we can find that when zoom in or out, the points on map moves (as screenshots show).
Does someone know what's the problem and how could I solve it? Any idea is welcomed!