I made the following 25 network graphs (all of these graphs are copies for simplicity - in reality, they will all be different):
library(tidyverse)
library(igraph)
set.seed(123)
n=15
data = data.frame(tibble(d = paste(1:n)))
relations = data.frame(tibble(
from = sample(data$d),
to = lead(from, default=from[1]),
))
data$name = c("new york", "chicago", "los angeles", "orlando", "houston", "seattle", "washington", "baltimore", "atlanta", "las vegas", "oakland", "phoenix", "kansas", "miami", "newark" )
graph = graph_from_data_frame(relations, directed=T, vertices = data)
V(graph)$color <- ifelse(data$d == relations$from[1], "red", "orange")
plot(graph, layout=layout.circle, edge.arrow.size = 0.2, main = "my_graph")
library(visNetwork)
a = visIgraph(graph)
m_1 = 1
m_2 = 23.6
a = toVisNetworkData(graph) %>%
c(., list(main = paste0("Trip ", m_1, " : "), submain = paste0 (m_2, "KM") )) %>%
do.call(visNetwork, .) %>%
visIgraphLayout(layout = "layout_in_circle") %>%
visEdges(arrows = 'to')
y = x = w = v = u = t = s = r = q = p = o = n = m = l = k = j = i = h = g = f = e = d = c = b = a
I would like to "tile" them as 5 x 5 : Since these are interactive html plots - I used the following command:
library(manipulateWidget)
library(htmltools)
ff = combineWidgets(y , x , w , v , u , t , s , r , q , p , o , n , m , l , k , j , i , h , g , f , e , d , c , b , a)
htmltools::save_html(html = ff, file = "widgets.html")
I found out how to add a zoom option for each individual graph:
a = toVisNetworkData(graph) %>%
c(., list(main = paste0("Trip ", m_1, " : "), submain = paste0 (m_2, "KM") )) %>%
do.call(visNetwork, .) %>%
visIgraphLayout(layout = "layout_in_circle") %>%
visInteraction(navigationButtons = TRUE) %>%
visEdges(arrows = 'to')
y = x = w = v = u = t = s = r = q = p = o = n = m = l = k = j = i = h = g = f = e = d = c = b = a
ff = combineWidgets(y , x , w , v , u , t , s , r , q , p , o , n , m , l , k , j , i , h , g , f , e , d , c , b , a)
htmltools::save_html(html = ff, file = "widgets.html")
[![enter image description here][1]][1]
But now the "zoom" options and "titles" have "cluttered" all the graphs!
I was thinking it might be better to "stack" all these graphs on top of each other and save each graph as a "group type" - and then hide/unhide as we please:
visNetwork(data, relations) %>%
visOptions(selectedBy = "group")
Can we put all 25 graphs on one page and then "zoom" into each individual graph to view it better (e.g. have only one set of zoom/navigation buttons in the corner of the screen that works for all graphs)?
Is there a way to stop the titles from overlapping with the graphs?
Can we put all 25 graphs on one page and then "hide" individual graphs by "checking" an option menu button? (like the last example on this page: https://datastorm-open.github.io/visNetwork/options.html)
Here are the possible solutions I have thought of for this problem:
Option 1: (a single zoom/navigation option for all graphs and no cluttered labels)
Option 2: (In the future, each "trip" will be different - "trips" will contain the same nodes, but have different edge connections and different titles/subtitles.)
I know that this style of selection ("Option 2") can be made using the following code:
nodes <- data.frame(id = 1:15, label = paste("Label", 1:15),
group = sample(LETTERS[1:3], 15, replace = TRUE))
edges <- data.frame(from = trunc(runif(15)*(15-1))+1,
to = trunc(runif(15)*(15-1))+1)
visNetwork(nodes, edges) %>%
visOptions(selectedBy = "group")
But I am not sure how to adapt the above code for a pre-existing set of "visNetwork" graphs. For example, suppose I already have "visNetwork" graphs "a, b, c, d, e" - how can I "stack them on top of each other" and "shuffle through them" with a "select menu" like in the above code?
[![enter image description here][4]][4]
Can someone please show me a way of addressing this clutter problem using Option 1 and Option 2?
Thank you!
The sizing works, but at first glance, it looks like it doesn't. It's not ready, though.
When you select options, it doesn't trigger the auto-resize functionality within the canvases.
The auto-resize of the graph objects works just fine. (You'll see in the gif.)
The Viewer pane in RStudio is not the best way to check the knitted file. Look at it in a browser after knitting...especially if you want to make changes. It appears as if sometimes it thinks that all of RStudio is the container size, and you get graphs running off the screen. I'm sure it's how I have it coded, but that doesn't appear to be an issue in Safari or Chrome (I didn't check the other browsers).
I have tried to trigger the resizing of the canvas many different ways. This code may have some redundancies from attempts to trigger a resize/zoom extent of the canvases. (I think I deleted all of the things that didn't work.) Perhaps with this, someone else can figure that part out.
I used some Shiny code, but this is not using a Shiny runtime. Essentially the static work is R, but dynamic elements cannot be in R (i.e., resizing events, reading selections, etc.).
In the libraries I used, I called shinyRPG. I added and commented out package installation code because that package isn't a Cran package. (It's on Github.)
Assumptions I've made in coding (and this answer):
If these are not true, let me know.
The Output Options
---
title: "Just for antonoyaro8"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
---
This code goes between the YAML and the first R code chunk. In the regular text area of the RMD–not in an R chunk.
<style>
select {
// A reset of styles, including removing the default dropdown arrow
appearance: none;
background-color: transparent;
border: none;
padding: 0 1em 0 0;
margin: 0;
width: 100%;
font-family: inherit;
font-size: inherit;
cursor: inherit;
line-height: inherit;
}
.select {
display: grid;
grid-template-areas: "select";
align-items: center;
position: relative;
min-width: 15ch;
max-width: 100ch;
border: 1px solid var(--select-border);
border-radius: 0.25em;
padding: 0.25em 0.5em;
font-size: 1.25rem;
cursor: pointer;
line-height: 1.1;
background-color: #fff;
background-image: linear-gradient(to top, #f9f9f9, #fff 33%);
}
select[multiple] {
padding-right: 0;
/* Safari will not show options unless labels fit */
height: 50rem; // how many options show at one time
font-size: 1rem;
}
#column-1 > div.containIt > div.visNetwork canvas {
width: 100%;
height: 80%;
}
.containIt {
display: flex;
flex-flow: row wrap;
flex-grow: 1;
justify-content: space-around;
align-items: flex-start;
align-content: space-around;
overflow: hidden;
height: 100%;
width: 100%;
margin-top: 2vw;
height: 80vh;
widhth: 80vw;
overflow: hidden;
}
</style>
The first R chunk is next. You don't have to set echo = F in flexdashboard.
```{r setup, include=FALSE}
library(flexdashboard)
library(visNetwork)
library(htmltools)
library(igraph)
library(tidyverse)
library(shinyRPG) # remotes::install_github("RinteRface/shinyRPG")
```
This next part is essentially your code. I changed a few things in the final version of the call to create the vizNetwork.
```{r dataStuff}
set.seed(123)
n=15
data = data.frame(tibble(d = paste(1:n)))
relations = data.frame(tibble(
from = sample(data$d),
to = lead(from, default=from[1]),
))
data$name = c("new york", "chicago", "los angeles", "orlando", "houston", "seattle", "washington", "baltimore", "atlanta", "las vegas", "oakland", "phoenix", "kansas", "miami", "newark" )
graph = graph_from_data_frame(relations, directed=T, vertices = data)
#red circle: starting point and final point
V(graph)$color <- ifelse(data$d == relations$from[1], "red", "orange")
a = visIgraph(graph)
m_1 = 1
m_2 = 23.6
a = toVisNetworkData(graph) %>%
c(., list(main = paste0("Trip ", m_1, " : "),
submain = paste0 (m_2, "KM") )) %>%
do.call(visNetwork, .) %>%
visIgraphLayout(layout = "layout_in_circle") %>%
visEdges(arrows = 'to')
# collect the correct order
df2 <- data %>%
mutate(d = as.numeric(d),
nuname = factor(a$x$edges$from,
levels = unlist(data$name))) %>%
arrange(nuname) %>%
select(d) %>% unlist(use.names = F)
# [1] 11 5 2 8 7 6 10 14 15 4 12 9 13 3 1
V(graph)$name = data$label = paste0(df2, "\n", data$name)
a = visIgraph(graph)
m_1 = 1
m_2 = 23.6
a = toVisNetworkData(graph) %>%
c(., list(main = list(text = paste0("Trip ", m_1, " : "),
style = "font-family: Georgia; font-size: 100%; font-weight: bold; text-align:center;"),
submain = list(text = paste0(m_2, "KM"),
style = "font-family: Georgia; font-size: 100%; text-align:center;"))) %>%
do.call(visNetwork, .) %>%
visInteraction(navigationButtons = TRUE) %>%
visIgraphLayout(layout = "layout_in_circle") %>%
visEdges(arrows = 'to') %>%
visOptions(width = "100%", height = "80%", autoResize = T)
a[["sizingPolicy"]][["knitr"]][["figure"]] <- FALSE
y = x = w = v = u = t = s = r = q = p = o = n = m = l = k = j = i = h = g = f = e = d = c = b = a
```
Between the last chunk and before the next chunk of code is where this next part goes. This creates the left column, where the multi-select box is. (This is not in a code chunk.)
Column {data-width=200}
-----------------------------------------------------------------------
### Select Options
You can select one or more options from the list.
No to build the select box and append the function that will trigger changes. This part will require modification. Name the options that the user sees on the screen here. (letters[1:25] in this code.)
Your object names do not have to match the names you have here. They do need to be in the same order, though.
```{r selectiver}
tagSel <- rpgSelect(
"selectBox", # don't change this (connected)
"Selections:", # visible on HTML; change away or set to ""
c(setNames(1:25, letters[1:25])), # left is values, right is labels
multiple = T # all multiple selections
) # other attributes controlled by css at the top
tagSel$attribs$class <- 'select select--multiple' # connect styles
tagSel$children[[2]]$attribs$class <- "mutli-select" # connect styles
tagSel$children[[2]]$attribs$onchange <- "getOps(this)" # connect the JS function
tagSel
```
Then between the previous chunk and the next chunk (not in a chunk):
Column
-----------------------------------------------------------------------
<div class="containIt">
Now call your graphs.
```{r notNow, include=T}
a
b
c
d
e
f
g
h
i
j
k
l
m
n
o
p
q
r
s
t
u
v
w
x
y
```
Close the div tag after that chunk:
</div>
This started out nice and neat...but after a lot of trial and error–WYSIWYG. Effective commenting fizzled out somewhere along the way, too. If there are questions as to what does what, let me know.
This chunk won't do anything if you run the chunk in R Markdown (while in the Source pane). To execute JS, you have to knit.
```{r pickMe,results='asis',engine='js'}
//remove inherent knitr element-- after using mutlti-select starts harboring space
byeknit = document.querySelector('#column-1 > div.containIt > div.knitr-options');
byeknit.remove(1);
// Reset Sizing of Widgets
h = document.querySelector('#column-1 > div.containIt').clientHeight;
w = document.querySelector('#column-1 > div.containIt').clientWidth;
hw = h * w;
cont = document.querySelectorAll('#column-1 > div.containIt > div');
newHeight = Math.floor(Math.sqrt(hw/cont.length)) * .85;
for(i = 0; i < cont.length; ++i){
cont[i].style.height = newHeight + 'px';
cont[i].style.width = newHeight + 'px';
cn = cont[i].childNodes;
if(cn.length > 0){
th = cn[0].clientHeight + cn[1].clientHeight;
console.log("canvas found");
mb = newheight - th;
cn[5].style.height = mb + 'px'; //canvas control attempt
}
}
function resizePlease(count) { //resize plots based on selections
// screen may have resized**
h = document.querySelector('#column-1 > div.containIt').clientHeight;
w = document.querySelector('#column-1 > div.containIt').clientWidth;
hw = h * w; // get the area
// based on selected count** these should fit---
// RStudio!
newHeight = Math.floor(Math.sqrt(hw/count)) * .85;
for(i = 0; i < graphy.length; ++i){
graphy[i].style.height = newHeight + 'px';
graphy[i].style.width = newHeight + 'px';
gcn = graphy[i].childNodes;
if(cn.length > 0){
th = gcn[0].clientHeight + gcn[1].clientHeight;
mb = newHeight - th;
gcn[5].style.height = mb + 'px'; //canvas control attempt
canYouPLEASElisten = graphy[i].querySelector('canvas');
canYouPLEASElisten.style.height = mb + 'px'; //trigger zoom extent!!
canYouPLEASElisten.style.height = '100%';
}
}
}
// Something selected triggers this function
function getOps(sel) {
//get ref to select list and display text box
graphy = document.querySelectorAll('#column-1 div.visNetwork');
count = 0; // reset count of selected vis
// loop through selections
for(i = 0; i < sel.length; i++) {
opt = sel.options[i];
if ( opt.selected ) {
count++
graphy[i].style.display = 'block';
console.log(opt + "selected");
console.log(count + " options selected");
} else {
graphy[i].style.display = 'none';
}
}
resizePlease(count);
}
```
If you go to the developer tools console, you will be able to see how many and which options are selected as the selections are made. That way, if there is something odd like reverse order (which I suspect but couldn't validate), you'll see what is or isn't happening as you might have expected. Where ever you see console.log, that is sending a message to the console, so you can watch what's happening.
If there are any colors, custom or otherwise you would like in the background, let me know. I can help with that part, as well. Right now, the colors of the dashboard are the default colors.