Potpourri of graph viz and other improvements

.gitignore

@@ -16,3 +16,6 @@ tests/testthat/Rplots.pdf
 **/*.tar.gz
 pkgnet.Rcheck/*
 .Rproj.user
+
+# Compiled vignette
+inst/doc/*

DESCRIPTION

@@ -6,7 +6,7 @@ Authors@R: c(
     person("Brian", "Burns", email = "brian.burns@uptake.com", role = c("aut", "cre")),
     person("James", "Lamb", email = "james.lamb@uptake.com", role = c("aut")),
     person("Patrick", "Boueri", email = "patrick.boueri@uptake.com", role = c("ctb")),
-    person("Jay", "Qi", email = "jay.qi@uptake.com", role = c("ctb"))
+    person("Jay", "Qi", email = "jay.qi@uptake.com", role = c("aut"))
     )
 Maintainer: Brian Burns <brian.burns@uptake.com>
 Description: Tools from the domain of graph theory can be used to quantify the complexity

NAMESPACE

@@ -24,6 +24,7 @@ importFrom(data.table,data.table)
 importFrom(data.table,melt)
 importFrom(data.table,rbindlist)
 importFrom(data.table,setcolorder)
+importFrom(data.table,setkeyv)
 importFrom(data.table,setnames)
 importFrom(data.table,uniqueN)
 importFrom(futile.logger,INFO)

R/PackageDependencyReporter.R

@@ -90,6 +90,8 @@ DependencyReporter <- R6::R6Class(
     ),
 
     private = list(
+        # Default graph viz layout
+        private_layout_type = "layout_as_tree",
 
         dep_types = NULL,
         ignore_packages = NULL,
@@ -173,12 +175,15 @@ DependencyReporter <- R6::R6Class(
                 log_fatal(sprintf(msg, self$pkg_name, paste(private$dep_types, collapse = ", ")))
             }
 
+            # If pkg A depends on pkg B, then A -> B
+            # A is the SOURCE and B is the TARGET
+            # This is UML dependency convention
             edges <- data.table::rbindlist(lapply(
                 names(dependencyList),
                 function(pkgN){
                     data.table::data.table(
-                        SOURCE = dependencyList[[pkgN]]
-                        , TARGET = rep(pkgN,length(dependencyList[[pkgN]]))
+                        SOURCE = rep(pkgN, length(dependencyList[[pkgN]]))
+                        , TARGET = dependencyList[[pkgN]]
                     )
                 }
             ))
@@ -236,5 +241,16 @@ DependencyReporter <- R6::R6Class(
             }
             return(outPackages)
         }
-    )
+
+        , plot_network = function() {
+            g <- super$plot_network()
+
+            g <- (g
+                  %>% visNetwork::visHierarchicalLayout(
+                      sortMethod = "directed"
+                      , direction = "UD")
+            )
+            return(g)
+        }
+    ) # /private
 )

R/PackageFunctionReporter.R

@@ -121,6 +121,9 @@ FunctionReporter <- R6::R6Class(
 
     private = list(
 
+        # Default graph viz layout
+        private_layout_type = "layout_with_graphopt",
+
         get_pkg_env = function() {
             if (is.null(private$cache$pkg_env)) {
                 # create a custom environment w/ this package's contents
@@ -314,6 +317,15 @@ FunctionReporter <- R6::R6Class(
 
             return(edgeDT)
         }
+
+        , plot_network = function() {
+            g <- super$plot_network()
+
+            g <- (g
+                %>% visNetwork::visHierarchicalLayout(enabled = FALSE)
+            )
+            return(g)
+        }
     )
 )
 
@@ -349,13 +361,14 @@ FunctionReporter <- R6::R6Class(
         return(invisible(NULL))
     }
 
-    # Convention: If B depends on A, then B is the TARGET
-    # and A is the SOURCE so that it looks like A -> B
+    # Convention: If A depends on B, then A is the SOURCE
+    # and B is the TARGET so that it looks like A -> B
+    # This is consistent with the UML dependency convention
     # fname calls <matches>. So fname depends on <matches>.
-    # So fname is TARGET and <matches> are SOURCEs
+    # So fname is SOURCE and <matches> are TARGETs
     edgeDT <- data.table::data.table(
-        SOURCE = unique(all_functions[matches])
-        , TARGET = fname
+        SOURCE = fname
+        , TARGET = unique(all_functions[matches])
     )
 
     return(edgeDT)
@@ -486,13 +499,14 @@ FunctionReporter <- R6::R6Class(
         return(NULL)
     }
 
-    # Convention: If B depends on A, then B is the TARGET
-    # and A is the SOURCE so that it looks like A -> B
-    # fname calls <matches>. So fname depends on <matches>.
-    # So fname is TARGET and <matches> are SOURCEs
+    # Convention: If A depends on B, then A is the SOURCE
+    # and B is the TARGET so that it looks like A -> B
+    # This is consistent with the UML dependency convention.
+    # The method calls the MATCHes, so method is SOURCE and
+    # the MATCHes are the TARGETs
     edgeDT <- data.table::data.table(
-        SOURCE = unique(mbodyDT[!is.na(MATCH), MATCH])
-        , TARGET = paste(class_name, method_type, method_name, sep = "$")
+        SOURCE = paste(class_name, method_type, method_name, sep = "$")
+        , TARGET = unique(mbodyDT[!is.na(MATCH), MATCH])
     )
 
     return(edgeDT)

R/PackageInheritanceReporter.R

@@ -136,7 +136,7 @@ InheritanceReporter <- R6::R6Class(
 
                 if (nrow(nodeDT) == 0) {
                     msg <- sprintf(
-                        'No Reference Class or R6 Class definitions found in package %s'
+                        'No S4, Reference, or R6 class definitions found in package %s'
                         , self$pkg_name
                     )
                     log_warn(msg)
@@ -194,7 +194,12 @@ InheritanceReporter <- R6::R6Class(
                     }
                 }
 
+                # Combine all edges together
                 edgeDT <- data.table::rbindlist(edgeList)
+
+                # Filter out any parents that are external to the package
+                edgeDT <- edgeDT[TARGET %in% nodeDT[, node]]
+
                 private$cache$edges <- edgeDT
 
             }
@@ -207,12 +212,31 @@ InheritanceReporter <- R6::R6Class(
     ),
 
     private = list(
+        # Default graph viz layout
+        private_layout_type = "layout_as_tree",
+
+        plotNodeColorScheme = list(
+            field = "classType"
+            , palette = c('#f0f9e8', '#bae4bc', '#7bccc4')
+        ),
+
         get_pkg_env = function() {
             if (is.null(private$cache$pkg_env)) {
                 # create a custom environment w/ this package's contents
                 private$cache$pkg_env <- loadNamespace(self$pkg_name)
             }
             return(private$cache$pkg_env)
+        },
+
+        plot_network = function() {
+            g <- super$plot_network()
+
+            g <- (g
+                  %>% visNetwork::visHierarchicalLayout(
+                      sortMethod = "directed"
+                      , direction = "DU")
+            )
+            return(g)
         }
     )
 

R/pkgnet.R

@@ -24,6 +24,13 @@ globalVariables(c('.'
                   ,'xend'
                   ,'y'
                   ,'yend'
+                  , 'CLASS_NAME'
+                  , 'MATCH'
+                  , 'METHOD_NAME'
+                  , 'METHOD_TYPE'
+                  , 'PARENT_IN_PKG'
+                  , 'PARENT_NAME'
+                  , 'SYMBOL'
                   ))
 
 # NULL object for common parameter documentation

inst/milne/R/The_Friend.R

@@ -41,5 +41,5 @@ RightAnswer <- setRefClass(
 # @description Incorrect Answer to a Question
 WrongAnswer <- setRefClass(
     Class = "WrongAnswer",
-    contains = "PoohAnswer"
+    contains = c("PoohAnswer", "numeric")
 )

inst/package_report/package_report.Rmd

@@ -12,8 +12,18 @@ params:
    pkg_name: params$pkg_name
 ---
 
+<style>
+    body .main-container {
+        max-width: 80%;
+    }
+</style>
+
 ```{r setup, include=FALSE}
-knitr::opts_chunk$set(echo = FALSE, warning=FALSE)
+knitr::opts_chunk$set(
+    echo = FALSE
+    , warning=FALSE
+    , out.width='100%'
+)
 pkgnet:::silence_logger()
 ```
 

tests/testthat/test-AbstractGraphReporter.R

@@ -17,15 +17,15 @@ futile.logger::flog.threshold(0)
 ## Structure Available ##
 
 test_that('AbstractGraphReporter structure is as expected', {
-    
+
     expect_named(
         object = AbstractGraphReporter$public_methods
         , expected = c("clone")
         , info = "Available public methods for AbstractGraphReporter not as expected."
         , ignore.order = TRUE
         , ignore.case = FALSE
     )
-    
+
     expect_named(
         object = AbstractGraphReporter$public_fields
         , expected = NULL
@@ -37,8 +37,15 @@ test_that('AbstractGraphReporter structure is as expected', {
 
 ### USAGE OF PUBLIC AND PRIVATE METHODS AND FIELDS TO BE TESTED BY CHILD OBJECTS
 
+test_that(".igraphAvailableLayouts returns layouts correctly", {
+    expect_true({
+        length(pkgnet:::.igraphAvailableLayouts()) > 0
+    })
+})
+
+
 ##### TEST TEAR DOWN #####
 
 futile.logger::flog.threshold(origLogThreshold)
 rm(list = ls())
-closeAllConnections()
+closeAllConnections()