knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(conceptmapper)
# devtools::load_all()
edges <- tibble::tibble(
  from = sample(letters, replace = T),
  to = sample(letters, replace = T),
  label = sample(LETTERS),
  length = 100,
  dashes = FALSE,
  width = 4,
  arrows = "to",
  smooth = TRUE,
  shadow = FALSE,
  title = "Edge 1"
)

edges

nodes <- tibble::tibble(
  id = letters,
  group = "A group")

# visNetwork::visNetwork(nodes, edges, width = "100%")

# load the package
library(igraph)

# your code
df <- data.frame(a = c(0,1,2,3,4),b = c(3,4,5,6,7))
nod <- data.frame(node = c(0:7),wt = c(1:8))
pg <- graph_from_data_frame(d = df, vertices = nod,directed = F)

# plot function with edge.label added
plot(pg, edge.label = nod$wt)
edges <- data.frame(from = sample(1:10,8), to = sample(1:10, 8),

                    # add labels on edges                  
                    label = paste("Edge", 1:8),

                    # length
                    length = c(100,500),

                    # width
                    width = c(4,1),

                    # arrows
                    arrows = c("to", "from", "middle", "middle;to"),

                    # dashes
                    dashes = c(TRUE, FALSE),

                    # tooltip (html or character)
                    title = paste("Edge", 1:8),

                    # smooth
                    smooth = c(FALSE, TRUE),

                    # shadow
                    shadow = c(FALSE, TRUE, FALSE, TRUE)) 

# head(edges)
#  from to  label length    arrows dashes  title smooth shadow
#    10  7 Edge 1    100        to   TRUE Edge 1  FALSE  FALSE
#     4 10 Edge 2    500      from  FALSE Edge 2   TRUE   TRUE

nodes <- data.frame(id = 1:10, group = c("A", "B"))

visNetwork::visNetwork(nodes, edges, height = "500px", width = "100%")
find_redundant_edges <- function(data) {
  edges_to_merge <- 
    data %>%
    dplyr::group_by(from, label) %>%
    dplyr::summarize(count = dplyr::n(), .groups = "drop") %>%
    dplyr::filter(count > 1) %>% 
    dplyr::left_join(data) %>% 
    dplyr::mutate(label = stringr::str_c(to, label))

  untouched <- dplyr::anti_join(data, edges_to_merge)

  new_links1 <- edges_to_merge %>%
    dplyr::select(-count) %>% 
    dplyr::mutate(to = label)

  new_links2 <- edges_to_merge %>%
    dplyr::select(-c(from, count)) %>% 
    dplyr::rename(from = label)

  new_links <- dplyr::bind_rows(new_links1, new_links2)

  dplyr::bind_rows(untouched, new_links) %>% dplyr::distinct()
}

# data <-  readr::read_csv("~/Downloads/2022-02-03_concept-map.csv")

plot_cleaned_visnetwork <- function(data){

  edges <- find_redundant_edges(data) %>%
    dplyr::distinct() %>% 
    dplyr::mutate(arrows = ifelse(to %in% label, NA, "to"))

  nodes <- tibble::tibble(id = unique(c(edges$from, edges$to))) %>% 
    dplyr::mutate(label = ifelse(id %in% edges$label, NA, id),
                  shape = ifelse(id %in% edges$label, "text", "ellipse"))

  visNetwork::visNetwork(nodes = nodes, edges = edges, physics = TRUE)
}


JamesHWade/conceptmapper documentation built on Feb. 13, 2022, 3:15 a.m.