Skip to content

Instantly share code, notes, and snippets.

@rich-iannone
Created April 12, 2015 02:26
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save rich-iannone/169c67bf8effdf3f017f to your computer and use it in GitHub Desktop.
Save rich-iannone/169c67bf8effdf3f017f to your computer and use it in GitHub Desktop.
Experimental R script to transition between two graph states in DiagrammeR with D3.
require(DiagrammeR)
require(stringr)
# Animation test
nodes <- c("a", "b", "c") # must be named 'nodes' and should have unique values
nodes_df <- data.frame(nodes)
edge_from <- c("a", "a", "b")
edge_to <- c("b", "c", "c")
edges_df <- data.frame(edge_from, edge_to)
node_attrs <- c("style = filled", "fillcolor = lightblue",
"color = gray", "shape = circle", "fontname = Helvetica")
svg_1 <- graphviz_graph(nodes_df = nodes_df, edges_df = edges_df,
graph_attrs = graph_attrs, node_attrs = node_attrs,
edge_attrs = edge_attrs, directed = TRUE,
return_code = "SVG")
nodes <- c("a", "b", "c") # must be named 'nodes' and should have unique values
nodes_df <- data.frame(nodes)
edge_from <- c("a", "a", "a")
edge_to <- c("b", "c", "a")
edges_df <- data.frame(edge_from, edge_to)
node_attrs <- c("style = filled", "fillcolor = lightblue",
"color = gray", "shape = circle", "fontname = Helvetica")
svg_2 <- graphviz_graph(nodes_df = nodes_df, edges_df = edges_df,
graph_attrs = graph_attrs, node_attrs = node_attrs,
edge_attrs = edge_attrs, directed = TRUE,
return_code = "SVG")
new_nodes_cx <-
gsub("\" ", "",
gsub(" cx=\"", "",
unlist(str_extract_all(svg_2, " cx=.*? "))))
new_nodes_cx_var <-
paste0("new_nodes_cx = [ ", paste(paste0("\"", new_nodes_cx, "\""), collapse = ", "),
" ];")
new_nodes_cy <-
gsub("\" ", "",
gsub(" cy=\"", "",
unlist(str_extract_all(svg_2, " cy=.*? "))))
new_nodes_cy_var <-
paste0("new_nodes_cy = [ ", paste(paste0("\"", new_nodes_cy, "\""), collapse = ", "),
" ];")
new_text_x <-
gsub("\" ", "",
gsub(" x=\"", "",
unlist(str_extract_all(svg_2, " x=.*? "))))
new_text_x_var <-
paste0("new_text_x = [ ", paste(paste0("\"", new_text_x, "\""), collapse = ", "),
" ];")
new_text_y <-
gsub("\" ", "",
gsub(" y=\"", "",
unlist(str_extract_all(svg_2, " y=.*? "))))
new_text_y_var <-
paste0("new_text_y = [ ", paste(paste0("\"", new_text_y, "\""), collapse = ", "),
" ];")
new_polygon <-
gsub("\"/", "",
gsub("points=\"", "",
unlist(str_extract_all(svg_2, "points=.*?/"))))
new_polygon_var <-
paste0("new_polygon = [ ", paste(paste0("\"", new_polygon, "\""), collapse = ", "),
" ];")
new_lines <-
gsub("\"/", "",
gsub(" d=\"", "",
unlist(str_extract_all(svg_2, " d=.*?/"))))
new_lines_var <-
paste0("new_lines = [ ", paste(paste0("\"", new_lines, "\""), collapse = ", "),
" ];")
svg_1_chunk <- gsub("<\\?xml version=\"1.0\" encoding=\"UTF-8\".*?(<svg .*)", "\\1", svg_1)
html_top <-
"<html>
<head>
<meta charset=\"utf-8\" />
<script type=\"text/javascript\" src=\"d3/d3.min.js\"></script>
</head>
<body>
"
html_bottom <-
" </body>
</html>
"
d3_ellipse_transition_x <-
"d3.selectAll(\"ellipse\")
.data(new_nodes_cx)
.transition()
.duration(1000)
.attr(\"cx\", function(d) {
return d;
});
"
d3_ellipse_transition_y <-
"d3.selectAll(\"ellipse\")
.data(new_nodes_cy)
.transition()
.duration(1000)
.attr(\"cy\", function(d) {
return d;
});
"
d3_text_transition_x <-
"d3.selectAll(\"text\")
.data(new_nodes_cx)
.transition()
.duration(1000)
.attr(\"x\", function(d) {
return d;
});
"
d3_text_transition_y <-
"d3.selectAll(\"text\")
.data(new_nodes_cy)
.transition()
.duration(1000)
.attr(\"y\", function(d) {
return d;
});
"
d3_path_transition <-
"d3.selectAll(\"path\")
.data(new_lines)
.transition()
.duration(500)
.style(\"opacity\",0)
.transition()
.duration(500)
.attr(\"d\", function(d) {
return d
})
.style(\"opacity\",1);
"
d3_polygon_transition <-
"d3.selectAll(\"polygon\")
.data(new_polygon)
.transition()
.duration(500)
.style(\"opacity\",0)
.transition()
.duration(500)
.attr(\"d\", function(d) {
return d
})
.style(\"opacity\",1);
"
html_page_transition <-
paste(html_top, svg_1_chunk,
"<script>",
new_nodes_cx_var, new_nodes_cy_var,
new_text_x_var, new_text_y_var,
new_polygon_var, new_lines_var,
d3_ellipse_transition_x,
d3_ellipse_transition_y,
d3_text_transition_x,
d3_text_transition_y,
d3_path_transition,
d3_polygon_transition,
"</script>",
html_bottom,
sep = "\n")
cat(html_page_transition, file = "~/Desktop/transition_test.html")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment