1
#' Add node or edge
2
#'
3
#' Proxies to dynamically add a node or an edge to an already existing graph.
4
#' 
5
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
6
#' @param data A \code{data.frame} of _one_ node or edge.
7
#' @param ... any column.
8
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect, if you are running force the algorithm is killed.
9
#' 
10
#' @examples
11
#' \dontrun{
12
#' demo("add-node", package = "sigmajs")
13
#' demo("add-edge", package = "sigmajs")
14
#' demo("add-node-edge", package = "sigmajs")
15
#' }
16
#'
17
#' @note Have the parameters from your initial graph match that of the node you add, i.e.: if you pass \code{size} in your initial chart,
18
#' make sure you also have it in your proxy.
19
#' 
20
#' @return The \code{proxy} object.
21
#' 
22
#' @rdname add_p
23
#' @export
24
sg_add_node_p <- function(proxy, data, ..., refresh = TRUE) {
25

26 0
  if (missing(proxy))
27 0
    stop("must pass proxy", call. = FALSE)
28
  
29 0
  .test_proxy(proxy)
30

31
	# build data
32 0
	nodes <- .build_data(data, ...) %>%
33 0
		.check_ids() %>%
34 0
		.check_x_y() %>%
35 0
		.as_list()
36

37 0
	message <- list(id = proxy$id, data = nodes, refresh = refresh) # create message
38

39 0
	proxy$session$sendCustomMessage("sg_add_node_p", message)
40

41 0
	return(proxy)
42
}
43

44
#' @rdname add_p
45
#' @export
46
sg_add_edge_p <- function(proxy, data, ..., refresh = TRUE) {
47

48 0
  if (missing(proxy))
49 0
    stop("must pass proxy", call. = FALSE)
50
  
51 0
  .test_proxy(proxy)
52

53
	# build data
54 0
	edges <- .build_data(data, ...) %>%
55 0
		.check_ids() %>%
56 0
		.check_x_y() %>%
57 0
		.as_list()
58

59 0
	message <- list(id = proxy$id, data = edges, refresh = refresh) # create message
60

61 0
	proxy$session$sendCustomMessage("sg_add_edge_p", message) # send message
62

63 0
	return(proxy)
64
}
65

66
#' Add nodes or edges
67
#' 
68
#' Proxies to dynamically add *multiple* nodes or edges to an already existing graph.
69
#' 
70
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
71
#' @param data A \code{data.frame} of nodes or edges.
72
#' @param ... any column.
73
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect, if you are running force the algorithm is killed and restarted at every iteration..
74
#' @param rate Refresh rate, either \code{once}, the graph is refreshed after data.frame of nodes is added or at each \code{iteration} (row-wise). Only applies if \code{refresh} is set to \code{TRUE}.
75
#' 
76
#' @examples
77
#' \dontrun{
78
#' demo("add-nodes", package = "sigmajs")
79
#' demo("add-edges", package = "sigmajs")
80
#' }
81
#'
82
#' @note Have the parameters from your initial graph match that of the node you add, i.e.: if you pass \code{size} in your initial chart,
83
#' make sure you also have it in your proxy.
84
#' 
85
#' @return The \code{proxy} object.
86
#' 
87
#' @rdname adds_p
88
#' @export
89
sg_add_nodes_p <- function(proxy, data, ..., refresh = TRUE, rate = "once") {
90

91 0
  if (missing(proxy))
92 0
    stop("must pass proxy", call. = FALSE)
93
  
94 0
  .test_proxy(proxy)
95

96 0
	if (missing(data))
97 0
		stop("must pass data", call. = FALSE)
98

99 0
	if (!rate %in% c("once", "iteration"))
100 0
		stop("incorrect rate", call. = FALSE)
101

102
	# build data
103 0
	nodes <- .build_data(data, ...) %>%
104 0
		.check_ids() %>%
105 0
		.check_x_y() %>%
106 0
		.as_list()
107

108 0
	message <- list(id = proxy$id, data = nodes, refresh = refresh, rate = rate) # create message
109

110 0
	proxy$session$sendCustomMessage("sg_add_nodes_p", message)
111

112 0
	return(proxy)
113
}
114

