Nothing
#' Netreader
#'
#' \code{Netreader} is an RStudio-Addin that allows you to read network files. So far, only plaintext files are supported (e.g. csv,tsv,...).
#'
#' @details To run the addin, select \code{Netreader} from the Addins-menu within RStudio.
#' @return \code{Netreader} returns the created network as igraph object.
#' @import miniUI
#' @import shiny
#' @import rstudioapi
#' @importFrom igraph graph_from_adjacency_matrix graph_from_data_frame vcount vertex_attr_names set_vertex_attr get.vertex.attribute
#' @name Netreader
NULL
Netreader <- function() {
rv <- reactiveValues(g = NULL, pathN = NULL, pathA = NULL, code = NULL)
# ui ----
ui <- miniPage(
tags$head(
tags$style(HTML("hr {border-top: 1px solid #000000;}"))
),
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", "#preview {background-color: rgba(0,0,0,0.50); color: white;}"),
tags$style(type = "text/css", "#previewA {background-color: rgba(0,0,0,0.50); color: white;}"),
tags$style(type = "text/css", "#netpreview {background-color: rgba(0,0,0,0.50); color: white;}"),
tags$style(type = "text/css", "#netpreviewA {background-color: rgba(0,0,0,0.50); color: white;}"),
tags$style(type = "text/css", "#codereview {background-color: rgba(0,0,0,1); color: white;}"),
tags$style(type = "text/css", "#readit {background-color: rgba(30,144,255,1); color: white}"),
tags$style(type = "text/css", "#readitA {background-color: rgba(30,144,255,1); color: white}"),
tags$style(type = "text/css", "#netfile {background-color: rgba(30,144,255,1); color: white}"),
tags$style(type = "text/css", "#attrfile {background-color: rgba(30,144,255,1); color: white}"),
gadgetTitleBar("Netreader"),
miniTabstripPanel(
selected = "Import Network",
miniTabPanel("Import Network",
icon = icon("bezier-curve"),
fillRow(
height = "30px", width = "100%",
strong("Choose network file")
),
fillRow(
height = "50px", width = "50%",
# fileInput("netfile", "Choose network file")
actionButton("netfile", "Browse...")
),
fillRow(
height = "50px", width = "75%",
verbatimTextOutput("netfilePath")
),
fillRow(
height = line.height, width = "100%",
h4("File Preview (first 5 lines)")
),
fillRow(
height = "120px", width = "100%",
verbatimTextOutput("preview")
),
fillRow(
height = line.height, width = "50%",
checkboxInput("colnames", "Header", value = FALSE),
checkboxInput("rownames", "Rownames", value = FALSE),
checkboxInput("quotes", "Quotes", value = FALSE),
checkboxInput("directed", "Directed", value = FALSE)
),
fillRow(
height = line.height, width = "50%",
radioButtons("readfct", "network format", choices = c("edgelist", "adjacency matrix")),
radioButtons("valsep", "file delimiter", choices = c("comma" = ",", "space" = " ", "tab" = "\t"))
),
hr(),
fillRow(
height = line.height, width = "100%",
actionButton("readit", "Import Network"),
textAreaInput("text", label = "", value = "", placeholder = "enter name", height = "35px")
),
fillRow(
height = "120px", width = "100%",
verbatimTextOutput("netpreview")
)
),
# attributes ----
miniTabPanel("Add Attributes",
icon = icon("list-ol"),
fillRow(
height = "30px", width = "100%",
strong("Choose attribute file")
),
fillRow(
height = "50px", width = "100%",
# fileInput("attrfile", "Choose attribute file")
actionButton("attrfile", "Browse...")
),
fillRow(
height = "50px", width = "75%",
verbatimTextOutput("attrfilePath")
),
fillRow(
height = line.height, width = "100%",
h4("File Preview (first 5 lines)")
),
fillRow(
height = "120px", width = "100%",
verbatimTextOutput("previewA")
),
fillRow(
height = line.height, width = "50%",
checkboxInput("colnamesA", "Header", value = TRUE),
checkboxInput("quotesA", "Quotes", value = FALSE),
radioButtons("valsepA", "file delimiter", choices = c("comma" = ",", "space" = " ", "tab" = "\t"))
),
tags$hr(),
fillRow(
height = line.height, width = "100%",
actionButton("readitA", "Import Attributes")
),
fillRow(
height = "120px", width = "100%",
verbatimTextOutput("netpreviewA")
)
),
# show code ----
miniTabPanel("Review Code",
icon = icon("code"),
verbatimTextOutput("codereview")
)
)
)
# server ----
server <- function(input, output, session) {
# choose netfile path ----
observeEvent(input$netfile, {
rv$pathN <- file.choose()
})
# choose attrfile path ----
observeEvent(input$attrfile, {
rv$pathA <- file.choose()
})
output$netfilePath <- renderPrint(
if (!is.null(rv$pathN)) {
cat(rv$pathN)
} else {
cat("no file selected")
}
)
output$attrfilePath <- renderPrint(
if (!is.null(rv$pathA)) {
cat(rv$pathA)
} else {
cat("no file selected")
}
)
# file preview ----
output$preview <- renderText({
# inFile <- input$netfile
inFile <- rv$pathN
if (is.null(inFile)) {
return(NULL)
}
txt <- readLines(inFile, n = 5)
txt <- paste(txt, collapse = "\n")
txt
})
# attribute preview ----
output$previewA <- renderText({
# inFile <- input$attrfile
inFile <- rv$pathA
if (is.null(inFile)) {
return(NULL)
}
txt <- readLines(inFile, n = 5)
txt <- paste(txt, collapse = "\n")
txt
})
# network preview ----
output$netpreview <- renderPrint({
g <- rv$g
if (is.null(g)) {
return(cat("no network created yet."))
}
summary(g)
})
# network2 preview ----
output$netpreviewA <- renderPrint({
g <- rv$g
if (is.null(g)) {
return(cat("no network created yet."))
}
summary(g)
})
# codeoutput ----
output$codereview <- renderPrint({
cat(rv$code)
})
# read network ----
observeEvent(input$readit, {
inFile <- rv$pathN
q <- ifelse(input$quotes, "\"", "")
if (input$rownames) {
A <- tryCatch(
utils::read.table(inFile,
header = input$colnames,
row.names = 1,
sep = input$valsep, quote = q,
stringsAsFactors = FALSE
),
error = function(e) NULL
)
head <- "library(igraph)\n\n# load raw network data ----\n"
cmd <- paste0(
"A <- utils::read.table(file = '", inFile, "'",
",\n header = ", input$colnames, ", row.names = 1",
", sep = '", input$valsep, "'", ", quote = '", q, "', stringsAsFactors = FALSE)\n"
)
rv$code <- paste(head, cmd)
} else {
A <- tryCatch(
utils::read.table(inFile,
header = input$colnames,
sep = input$valsep, quote = q,
stringsAsFactors = FALSE
),
error = function(e) NULL
)
head <- "library(igraph)\n# load raw network data ----\n"
cmd <- paste0(
"A <- utils::read.table(file = '", inFile, "'",
",\n header = ", input$colnames, ", sep = '", input$valsep, "'",
", quote = '", q, "', stringsAsFactors = FALSE)\n"
)
rv$code <- paste0(head, cmd)
}
if (is.null(A)) {
showNotification("something went wrong reading the file. Check your settings", type = "error", duration = 2)
} else {
if (input$readfct == "adjacency matrix") {
mode <- ifelse(input$directed, "directed", "undirected")
g <- tryCatch(graph_from_adjacency_matrix(as.matrix(A), mode = mode, weighted = "weight"), error = function(e) NULL)
if (is.null(g)) {
showNotification("something went wrong creating the network.", type = "error", duration = 2)
} else {
head <- "# create network ----\n"
cmd <- paste0("g <- graph_from_adjacency_matrix(as.matrix(A),mode = '", mode, "')\n")
rv$code <- paste0(rv$code, head, cmd)
rv$g <- g
showNotification("network data successfully imported", type = "message", duration = 2)
}
} else if (input$readfct == "edgelist") {
mode <- ifelse(input$directed, T, F)
g <- tryCatch(graph_from_data_frame(A, directed = mode), error = function(e) NULL)
if (is.null(g)) {
showNotification("something went wrong creating the network.", type = "error", duration = 2)
} else {
head <- "# create network ----\n"
cmd <- paste0("g <- graph_from_data_frame(A,directed = ", mode, ")\n")
rv$code <- paste0(rv$code, "\n", head, cmd)
rv$g <- g
showNotification("network data successfully imported", type = "message", duration = 2)
}
}
}
})
# read attributes ----
observeEvent(input$readitA, {
if (is.null(rv$g)) {
showNotification("please import a network first", type = "error", duration = 2)
} else {
# inFile <- input$attrfile
inFile <- rv$pathA
q <- ifelse(input$quotesA, "\"", "")
A <- tryCatch(
utils::read.table(inFile,
header = input$colnamesA,
sep = input$valsepA, quote = q,
stringsAsFactors = FALSE
),
error = function(e) NULL
)
head <- "# load raw attribute data ----\n"
cmd <- paste0(
"attrs <- utils::read.table(file = '", inFile, "'",
",\n header = ", input$colnamesA, ", sep = '", input$valsepA, "'",
", quote = '", q, "', stringsAsFactors = FALSE)\n"
)
rv$code <- paste0(rv$code, "\n", head, cmd)
if (is.null(A)) {
showNotification("something went wrong reading the file. Check your settings", type = "error", duration = 2)
} else {
if (nrow(A) != vcount(rv$g)) {
showNotification("The number of rows does not match the number of nodes in the network", type = "error", duration = 2)
} else {
if ("name" %in% vertex_attr_names(rv$g)) {
vnames <- get.vertex.attribute(rv$g, "name")
identCol <- which(apply(A, 2, function(x) all(x %in% vnames)))[1]
anames <- A[, identCol]
A <- A[, -identCol, drop = FALSE]
perm <- match(vnames, anames)
for (attr in names(A)) {
rv$g <- set_vertex_attr(rv$g, name = attr, value = A[[attr]][perm])
}
head <- "# add attributes to network ----\n"
cmd <- AttrNameImport
rv$code <- paste0(rv$code, "\n", head, cmd)
} else {
showNotification("network does not have a name attribute.\nmatching by row number instead", type = "warning", duration = 2)
for (attr in names(A)) {
rv$g <- set_vertex_attr(rv$g, name = attr, value = A[[attr]])
}
head <- "# add attributes to network ----\n"
cmd <- AttrRowImport
rv$code <- paste0(rv$code, "\n", head, cmd)
}
showNotification("Attributes successfully imported", type = "message", duration = 2)
}
}
}
})
# cancel ----
observeEvent(input$cancel, {
invisible(stopApp())
})
# done ----
observeEvent(input$done, {
if (input$text == "") {
showNotification("Please enter a variable name", type = "warning", duration = 2)
} else {
eval(parse(text = paste0("assign(\"", input$text, "\",rv$g", ",envir = .GlobalEnv)")))
invisible(stopApp())
}
})
}
viewer <- dialogViewer(dialogName = "Netreader", width = 990, height = 900)
runGadget(ui, server, stopOnCancel = FALSE, viewer = viewer)
}
#' @export
#' @rdname Netreader
NetreaderAddin <- function() {
Netreader()
}
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.