R/Netreader.R

In schochastics/snahelper: 'RStudio' Addin for Network Analysis and Visualization

#' 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()
}