115
#' @rdname adds_p
116
#' @export
117
sg_add_edges_p <- function(proxy, data, ..., refresh = TRUE, rate = "once") {
118

119 0
  if (missing(proxy))
120 0
    stop("must pass proxy", call. = FALSE)
121
  
122 0
  .test_proxy(proxy)
123

124 0
	if (missing(data))
125 0
		stop("must pass data", call. = FALSE)
126

127 0
	if (!rate %in% c("once", "iteration"))
128 0
		stop("incorrect rate", call. = FALSE)
129

130
	# build data
131 0
	nodes <- .build_data(data, ...) %>%
132 0
		.check_ids() %>%
133 0
		.check_x_y() %>%
134 0
		.as_list()
135

136 0
	message <- list(id = proxy$id, data = nodes, refresh = refresh, rate = rate) # create message
137

138 0
	proxy$session$sendCustomMessage("sg_add_edges_p", message)
139

140 0
	return(proxy)
141
}
142

143
#' Remove node or edge
144
#'
145
#' Proxies to dynamically remove a node or an edge to an already existing graph.
146
#'
147
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
148
#' @param id Id of edge or node to delete.
149
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect, if you are running force the algorithm is killed and restarted.
150
#'
151
#' @return The \code{proxy} object.
152
#'
153
#' @rdname drop_p
154
#' @export
155
sg_drop_node_p <- function(proxy, id, refresh = TRUE) {
156

157 0
  if (missing(proxy))
158 0
    stop("must pass proxy", call. = FALSE)
159
  
160 0
  .test_proxy(proxy)
161

162 0
	if (missing(id))
163 0
		stop("must pass id")
164

165 0
	message <- list(id = proxy$id, data = id, refresh = refresh)
166

167 0
	proxy$session$sendCustomMessage("sg_drop_node_p", message)
168

169 0
	return(proxy)
170
}
171

172
#' @rdname drop_p
173
#' @export
174
sg_drop_edge_p <- function(proxy, id, refresh = TRUE) {
175

176 0
  if (missing(proxy))
177 0
    stop("must pass proxy", call. = FALSE)
178
  
179 0
  .test_proxy(proxy)
180

181 0
	if (missing(id))
182 0
		stop("must pass id")
183

184 0
	message <- list(id = proxy$id, data = id, refresh = refresh)
185

186 0
	proxy$session$sendCustomMessage("sg_drop_edge_p", message)
187

188 0
	return(proxy)
189
}
190

191
#' Clear or kill the graph
192
#'
193
#' Clear all nodes and edges from the graph or kills the graph.
194
#'
195
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
196
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect, if you are running force the algorithm is killed and restarted.
197
#' 
198
#' @return The \code{proxy} object.
199
#'
200
#' @rdname clear-kill
201
#' @export
202
sg_clear_p <- function(proxy, refresh = TRUE) {
203

204 0
  if (missing(proxy))
205 0
    stop("must pass proxy", call. = FALSE)
206
  
207 0
  .test_proxy(proxy)
208

209 0
	message <- list(id = proxy$id, refresh = refresh)
210

211 0
	proxy$session$sendCustomMessage("sg_clear_p", message)
212

213 0
	return(proxy)
214
}
215

216
#' @rdname clear-kill
217
#' @export
218
sg_kill_p <- function(proxy, refresh = TRUE) {
219

220 0
  if (missing(proxy))
221 0
    stop("must pass proxy", call. = FALSE)
222
  
223 0
  .test_proxy(proxy)
224

225 0
	message <- list(id = proxy$id, refresh = refresh)
226

227 0
	proxy$session$sendCustomMessage("sg_kill_p", message)
228

229 0
	return(proxy)
230
}
231

232
#' Add nodes or edges with a delay
233
#' 
234
#' Proxies to dynamically add multiple nodes or edges to an already existing graph with a *delay* between each addition.
235
#' 
236
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
237
#' @param data A \code{data.frame} of _one_ node or edge.
238
#' @param ... any column.
239
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect, if you are running force the algorithm is killed and restarted at every iteration.
240
#' @param delay Column name containing delay in milliseconds.
241
#' @param cumsum Whether to compute the cumulative sum of the delay.
242
#' 
243
#' @details The delay helps for build dynamic visualisations where nodes and edges do not appear all at the same time.
244
#' How the delay works depends on the \code{cumsum} parameter. if \code{TRUE} the function computes the cumulative sum
245
#' of the delay to effectively add each row one after the other: delay is thus applied at each row (number of seconds to wait
246
#' before the row is added *since the previous row*). If \code{FALSE} this is the number of milliseconds to wait before the node or
247
#' edge is added to the visualisation; \code{delay} is used as passed to the function.
248
#' 
249
#' @return The \code{proxy} object.
250
#'
251
#' @note Have the parameters from your initial graph match that of the node you add, i.e.: if you pass \code{size} in your initial chart,
252
#' make sure you also have it in your proxy.
253
#' 
254
#' @rdname adds_delay_p
255
#' @export
256
sg_add_nodes_delay_p <- function(proxy, data, delay, ..., refresh = TRUE, cumsum = TRUE) {
257

258 0
  if (missing(proxy))
259 0
    stop("must pass proxy", call. = FALSE)
260
  
261 0
  .test_proxy(proxy)
262

263 0
	if (missing(data) || missing(delay))
264 0
		stop("must pass data and delay", call. = FALSE)
265

266 0
	delay_col <- eval(substitute(delay), data) # subset delay
267 0
	if (isTRUE(cumsum))
268 0
		delay_col <- cumsum(delay_col) # cumul for setTimeout
269 0
	delay_table <- dplyr::tibble(sigmajsdelay = delay_col) # build delay tibble
270

271
	# build data
272 0
	nodes <- .build_data(data, ...) %>%
273 0
		dplyr::bind_cols(delay_table) %>% # bind delay
274 0
		.check_ids() %>%
275 0
		.check_x_y() %>%
276 0
		.as_list()
277

278 0
	message <- list(id = proxy$id, data = nodes, refresh = refresh) # create message
279

280 0
	proxy$session$sendCustomMessage("sg_add_nodes_delay_p", message)
281

282 0
	return(proxy)
283
}
284

285
#' @rdname adds_delay_p
286
#' @export
287
sg_add_edges_delay_p <- function(proxy, data, delay, ..., refresh = TRUE, cumsum = TRUE) {
288

289 0
  if (missing(proxy))
290 0
    stop("must pass proxy", call. = FALSE)
291
  
292 0
  .test_proxy(proxy)
293

294 0
	if (missing(data) || missing(delay))
295 0
		stop("must pass data and delay", call. = FALSE)
296

297 0
	delay_col <- eval(substitute(delay), data) # subset delay
298 0
	if (isTRUE(cumsum))
299 0
		delay_col <- cumsum(delay_col) # cumul for setTimeout
300 0
	delay_table <- dplyr::tibble(sigmajsdelay = delay_col) # build delay tibble
301

302
	# build data
303 0
	nodes <- .build_data(data, ...) %>%
304 0
		dplyr::bind_cols(delay_table) %>% # bind delay
305 0
	  .check_ids() %>%
306 0
		.check_x_y() %>%
307 0
		.as_list()
308

309 0
	message <- list(id = proxy$id, data = nodes, refresh = refresh) # create message
310

311 0
	proxy$session$sendCustomMessage("sg_add_edges_delay_p", message)
312

313 0
	return(proxy)
314
}
315

316
#' Drop nodes or edges
317
#' 
318
#' Proxies to dynamically drop *multiple* nodes or edges from an already existing graph.
319
#' 
320
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
321
#' @param data A \code{data.frame} of nodes or edges.
322
#' @param ids Column containing ids to drop from the graph.
323
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect.
324
#' @param rate Refresh rate, either \code{once}, the graph is refreshed after data.frame of nodes is added or at each \code{iteration} (row-wise). Only applies if \code{refresh} is set to \code{TRUE}.
325
#'
326
#' @return The \code{proxy} object.
327
#' 
328
#' @note Have the parameters from your initial graph match that of the node you add, i.e.: if you pass \code{size} in your initial chart,
329
#' make sure you also have it in your proxy.
330
#' 
331
#' @rdname drops_p
332
#' @export
333
sg_drop_nodes_p <- function(proxy, data, ids, refresh = TRUE, rate = "once") {
334

335 0
  if (missing(proxy))
336 0
    stop("must pass proxy", call. = FALSE)
337
  
338 0
  .test_proxy(proxy)
339

340 0
	if (missing(data))
341 0
		stop("must pass data", call. = FALSE)
342

343 0
	if (!rate %in% c("once", "iteration"))
344 0
		stop("incorrect rate", call. = FALSE)
345

346 0
	ids <- eval(substitute(ids), data) # subset ids
347

348 0
	message <- list(id = proxy$id, data = ids, refresh = refresh, rate = rate) # create message
349

350 0
	proxy$session$sendCustomMessage("sg_drop_nodes_p", message)
351

352 0
	return(proxy)
353
}
354

355
#' @rdname drops_p
356
#' @export
357
sg_drop_edges_p <- function(proxy, data, ids, refresh = TRUE, rate = "once") {
358

359 0
  if (missing(proxy))
360 0
    stop("must pass proxy", call. = FALSE)
361
  
362 0
  .test_proxy(proxy)
363

364 0
	if (missing(data))
365 0
		stop("must pass data", call. = FALSE)
366

367 0
	if (!rate %in% c("once", "iteration"))
368 0
		stop("incorrect rate", call. = FALSE)
369

370 0
	ids <- eval(substitute(ids), data) # subset ids
371

372 0
	message <- list(id = proxy$id, data = ids, refresh = refresh, rate = rate) # create message
373

374 0
	proxy$session$sendCustomMessage("sg_drop_edges_p", message)
375

376 0
	return(proxy)
377
}
378

379
#' Drop nodes or edges with a delay
380
#' 
381
#' Proxies to dynamically drop multiple nodes or edges to an already existing graph with a *delay* between each removal.
382
#' 
383
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
384
#' @param data A \code{data.frame} of _one_ node or edge.
385
#' @param ids Ids of elements to drop.
386
#' @param refresh Whether to refresh the graph after node is dropped, required to take effect, if you are running force the algorithm is killed and restarted at every iteration.
387
#' @param delay Column name containing delay in milliseconds.
388
#' @param cumsum Whether to compute the cumulative sum of the delay.
389
#' 
390
#' @details The delay helps for build dynamic visualisations where nodes and edges do not disappear all at the same time.
391
#' How the delay works depends on the \code{cumsum} parameter. if \code{TRUE} the function computes the cumulative sum
392
#' of the delay to effectively drop each row one after the other: delay is thus applied at each row (number of seconds to wait
393
#' before the row is dropped *since the previous row*). If \code{FALSE} this is the number of milliseconds to wait before the node or
394
#' edge is added to the visualisation; \code{delay} is used as passed to the function.
395
#'
396
#' @return The \code{proxy} object.
397
#'
398
#' @note Have the parameters from your initial graph match that of the node you add, i.e.: if you pass \code{size} in your initial chart,
399
#' make sure you also have it in your proxy.
400
#' 
401
#' @rdname drop_delay_p
402
#' @export
403
sg_drop_nodes_delay_p <- function(proxy, data, ids, delay, refresh = TRUE, cumsum = TRUE) {
404
  
405 0
  if (missing(proxy))
406 0
    stop("must pass proxy", call. = FALSE)
407
  
408 0
  .test_proxy(proxy)
409
  
410 0
  if (missing(data))
411 0
    stop("must pass data", call. = FALSE)
412
  
413 0
  delay_col <- eval(substitute(delay), data) # subset delay
414 0
  if (isTRUE(cumsum))
415 0
    delay_col <- cumsum(delay_col) # cumul for setTimeout
416
  
417 0
  ids <- eval(substitute(ids), data) # subset ids
418
  
419 0
  to_drop <- dplyr::tibble(
420 0
    id = ids,
421 0
    sigmajsdelay = delay_col
422
  )
423
  
424 0
  to_drop <- dplyr::tibble(
425 0
    id = ids,
426 0
    sigmajsdelay = delay_col
427 0
  ) %>% # bind delay
428 0
    .as_list()
429
  
430 0
  message <- list(id = proxy$id, data = to_drop, refresh = refresh) # create message
431
  
432 0
  proxy$session$sendCustomMessage("sg_drop_nodes_delay_p", message)
433
  
434 0
  return(proxy)
435
}
436

437
#' @rdname drop_delay_p
438
#' @export
439
sg_drop_edges_delay_p <- function(proxy, data, ids, delay, refresh = TRUE, cumsum = TRUE) {
440
  
441 0
  if (missing(proxy))
442 0
    stop("must pass proxy", call. = FALSE)
443
  
444 0
  .test_proxy(proxy)
445
  
446 0
  if (missing(data))
447 0
    stop("must pass data", call. = FALSE)
448
  
449 0
  delay_col <- eval(substitute(delay), data) # subset delay
450 0
  if (isTRUE(cumsum))
451 0
    delay_col <- cumsum(delay_col) # cumul for setTimeout
452
  
453 0
  ids <- eval(substitute(ids), data) # subset ids
454
  
455 0
  to_drop <- dplyr::tibble(
456 0
    id = ids,
457 0
    sigmajsdelay = delay_col
458
  )
459
  
460 0
  to_drop <- dplyr::tibble(
461 0
    id = ids,
462 0
    sigmajsdelay = delay_col
463 0
  ) %>% # bind delay
464 0
    .as_list()
465
  
466 0
  message <- list(id = proxy$id, data = to_drop, refresh = refresh) # create message
467
  
468 0
  proxy$session$sendCustomMessage("sg_drop_edges_delay_p", message)
469
  
470 0
  return(proxy)
471
}
472

473
#' Read
474
#'
475
#' Read nodes and edges to add to the graph. Other proxy methods to add data to a graph have to add nodes and edges one by one, 
476
#' thereby draining the browser, this method will add multiple nodes and edges more efficiently.
477
#'
478
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
479
#' @param data A \code{data.frame} of _one_ node or edge.
480
#' @param ... any column.
481
#'
482
#' @section Functions:
483
#' \itemize{
484
#'   \item{\code{sg_read_nodes_p} read nodes.}
485
#'   \item{\code{sg_read_edges_p} read edges.}
486
#'   \item{\code{sg_read_exec_p} send read nodes and edges to JavaScript front end.}
487
#' }
488
#' 
489
#' @examples
490
#' library(shiny)
491
#' 
492
#' ui <- fluidPage(
493
#' 	actionButton("add", "add nodes & edges"),
494
#' 	sigmajsOutput("sg")
495
#' )
496
#' 
497
#' server <- function(input, output, session){
498
#' 
499
#' 	nodes <- sg_make_nodes()
500
#' 	edges <- sg_make_edges(nodes)
501
#' 
502
#' 	output$sg <- renderSigmajs({
503
#' 		sigmajs() %>% 
504
#' 			sg_nodes(nodes, id, label, color, size) %>% 
505
#' 			sg_edges(edges, id, source, target) %>% 
506
#' 			sg_layout()
507
#' 	})
508
#' 
509
#' 	i <- 10
510
#' 
511
#' 	observeEvent(input$add, {
512
#' 		new_nodes <- sg_make_nodes()
513
#' 		new_nodes$id <- as.character(as.numeric(new_nodes$id) + i)
514
#' 		i <<- i + 10
515
#' 		ids <- 1:(i)
516
#' 		new_edges <- data.frame(
517
#' 			id = as.character((i * 2 + 15):(i * 2 + 29)),
518
#' 			source = as.character(sample(ids, 15)),
519
#' 			target = as.character(sample(ids, 15))
520
#' 		)
521
#' 		
522
#' 		sigmajsProxy("sg") %>% 
523
#' 			sg_force_kill_p() %>% 
524
#' 			sg_read_nodes_p(new_nodes, id, label, color, size) %>% 
525
#' 			sg_read_edges_p(new_edges, id, source, target) %>% 
526
#' 			sg_read_exec_p() %>% 
527
#' 			sg_force_start_p() %>% 
528
#' 			sg_refresh_p()
529
#' 	})
530
#' 
531
#' }
532
#' 
533
#' if(interactive()) shinyApp(ui, server)
534
#' 
535
#' @return The \code{proxy} object.
536
#' 
537
#' @name read
538
#' @export
539
sg_read_nodes_p <- function(proxy, data, ...){
540
  
541 0
  .test_proxy(proxy)
542

543
	# build data
544 0
	nodes <- data %>% 
545 0
		.build_data(...) %>%
546 0
		.check_ids() %>%
547 0
		.check_x_y() %>%
548 0
		.as_list()
549

550 0
	proxy$message$data$nodes <- nodes
551

552 0
	return(proxy)
553
}
554

