Nothing
#' Visualize, customize and get back a \code{visNetwork} object. Need shiny package
#'
#' @param object : a \code{visNetwork} object
#' @param filter : see \link{visConfigure}
#' @param showButton : see \link{visConfigure}
#'
#' @return a \code{visNetwork} object
#'
#' @examples
#'
#' \dontrun{
#'
#' nodes <- data.frame(id = 1:3, label = paste("Node", 1:3))
#' edges <- data.frame(from = c(1,2), to = c(1,3), label = paste("Edge", 1:2))
#' network <- visNetwork(nodes, edges)
#'
#' custom_network <- visNetworkEditor(object = network)
#' custom_network
#'
#' custom_network <- visNetworkEditor(object = network, filter = "nodes,edges")
#' custom_network
#'
#' }
#'
#' @export
#'
#' @importFrom utils packageVersion
#'
#' @seealso \link{visConfigure}, \link{visTree}, \link{visNetworkEditorServer}
#'
#' @references See online documentation \url{https://datastorm-open.github.io/visNetwork/}
#'
visNetworkEditor <- function(object, filter = NULL, showButton = NULL){
if(!requireNamespace("shiny")){
stop("visNetworkEditor require 'shiny' package")
} else {
if(packageVersion("shiny") < '1.0.0'){
stop("visNetworkEditor require 'shiny' 1.0.0 or more")
}
}
# server
server <- function(input, output, session) {
shiny::callModule(visNetworkEditorServer, id = "editor" ,
object = shiny::reactive(object),
filter = shiny::reactive(filter),
showButton = shiny::reactive(showButton))
}
ui <- shiny::fluidPage(
visNetworkEditorUI(id = "editor", quitButton = TRUE)
)
return(shiny::runApp(shiny::shinyApp(ui = ui, server = server)))
}
#' Module shiny for visualize and customize and get back a \code{visNetwork} object.
#' Using the javascript interface \link{visConfigure}.
#'
#' @param input \code{list} shiny input
#' @param output \code{list}, shiny output
#' @param session \code{list}, shiny session
#' @param id \code{character} id of module, linked to \link{visNetworkEditorUI}
#' @param object a \code{visNetwork} object. Must be a reactive.
#' @param filter : see \link{visConfigure}. Must be a reactive.
#' @param showButton : see \link{visConfigure}. Must be a reactive.
#' @param quitButton : logical. Add a button for quit shiny and get back network in R ?
#' @param height : height of the configuration div. Default to "700px"
#'
#' @examples
#' \dontrun{
#'
#' nodes <- data.frame(id = 1:3, label = paste("Node", 1:3))
#' edges <- data.frame(from = c(1,2), to = c(1,3), label = paste("Edge", 1:2))
#' network <- visNetwork(nodes, edges)
#'
#' shiny::shinyApp(ui = shiny::fluidPage(
#' visNetworkEditorUI(id = "id1")),
#' server = function(input, output, session) {
#' shiny::callModule(visNetworkEditorServer, "id1", object = shiny::reactive(network))
#' })
#'
#' }
#' @name visNetworkEditor-module
#'
#' @export
#'
#' @seealso \link{visConfigure}, \link{visTree}, \link{visNetworkEditor}
#'
#' @references See online documentation \url{https://datastorm-open.github.io/visNetwork/}
#'
#'
visNetworkEditorServer <- function(input, output, session, object,
filter = shiny::reactive(NULL), showButton = shiny::reactive(NULL)) {
ns <- session$ns
# renderNetwork
output$network <- renderVisNetwork({
object() %>%
visConfigure(enabled = TRUE, container = ns("configure"),
filter = filter(), showButton = showButton())
})
output$network_ui <- shiny::renderUI({
height <- "700px"
if(!is.null(object()$height)){
height <- object()$height
}
visNetworkOutput(ns("network"), height = height)
})
# retrieve new options on quit
shiny::observe({
if(!is.null(input$quit_btn)){
if(input$quit_btn > 0){
session$sendCustomMessage(
type='visShinyGetOptionsFromConfigurator',
message=list(id = ns("network"), input = ns(paste0("network", "_", "configurator")))
)
}
}
})
# quit and get back new network
shiny::observe({
if(!is.null(input$network_configurator)){
update_network <- object() %>%
visSetOptions(options = vis_list_clean(input$network_configurator, recursive = TRUE)) %>%
visConfigure(enabled = FALSE)
shiny::stopApp(update_network)
}
})
}
#' @rdname visNetworkEditor-module
#'
#' @export
visNetworkEditorUI <- function(id, quitButton = FALSE, height = "700px") {
ns <- shiny::NS(id)
shiny::fluidPage(
shiny::tags$head(
shiny::tags$style(HTML("input.vis-configuration.vis-config-rangeinput {visibility : hidden;}"))
),
shiny::fluidRow(
shiny::column(5,
shiny::div(id = ns("configure"),
style = paste0("overflow: auto;overflow-x: hidden; height:", height, ";")),
if(quitButton){
shiny::div(hr(), shiny::actionButton(ns("quit_btn"), "Quit and get back network in R"), align = "center")
}
),
shiny::column(7, shiny::uiOutput(ns("network_ui")))
)
)
}
vis_setmembers <- `[<-`
vis_list_clean <- function (.data, fun = is.null, recursive = FALSE)
{
if (recursive) {
.data <- lapply(.data, function(.item) {
if (is.list(.item))
vis_list_clean(.item, fun, recursive = TRUE)
else .item
})
}
vis_setmembers(.data, vapply(.data, fun, logical(1L)), NULL)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.