1
globalVariables(c("from", "to", "."))
2

3
.build_data <- function(data, ...){
4 1
  data %>% 
5 1
    dplyr::select(...)
6
}
7

8
.as_list <- function(data){
9 1
  apply(data, 1, as.list) %>%  # json formatted list
10 1
    unname() # in case of row.names
11
}
12

13
.check_ids <- function(data){
14 1
  if(!"id" %in% names(data))
15 0
    stop("missing ids", call. = FALSE)
16
  else 
17 1
    data$id <- as.character(data$id)
18 1
  return(data)
19
}
20

21
.check_x_y <- function(data){
22 1
  if(!"x" %in% names(data))
23 1
    data$x <- runif(nrow(data), 1, 20)
24
  
25 1
  if(!"y" %in% names(data))
26 1
    data$y <- runif(nrow(data), 1, 20)
27 1
  return(data)
28
}
29

30
.add_image <- function(sg, data) {
31 1
  .rename <- function(x){
32 1
    x[x == ""] <- "image"
33 1
    x
34
  }
35
  
36 1
  imgs <- apply(data, 1, function(x) list(as.list(x))) %>% 
37 1
    purrr::set_names(rep("image", length(.)))
38
  
39 1
  imgs <- purrr::map2(sg$x$data$nodes, imgs, append)
40
  
41 1
  n <- purrr::map(imgs, names) %>% 
42 1
    purrr::map(.rename)
43
  
44 1
  imgs <- purrr::map2(imgs, n, purrr::set_names)
45
  
46 1
  sg$x$data$nodes <- imgs
47 1
	sg
48
}
49

50
.data_2_df <- function(x){
51 1
  if(is.null(x))
52 0
    stop("must have both edges and nodes to compute layout")
53
  
54 1
  do.call("rbind.data.frame", lapply(x, as.data.frame, stringsAsFactors = FALSE))
55
}
56

57
.re_order <- function(x){
58 1
  n <- names(x)
59
  
60 1
  cols <- c("source", "target")
61
  
62 1
  first <- n[n %in% cols]
63 1
  last <- n[!n %in% cols]
64
  
65 1
  x[, c(first, last)]
66
}
67

68
.re_order_nodes <- function(x){
69 1
  n <- names(x)
70
  
71 1
  id <- c("id")
72
  
73 1
  first <- n[n %in% id]
74 1
  last <- n[!n %in% id]
75
  
76 1
  x[, c(first, last)]
77
}
78

79
.rm_x_y <- function(x){
80 1
  x$x <- NULL
81 1
  x$y <- NULL
82 1
  return(x)
83
}
84

85
.valid_events <- function(){
86 1
  c("force_start", "force_stop", "noverlap", 
87 1
    "drag_nodes", "relative_size", "add_nodes", 
88 1
    "add_edges", "drop_nodes", "drop_edges", 
89 1
    "animate", "export_svg", "export_img",
90 1
    "add_nodes_edges", "progress", "read_exec")
91
}
92

93

94
.test_sg <- function(sg){
95 1
  if(!inherits(sg, "sigmajs"))
96 1
    stop("sg must be of class sigmajs", call. = FALSE)
97
}
98

99
.test_proxy <- function(p){
100 0
  if (!inherits(p, "sigmajsProxy"))
101 0
    stop("proxy must be of class sigmajsProxy", call. = FALSE)
102
}
103

104
.get_graph <- function(){
105 1
  graph <- tryCatch(
106 1
    get("igraph", envir = storage_env),
107 1
    error = function(e) NULL
108
  )
109
}
110

111
.build_igraph <- function(edges, directed = FALSE, nodes, save = TRUE){
112
  
113 1
  g <- .get_graph()
114
  
115 1
  if(is.null(g)){
116 1
    g <- igraph::graph_from_data_frame(edges, directed, nodes)
117
    
118 1
    if(isTRUE(save))
119 1
      assign("igraph", g, envir = storage_env)
120
  } 
121
  
122 1
  return(g)
123
  
124
}
125

126
.make_rand_id <- function(){
127 1
  paste0(sample(LETTERS, 5), 1:9, collapse = "")
128
}
129

130
.grp <- function(x, y){
131 0
  list(
132 0
    nodes = x,
133 0
    edges = y
134
  )
135
}

Read our documentation on viewing source code .

Loading