555
#' @rdname read
556
#' @export
557
sg_read_edges_p <- function(proxy, data, ...){
558 0
  .test_proxy(proxy)
559

560
	# build data
561 0
	edges <- data %>% 
562 0
		.build_data(...) %>%
563 0
		.check_ids() %>%
564 0
		.check_x_y() %>%
565 0
		.as_list()
566

567 0
	proxy$message$data$edges <- edges
568

569 0
	return(proxy)
570
}
571

572
#' @rdname read
573
#' @export
574
sg_read_exec_p <- function(proxy){
575 0
	.test_proxy(proxy)
576

577 0
	proxy$message$id <- proxy$id
578

579 0
	if(is.null(proxy$message$data$edges))
580 0
		proxy$message$data$edges <- list()
581

582 0
	if(is.null(proxy$message$data$nodes))
583 0
		proxy$message$data$nodes <- list()
584

585 0
	proxy$session$sendCustomMessage("sg_read_exec_p", proxy$message)
586 0
	return(proxy)
587
}
588

589
#' Batch read
590
#' 
591
#' Read nodes and edges by batch with a delay.
592
#'
593
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
594
#' @param data A \code{data.frame} of nodes or edges to add to the graph.
595
#' @param ... any column.
596
#' @param delay Column name of containing batch identifier.
597
#' @param refresh Whether to refresh the graph after each batch (\code{delay}) has been added to the graph.
598
#' Note that this will also automatically restart any running force layout.
599
#'
600
#' @details Add nodes and edges with \code{sg_read_delay_nodes_p} and \code{sg_read_delay_edges_p} then execute (send to JavaScript end) with \code{sg_read_delay_exec_p}.
601
#'
602
#' @examples
603
#' library(shiny)
604
#' 
605
#' ui <- fluidPage(
606
#' 	actionButton("add", "add nodes & edges"),
607
#' 	sigmajsOutput("sg")
608
#' )
609
#' 
610
#' server <- function(input, output, session){
611
#' 
612
#' 	output$sg <- renderSigmajs({
613
#' 		sigmajs()
614
#' 	})
615
#' 
616
#' 	observeEvent(input$add, {
617
#' 		nodes <- sg_make_nodes(50)
618
#' 		nodes$batch <- c(
619
#' 			rep(1000, 25),
620
#' 			rep(3000, 25)
621
#' 		)
622
#' 
623
#' 		edges <- data.frame(
624
#' 			id = 1:80,
625
#' 			source = c(
626
#' 				sample(1:25, 40, replace = TRUE),
627
#' 				sample(1:50, 40, replace = TRUE)
628
#' 			),
629
#' 			target = c(
630
#' 				sample(1:25, 40, replace = TRUE),
631
#' 				sample(1:50, 40, replace = TRUE)
632
#' 			),
633
#' 			batch = c(
634
#' 				rep(1000, 40),
635
#' 				rep(3000, 40)
636
#' 			)
637
#' 		) %>% 
638
#' 		dplyr::mutate_all(as.character)
639
#' 
640
#' 		sigmajsProxy("sg") %>% 
641
#'      sg_force_start_p() %>% 
642
#' 			sg_read_delay_nodes_p(nodes, id, color, label, size, delay = batch) %>% 
643
#' 			sg_read_delay_edges_p(edges, id, source, target, delay = batch) %>% 
644
#' 			sg_read_delay_exec_p()  %>% 
645
#' 			sg_force_stop_p()
646
#' 	})
647
#' 
648
#' }
649
#' 
650
#' if(interactive()) shinyApp(ui, server)
651
#' 
652
#' @return The \code{proxy} object.
653
#' 
654
#' @name read-batch
655
#' @export
656
sg_read_delay_nodes_p <- function(proxy, data, ..., delay){
657
  
658 0
  .test_proxy(proxy)
659

660 0
	if(missing(delay) || missing(data))
661 0
		stop("missing data or delay", call. = FALSE)
662

663 0
	delay <- deparse(substitute(delay))
664

665
	# build data
666 0
	nodes <- data %>% 
667 0
		.build_data(..., delay = delay) %>%
668 0
		.check_ids() %>%
669 0
		.check_x_y() %>%
670 0
		split(.[["delay"]]) %>% 
671 0
		purrr::map(.as_list)
672

673 0
	proxy$message$data$nodes <- nodes
674

675 0
	return(proxy)
676
}
677

