#' Netbuilder
#'
#' \code{Netbuilder} is an RStudio-Addin that allows you to create small networks with point and click.
#'
#' @details To run the addin, select \code{Netbuilder} from the Addins-menu within RStudio.
#' @return \code{Netbuilder} returns the created network as igraph object.
#' @import miniUI
#' @import shiny
#' @import ggplot2
#' @import ggraph
#' @import rstudioapi
#' @import igraph
#' @name Netbuilder
NULL
Netbuilder <- function() {
rv <- reactiveValues(
g = igraph::graph.empty(n = 0, directed = FALSE), xy = matrix(0, 0, 2),
start = -1, end = -1, el = matrix(0, 0, 2)
)
# ui ----
ui <- miniPage(
tags$script(jscodeWidth),
tags$script(jscodeHeight),
tags$style(type = "text/css", ".selectize-dropdown{ width: 200px !important; }"),
tags$style(type = "text/css", ".form-group.shiny-input-container{width:50%;}"),
tags$style(type = "text/css", "#makeD {background-color: rgba(30,144,255,1); color: white}"),
tags$style(type = "text/css", "#makeU {background-color: rgba(30,144,255,1); color: white}"),
tags$style(type = "text/css", "#clearG {background-color: rgba(220,20,60,1); color: white}"),
gadgetTitleBar("Netbuilder"),
plotOutput("Graph1", width = "80%", height = "80%", click = "add_edge", dblclick = "add_vertex"),
# hover = hoverOpts(id = "showXY",delay = 500,delayType = "throttle")),
fillRow(
height = line.height, width = "100%",
actionButton("makeU", "make undirected"),
actionButton("makeD", "make directed"),
actionButton("clearG", "clear"),
textAreaInput("text", label = "", value = "", placeholder = "enter name", height = "35px")
),
p(
strong("Double Click:"), " add vertex.",
strong("Click on two nodes:"), " add edge.",
strong("Done:"), "Export graph to global enivronment with name from text input field"
)
)
# server ----
server <- function(input, output, session) {
#--------------------#
# observe click ----
#--------------------#
shiny::observeEvent(input$add_edge, {
pts <- c(input$add_edge$x, input$add_edge$y)
g <- rv$g
xy <- rv$xy
start <- rv$start
end <- rv$end
closest_nID <- closest_node(pts, xy)
if (start == -1) {
start <- closest_nID
rv$start <- start
} else {
end <- closest_nID
if (end != -1) {
g <- igraph::add.edges(g, c(start, end))
rv$start <- -1
rv$end <- -1
rv$g <- g
rv$el <- rbind(rv$el, c(start, end))
} else {
g <- igraph::add.vertices(g, 1)
rv$start <- -1
rv$end <- -1
xy <- rv$xy
xy <- rbind(xy, pts)
g <- igraph::add.edges(g, c(start, nrow(xy)))
rv$xy <- xy
rv$g <- g
rv$el <- rbind(rv$el, c(start, nrow(xy)))
}
}
gg_reactive()
})
#--------------------#
# observe dbclick ----
#--------------------#
shiny::observeEvent(input$add_vertex, {
g <- rv$g
g <- igraph::add.vertices(g, 1)
rv$g <- g
xy <- rv$xy
xy <- rbind(xy, c(input$add_vertex$x, input$add_vertex$y))
rv$xy <- xy
rv$start <- -1
gg_reactive()
})
#--------------------#
# observe dbclick ----
#--------------------#
# output$coordXY <- renderPrint({
# cat("Hover:\n")
# str(input$showXY)
# })
#--------------------#
# make (un)directed ----
#--------------------#
shiny::observeEvent(input$makeD, {
if (igraph::ecount(rv$g) != 0) {
# el <- igraph::get.edgelist(rv$g)
el <- rv$el
g <- igraph::graph_from_edgelist(el, directed = TRUE)
rv$g <- g
}
})
shiny::observeEvent(input$makeU, {
if (igraph::ecount(rv$g) != 0) {
# el <- igraph::get.edgelist(rv$g)
el <- rv$el
g <- igraph::graph_from_edgelist(el, directed = FALSE)
rv$g <- g
}
})
shiny::observeEvent(input$clearG, {
g <- igraph::graph.empty(n = 0, directed = FALSE)
rv$g <- g
xy <- matrix(0, 0, 2)
rv$xy <- xy
rv$el <- xy
})
#-------------------#
# plot ----
#-------------------#
gg_reactive <- reactive({
code_layout <- "ggraph(rv$g,layout = \"manual\", x = rv$xy[,1], y = rv$xy[,2])"
code_nodes <- "geom_node_point(shape = 21,fill = \"grey25\",size=8)"
code_label <- "geom_node_text(label=1:nrow(rv$xy),size=6,col=\"white\")"
if (igraph::is.directed(rv$g)) {
code_arrow <- paste0(
",\narrow = arrow(angle = 25, length = unit(0.15, \"inches\")",
",\nends = \"last\", type = \"closed\")",
",\nend_cap = circle(", 8, ", \"pt\"))"
)
code_edges <- "geom_edge_link(edge_width=0.4,edge_colour=\"grey66\""
code_edges <- paste0(code_edges, ", ", code_arrow)
} else {
code_edges <- "geom_edge_link0(edge_width=0.4,edge_colour=\"grey66\")"
}
code_theme <- "theme_graph(foreground=\"black\",border=TRUE)"
code_scale <- "scale_x_continuous(limits=c(0,10)) + scale_y_continuous(limits=c(0,10))"
code <- paste(code_layout, code_edges, code_nodes, code_label, code_theme, code_scale, sep = " + ")
p <- code
return(p)
})
# render plot
ggnet <- renderPlot({
eval(parse(text = gg_reactive()))
})
output$Graph1 <- ggnet
# cancel ----
observeEvent(input$cancel, {
invisible(stopApp())
})
# done ----
observeEvent(input$done, {
igraph::V(rv$g)$x <- rv$xy[, 1]
igraph::V(rv$g)$y <- rv$xy[, 2]
if (input$text == "") {
showNotification("Please enter a variable name", type = "warning")
} else {
eval(parse(text = paste0("assign(\"", input$text, "\",rv$g", ",envir = .GlobalEnv)")))
invisible(stopApp())
}
})
}
viewer <- dialogViewer(dialogName = "Netbuilder", width = 990, height = 900)
runGadget(ui, server, stopOnCancel = FALSE, viewer = viewer)
}
#' @export
#' @rdname Netbuilder
NetbuilderAddin <- function() {
Netbuilder()
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.