Directly Adding Titles and Labels to Visnetwork

We can try this approach if you like

toVisNetworkData(graph) %>%
  c(list(main = "my title")) %>%
  do.call(visNetwork, .)

toVisNetworkData(graph) %>%
  {
    do.call(visNetwork, c(., list(main = "my title", submain = "subtitle")))
  }

and you will see

Sample Image

Understanding list and do.call commands

Please find below one possible solution.

Reprex

Your data

library(dplyr)
library(visNetwork)

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

Suggested code

toVisNetworkData(graph) %>%
  c(., list(main = "my title", submain = "subtitle")) %>%
  do.call(visNetwork, .) %>%
  visIgraphLayout(layout = "layout_in_circle") %>% 
  visEdges(arrows = 'to')

Sample Image

^{Created on 2022-02-25 by the reprex package (v2.0.1)}

Adding additional information to a visNetwork

Data_I_Have <- data.frame(

  "Node_A" = c("John", "John", "John", "Peter", "Peter", "Peter", "Tim", "Kevin", "Adam", "Adam", "Xavier"),
  "Node_B" = c("Claude", "Peter", "Tim", "Tim", "Claude", "Henry", "Kevin", "Claude", "Tim", "Henry", "Claude"),
  "Place_Where_They_Met" = c("Chicago", "Boston", "Seattle", "Boston", "Paris", "Paris", "Chicago", "London", "Chicago", "London", "Paris"),
  "Years_They_Have_Known_Each_Other" = c("10", "10", "1", "5", "2", "8", "7", "10", "3", "3", "5"),
  "What_They_Have_In_Common" = c("Sports", "Movies", "Computers", "Computers", "Video Games", "Sports", "Movies", "Computers", "Sports", "Sports", "Video Games")
)

common_data = purrr::imap_dfc(dplyr::select(Data_I_Have, -Node_A, -Node_B), function(item, id){
  paste(id, ": ", item)
})

common_strings = purrr::map_chr(seq(1, nrow(common_data)), function(in_row){
  paste(common_data[in_row, ], collapse = "<br>")
})

edge_data = dplyr::transmute(Data_I_Have, from = Node_A, to = Node_B, title = common_strings)

#data about individualsli

additional_data_about_people <- data.frame(

  "Person" = c("John", "Peter", "Tim", "Kevin", "Adam", "Xacier", "Claude", "Henry"),
  "Job" = c("Teacher", "Lawyer", "Accountant", "Engineer", "Teacher", "Lawyer", "Engineer", "Lawyer"),
  "Age" = c("50", "51", "61", "56", "65", "65", "54", "50"),
  "Favorite_Food" = c("pizza", "pizza", "tacos", "pizza", "ice cream", "sushi", "sushi", "pizza")
)

library(igraph)
library(dplyr)
library(visNetwork)

graph_file <- data.frame(Data_I_Have$Node_A, Data_I_Have$Node_B)

colnames(graph_file) <- c("Data_I_Have$Node_A", "Data_I_Have$Node_B")

graph <- graph.data.frame(graph_file, directed=F)
graph <- simplify(graph)

plot(graph)

add_field = purrr::imap_dfc(additional_data_about_people, function(item, id){
  paste0(id, ": ", item)
})
additional_strings = purrr::map_chr(seq(1, nrow(add_field)), function(in_row){
  paste(add_field[in_row, ], collapse = "<br>")
})
additional_df = data.frame(id = additional_data_about_people$Person, title = additional_strings)
additional_df2 = dplyr::left_join(data.frame(id = V(graph)$name), additional_df, by = "id")

nodes <- data.frame(id = V(graph)$name, title = additional_df2$title)
nodes <- nodes[order(nodes$id, decreasing = F),]
edges <- get.data.frame(graph, what="edges")[1:2]

edges2 = dplyr::left_join(edges, edge_data, by = c("from", "to"))

visNetwork(nodes, edges2)

Then on hover, I see the additional information about each node and edge.

Two things to be mindful of here:

visNetwork displays in html, so you have to use html codes for special characters, like the <br> for a return, and : for the ":".
Everything can have a "title" attribute that gets displayed as a tooltip, so you can add it to the edges as well.

Notice I create the data.frame where I have the attribute added to make it look field like with the ":", and then paste them all together to make the actual title to display.

Hopefully the above makes sense.

Also, fix your code, you had a space in front of one variable name that was going to do weird things to it.

As far as displaying the names when you click on them, that's beyond me at the moment.

Fixing Cluttered Titles on Graphs

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

You have working knowledge of Rmarkdown.
There are 25 of these network diagrams.
There are no other HTML widgets in the script.

If these are not true, let me know.

The YAML

The Output Options

---
title: "Just for antonoyaro8"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
---

The Styles

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>

Libraries

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

```

R Code to Create the Diagrams

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

```

The Multi-Select Box

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

```

The Network Diagrams

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>

Final Chunk: Javascript

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); 
}

```

Developer Tools Console

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.

Dashboard Colors

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.

Converting Igraph to VisNetwork

You have to do a bit of manipulation to make this work because this uses base R plotting.

Essentially, these are two different igraph objects lying on top of each other. This is the only way I could think of to have two different 'cex' sizes. It may require a bit of finesse, depending on where you go from here.

library(tidyverse)
library(igraph)
library(gridGraphics)    # <--- I'm new!
library(grid)            # <--- I'm new!

#----------- from question -----------
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) 
(edge_fac <- forcats::as_factor(get.edgelist(graph)[,1]))
n2 <- as.integer(factor(data$name,levels = levels(edge_fac)))
V(graph)$color <- ifelse(data$d == relations$from[1], 
                         "red", "orange")

This is where the changes begin.

#---------- prepare the first plot -----------
# make label text larger
V(graph)$label.cex = 1.5
# V(graph)$label <- paste0(data$name,"\n",n2)
V(graph)$label <- paste0(n2) # just the number instead

#---------- prepare to collect grob ----------
# collect base plot grob
grabber <- function(){
  grid.echo()
  grid.grab()
}

# create a copy for the top layer
graph2 <- graph

#-------------- plot and grab ----------------
# without arrow sizes
plot(graph, layout=layout.circle, main = "my_graph")

# grab the grob
g1 = grabber()

Now for the second graph; the top layer

#----------- create the top layer -------------
# with the copy, make the vertices transparent
V(graph2)$color <- "transparent"

# reset the font size
V(graph2)$label.cex = 1 

# shift the labels below (while keeping the plot design the same)
V(graph2)$label <- paste0("\n\n\n\n", data$name)

# show me
plot(graph2, layout=layout.circle,
     main = "my_graph", 
     edge.color = "transparent") # invisible arrows/ only 1 layer of arrows

# grab the grob
g2 = grabber()

Layer them!

#-------------- redraw the plots -------------
# make the plot background transparent on the top layer
g2[["children"]][["graphics-background"]][["gp"]][["fill"]] <- "transparent"

# draw it!
grid.draw(g1)
grid.draw(g2)

Sample Image

You might find it interesting that the graphs going into the grob look different than what comes out of them...grid essentially adjusts them. I thought that was kind of awesome.

How to display text out of color figure and easy to read in visNetwork?

ledges <- data.frame(color = c("lightblue", "red"), 
 label = c("reverse", "depends"), arrows =c("to", "from"), 
 font.align = "top") 
 
visNetwork(nodes, edges) %>%
  visGroups(groupname = "A", color = "red") %>%
  visGroups(groupname = "B", color = "lightblue") %>%
  visLegend(addNodes = lnodes, addEdges = ledges, useGroups = FALSE)

font.align = "top" must do the job

Directly Adding Titles and Labels to Visnetwork