678
#' @rdname read-batch
679
#' @export
680
sg_read_delay_edges_p <- function(proxy, data, ..., delay){
681 0
  .test_proxy(proxy)
682

683 0
	if(missing(delay) || missing(data))
684 0
		stop("missing data or delay", call. = FALSE)
685

686 0
	delay <- deparse(substitute(delay))
687

688
	# build data
689 0
	edges <- data %>% 
690 0
		.build_data(..., delay = delay) %>%
691 0
		.check_ids() %>%
692 0
		.check_x_y() %>%
693 0
		split(.[["delay"]]) %>% 
694 0
		purrr::map(.as_list)
695

696 0
	proxy$message$data$edges <- edges
697

698 0
	return(proxy)
699
}
700

701
#' @rdname read-batch
702
#' @export
703
sg_read_delay_exec_p <- function(proxy, refresh = TRUE){
704 0
	.test_proxy(proxy)
705

706 0
	proxy$message$id <- proxy$id
707

708 0
	if(is.null(proxy$message$data$edges))
709 0
		proxy$message$data$edges <- list()
710

711 0
	if(is.null(proxy$message$data$nodes))
712 0
		proxy$message$data$nodes <- list()
713

714 0
	proxy$message$data <- purrr::map2(proxy$message$data$nodes, proxy$message$data$edges, .grp) %>% 
715 0
		unname()
716

717 0
	proxy$message$refresh <- refresh
718

719 0
	proxy$session$sendCustomMessage("sg_read_bacth_exec_p", proxy$message)
720 0
	return(proxy)
721
}
722

723
#' Animate
724
#'
725
#' Proxy to dynamically animate an already existing graph.
726
#'
727
#' @inheritParams sg_animate
728
#' @param proxy An object of class \code{sigmajsProxy} as returned by \code{\link{sigmajsProxy}}.
729
#'
730
#' @details You can animate, \code{x}, \code{y}, \code{size} and \code{color}.
731
#'
732
#' @note You have to make sure that all the columns you want to animate to
733
#' (e.g. \code{to_x}, \code{to_size}) are also provided as arguments when you
734
#' create the graph with \code{sigmajs() \%>\% sg_nodes()}.
735
#'
736
#' @seealso \code{\link{sg_animate}}
737
#'
738
#' @examples
739
#' \dontrun{
740
#' # generate graph
741
#' nodes <- sg_make_nodes(20)
742
#' edges <- sg_make_edges(nodes)
743
#'
744
#' # add transition
745
#' n <- nrow(nodes)
746
#' nodes$to_x <- runif(n, 5, 10)
747
#' nodes$to_y <- runif(n, 5, 10)
748
#' nodes$to_size <- runif(n, 5, 10)
749
#'
750
#' # in server function:
751
#' output$my_sigmajs_id <- renderSigmajs({
752
#'   sigmajs() %>%
753
#'     sg_nodes(nodes, id, label, size, color, to_x, to_y, to_size) %>%
754
#'     sg_edges(edges, id, source, target)
755
#' })
756
#'
757
#' observeEvent(input$button, {
758
#'   sigmajsProxy("my_sigmajs_id") %>%
759
#'     sg_animate_p(mapping = list(x = "to_x", y = "to_y", size = "to_size"),
760
#'                  options = list(duration = 1000), delay = 0)
761
#' })
762
#' }
763
#'
764
#' @return The \code{proxy} object.
765
#'
766
#' @rdname animation_p
767
#' @export
768
sg_animate_p <- function(proxy, mapping, options = list(easing = "cubicInOut"), delay = 5000) {
769

770 0
  if (missing(proxy) || missing(mapping))
771 0
    stop("missing proxy or mapping", call. = FALSE)
772

773 0
  .test_proxy(proxy)
774

775 0
  message <- list(id = proxy$id, mapping = mapping, options = options, delay = delay) # create message
776

777 0
  proxy$session$sendCustomMessage("sg_animate_p", message)
778

779 0
  return(proxy)
780
}

Read our documentation on viewing source code .

Loading