From 0cda15dc1489fd74d28162f31d171e460a0d1b2f Mon Sep 17 00:00:00 2001 From: Jay Qi Date: Sat, 10 Nov 2018 18:29:56 -0600 Subject: [PATCH 01/10] Working code for R6 in FunctionReporter --- R/PackageFunctionReporter.R | 249 ++++++++++++++++++++++++++++++++++-- 1 file changed, 239 insertions(+), 10 deletions(-) diff --git a/R/PackageFunctionReporter.R b/R/PackageFunctionReporter.R index 11df2e1a..f7840160 100644 --- a/R/PackageFunctionReporter.R +++ b/R/PackageFunctionReporter.R @@ -74,11 +74,52 @@ FunctionReporter <- R6::R6Class( }, report_markdown_path = function(){ system.file(file.path("package_report", "package_function_reporter.Rmd"), package = "pkgnet") + }, + pkg_R6_classes = function() { + if (is.null(private$cache$pkg_R6_classes)) { + pkg_env <- private$get_pkg_env() + private$cache$pkg_R6_classes <- Filter( + f = function(x, p = pkg_env){ + R6::is.R6Class(get(x, p)) + } + , x = names(pkg_env) + ) + } + return(private$cache$pkg_R6_classes) + }, + pkg_R6_methods = function() { + if (is.null(private$cache$pkg_R6_methods)){ + private$cache$pkg_R6_methods <- data.table::rbindlist(lapply( + X = self$pkg_R6_classes + , FUN = function(x, p = private$get_pkg_env()) { + .get_R6_class_methods(get(x,p)) + } + )) + } + return(private$cache$pkg_R6_methods) + }, + pkg_R6_inheritance = function() { + if (is.null(private$cache$pkg_R6_inheritance)) { + private$cache$pkg_R6_inheritance <- .get_R6_class_inheritance( + self$pkg_R6_classes + , self$pkg_name + , private$get_pkg_env() + ) + } + return(private$cache$pkg_R6_inheritance) } ), private = list( - + + 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) + }, + # add coverage to nodes table calculate_test_coverage = function(){ @@ -148,15 +189,16 @@ FunctionReporter <- R6::R6Class( return(invisible(NULL)) }, - extract_nodes = function(){ + extract_nodes = function() { if (is.null(self$pkg_name)) { log_fatal('Must set_package() before extracting nodes.') } - # create a custom environment w/ this package's contents - pkg_env <- loadNamespace(self$pkg_name) + pkg_env <- private$get_pkg_env() + + ## FUNCTIONS ## - # Filter objects to just functions + # Filter objects in package environment to just functions # This will now be a character vector full of function names funs <- Filter( f = function(x, p = pkg_env){is.function(get(x, p))} @@ -164,7 +206,10 @@ FunctionReporter <- R6::R6Class( ) # Create nodes data.table - nodes <- data.table::data.table(node = funs) + nodes <- data.table::data.table( + node = funs + , type = "function" + ) # Figure out which functions are exported # We need the package to be loaded first @@ -175,7 +220,18 @@ FunctionReporter <- R6::R6Class( }) exported_obj_names <- ls(sprintf("package:%s", self$pkg_name)) nodes[, isExported := node %in% exported_obj_names] - + + # Check if we have R6 functions + if (length(self$pkg_R6_classes) > 0) { + r6DT <- self$pkg_R6_methods[, .( + node = paste(CLASS_NAME, METHOD_TYPE, METHOD_NAME, sep = "$") + , type = "R6 method" + , isExported = CLASS_NAME %in% exported_obj_names + )] + + nodes <- data.table::rbindlist(list(nodes, r6DT)) + } + return(nodes) }, @@ -187,12 +243,14 @@ FunctionReporter <- R6::R6Class( log_info(sprintf('Constructing network representation...')) # create a custom environment w/ this package's contents - pkg_env <- loadNamespace(self$pkg_name) + pkg_env <- private$get_pkg_env() + + ### FUNCTIONS ### # Get table of edges between functions # for each function, check if anything else in the package # was called by it - funs <- self$nodes[, node] + funs <- self$nodes[type == "function", node] edgeDT <- data.table::rbindlist( lapply( X = funs @@ -203,6 +261,27 @@ FunctionReporter <- R6::R6Class( , fill = TRUE ) + ### R6 METHODS ### + if (length(self$pkg_R6_classes) > 0) { + edgeDT <- data.table::rbindlist(c( + list(edgeDT) + , mapply( + FUN = .determine_R6_dependencies + , method_name = self$pkg_R6_methods[, METHOD_NAME] + , method_type = self$pkg_R6_methods[, METHOD_TYPE] + , class_name = self$pkg_R6_methods[, CLASS_NAME] + , MoreArgs = list( + methodsDT = self$pkg_R6_methods + , inheritanceDT = self$pkg_R6_inheritance + , pkg_env = private$get_pkg_env() + , pkg_functions = funs + ) + ) + ) + , fill = TRUE + ) + } + # If there are no edges, we still want to return a length-zero # data.table with correct columns if (nrow(edgeDT) == 0) { @@ -214,7 +293,7 @@ FunctionReporter <- R6::R6Class( } log_info("Done constructing network representation") - + return(edgeDT) } ) @@ -279,3 +358,153 @@ FunctionReporter <- R6::R6Class( } return(out) } + + +.get_R6_class_methods <- function(thisClass) { + assertthat::assert_that( + R6::is.R6Class(thisClass) + ) + + method_types <- c('public_methods', 'active', 'private_methods') + + methodsDT <- data.table::rbindlist(do.call( + c, + lapply(method_types, function(mtype) { + lapply(names(thisClass[[mtype]]), function(mname) { + list(METHOD_TYPE = mtype, METHOD_NAME = mname) + }) + }) + )) + methodsDT[, CLASS_NAME := thisClass$classname] + + return(methodsDT) +} + +.get_R6_class_inheritance <- function(class_names, pkg_name, pkg_env) { + inheritanceDT <- data.table::rbindlist(lapply( + X = class_names + , FUN = function(x, p = pkg_env) { + parentClass <- get(x, p)$get_inherit() + return(list( + CLASS_NAME = x + , PARENT_NAME = if (!is.null(parentClass)) parentClass$classname else NA_character_ + , PARENT_IN_PKG = (pkg_name == environmentName(parentClass$parent_env)) + )) + } + )) +} + + +.determine_R6_dependencies <- function(method_name + , method_type + , class_name + , methodsDT + , inheritanceDT + , pkg_env + , pkg_functions +) { + # Get body of method + mbody <- get(class_name, envir = pkg_env)[[method_type]][[method_name]] + + # Parse into symbols + mbodyDT <- data.table::data.table( + SYMBOL = unique(.parse_R6_expression(mbody)) + ) + + # Match to R6 methods + mbodyDT[grepl('(^self\\$|^private\\$)', SYMBOL) + , MATCH := vapply(SYMBOL + , FUN = .match_R6_methods + , FUN.VALUE = character(1) + , class_name = class_name + , methodsDT = methodsDT + , inheritanceDT = inheritanceDT + )] + + # Match to functions in package + mbodyDT[!grepl('(^self\\$|^private\\$)', SYMBOL) + & is.na(MATCH) + & SYMBOL %in% pkg_functions + , MATCH := SYMBOL + ] + + if (nrow(mbodyDT[!is.na(MATCH)]) == 0) { + 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 . So fname depends on . + # So fname is TARGET and are SOURCEs + edgeDT <- data.table::data.table( + SOURCE = unique(mbodyDT[!is.na(MATCH), MATCH]) + , TARGET = paste(class_name, method_type, method_name, sep = "$") + ) + + return(edgeDT) +} + +.match_R6_methods <- function(symbol_name, class_name, methodsDT, inheritanceDT) { + # Check if symbol matches method in this class + splitSymbol <- unlist(strsplit(symbol_name, split = "$", fixed = TRUE)) + if (splitSymbol[1] == "self") { + out <- methodsDT[CLASS_NAME == class_name + & METHOD_TYPE %in% c("public_methods", "active") + & splitSymbol[2] == METHOD_NAME + , paste(CLASS_NAME, METHOD_TYPE, METHOD_NAME, sep = "$") + ] + } else { + out <- methodsDT[CLASS_NAME == class_name + & METHOD_TYPE == "private_methods" + & splitSymbol[2] == METHOD_NAME + , paste(CLASS_NAME, METHOD_TYPE, METHOD_NAME, sep = "$") + ] + } + + # Above returns character(0) if not matched. Convert to NA_character + if (identical(out, character(0))) { + out <- NA_character_ + } + + # Not not matched, try parent if there is one and it is in package + if (is.na(out) + && inheritanceDT[CLASS_NAME == class_name + , !is.na(PARENT_NAME) && PARENT_IN_PKG]) { + out <- .match_R6_methods( + symbol_name + , inheritanceDT[CLASS_NAME == class_name, PARENT_NAME] + , methodsDT + , inheritanceDT + ) + } + + return(out) +} + +.parse_R6_expression <- function(x) { + + # If expression x isnot an atomic type or symbol (i.e., name of object) + # then we can break x up into components + listable <- (!is.atomic(x) && !is.symbol(x)) + if (!is.list(x) && listable) { + xList <- as.list(x) + + # Check if expression x is of form self$foo or private$foo + if (identical(xList[[1]], quote(`$`)) + && (identical(xList[[2]], quote(self)) + || identical(xList[[2]], quote(private))) + ) { + listable <- FALSE + } else { + x <- xList + } + } + + if (listable){ + out <- unlist(lapply(x, .parse_R6_expression), use.names = FALSE) + } else { + out <- paste(deparse(x), collapse = "\n") + } + return(out) +} + From 6e72a865eac659636c82dbcfd2b244ae6b44443b Mon Sep 17 00:00:00 2001 From: Jay Qi Date: Sun, 11 Nov 2018 10:57:55 -0600 Subject: [PATCH 02/10] Support for super$ edges; added milne test package for R6 --- R/PackageFunctionReporter.R | 65 ++++++++++++++++--- inst/milne/DESCRIPTION | 13 ++++ inst/milne/LICENSE | 1 + inst/milne/NAMESPACE | 2 + inst/milne/R/The_End.R | 40 ++++++++++++ inst/milne/tests/testthat.R | 12 ++++ .../tests/testthat/test-batting_statistics.R | 6 ++ 7 files changed, 131 insertions(+), 8 deletions(-) create mode 100644 inst/milne/DESCRIPTION create mode 100644 inst/milne/LICENSE create mode 100644 inst/milne/NAMESPACE create mode 100644 inst/milne/R/The_End.R create mode 100644 inst/milne/tests/testthat.R create mode 100644 inst/milne/tests/testthat/test-batting_statistics.R diff --git a/R/PackageFunctionReporter.R b/R/PackageFunctionReporter.R index f7840160..fa2dc54d 100644 --- a/R/PackageFunctionReporter.R +++ b/R/PackageFunctionReporter.R @@ -413,14 +413,27 @@ FunctionReporter <- R6::R6Class( # Match to R6 methods mbodyDT[grepl('(^self\\$|^private\\$)', SYMBOL) - , MATCH := vapply(SYMBOL - , FUN = .match_R6_methods + , MATCH := vapply(X = SYMBOL + , FUN = .match_R6_class_methods , FUN.VALUE = character(1) , class_name = class_name , methodsDT = methodsDT , inheritanceDT = inheritanceDT )] + # Match to R6 superclass methods. This has a different recursion strategy + mbodyDT[grepl('(^super\\$)', SYMBOL) + , MATCH := vapply(X = unlist(strsplit( + SYMBOL, split = "$", fixed = TRUE + ))[[2]] + , FUN = .match_R6_super_methods + , FUN.VALUE = character(1) + , parent_name = inheritanceDT[CLASS_NAME == class_name + , PARENT_NAME] + , methodsDT = methodsDT + , inheritanceDT = inheritanceDT + )] + # Match to functions in package mbodyDT[!grepl('(^self\\$|^private\\$)', SYMBOL) & is.na(MATCH) @@ -444,16 +457,17 @@ FunctionReporter <- R6::R6Class( return(edgeDT) } -.match_R6_methods <- function(symbol_name, class_name, methodsDT, inheritanceDT) { +.match_R6_class_methods <- function(symbol_name, class_name, methodsDT, inheritanceDT) { # Check if symbol matches method in this class splitSymbol <- unlist(strsplit(symbol_name, split = "$", fixed = TRUE)) + assertthat::assert_that(splitSymbol[1] %in% c('self', 'private')) if (splitSymbol[1] == "self") { out <- methodsDT[CLASS_NAME == class_name & METHOD_TYPE %in% c("public_methods", "active") & splitSymbol[2] == METHOD_NAME , paste(CLASS_NAME, METHOD_TYPE, METHOD_NAME, sep = "$") ] - } else { + } else if (splitSymbol[1] == "private") { out <- methodsDT[CLASS_NAME == class_name & METHOD_TYPE == "private_methods" & splitSymbol[2] == METHOD_NAME @@ -470,7 +484,7 @@ FunctionReporter <- R6::R6Class( if (is.na(out) && inheritanceDT[CLASS_NAME == class_name , !is.na(PARENT_NAME) && PARENT_IN_PKG]) { - out <- .match_R6_methods( + out <- .match_R6_class_methods( symbol_name , inheritanceDT[CLASS_NAME == class_name, PARENT_NAME] , methodsDT @@ -481,18 +495,53 @@ FunctionReporter <- R6::R6Class( return(out) } +# super$method_name calls don't specify public, private, or active +# We have to search all three for a parent class before moving up +# to the next parent class. Luckily, within one class definition you're not allowed +# to name things the same. +.match_R6_super_methods <- function(method_name, parent_name, methodsDT, inheritanceDT) { + + out <- methodsDT[CLASS_NAME == parent_name + & method_name == METHOD_NAME + , paste(CLASS_NAME, METHOD_TYPE, METHOD_NAME, sep = "$") + ] + + # Above returns character(0) if not matched. Convert to NA_character + if (identical(out, character(0))) { + out <- NA_character_ + } + + # If not matched, try parent if there is one and it is in package + if (is.na(out) + && inheritanceDT[CLASS_NAME == parent_name + , !is.na(PARENT_NAME) && PARENT_IN_PKG]) { + out <- .match_R6_super_methods( + method_name + , inheritanceDT[CLASS_NAME == parent_name, PARENT_NAME] + , methodsDT + , inheritanceDT + ) + } + + return(out) +} + .parse_R6_expression <- function(x) { - # If expression x isnot an atomic type or symbol (i.e., name of object) + # If expression x is not an atomic type or symbol (i.e., name of object) # then we can break x up into components + listable <- (!is.atomic(x) && !is.symbol(x)) + if (!is.list(x) && listable) { xList <- as.list(x) - # Check if expression x is of form self$foo or private$foo + # Check if expression x is of form self$foo, private$foo, or super$foo if (identical(xList[[1]], quote(`$`)) && (identical(xList[[2]], quote(self)) - || identical(xList[[2]], quote(private))) + || identical(xList[[2]], quote(private)) + || identical(xList[[2]], quote(super)) + ) ) { listable <- FALSE } else { diff --git a/inst/milne/DESCRIPTION b/inst/milne/DESCRIPTION new file mode 100644 index 00000000..9f476429 --- /dev/null +++ b/inst/milne/DESCRIPTION @@ -0,0 +1,13 @@ +Package: milne +Type: Package +Title: Now We Are Six +Version: 6.0 +Author: Uptake Data Science +Authors@R: c( + person("Jay", "Qi", email = "jay.qi@uptake.com", role = c("aut", "cre")) + ) +Maintainer: Jay Qi +Description: This package is used to test the functions in `pkgnet`. So I think I'll be six now for ever and ever. +License: file LICENSE +LazyData: TRUE +RoxygenNote: 6.1.1 diff --git a/inst/milne/LICENSE b/inst/milne/LICENSE new file mode 100644 index 00000000..d73603e3 --- /dev/null +++ b/inst/milne/LICENSE @@ -0,0 +1 @@ +this is a test package diff --git a/inst/milne/NAMESPACE b/inst/milne/NAMESPACE new file mode 100644 index 00000000..6ae92683 --- /dev/null +++ b/inst/milne/NAMESPACE @@ -0,0 +1,2 @@ +# Generated by roxygen2: do not edit by hand + diff --git a/inst/milne/R/The_End.R b/inst/milne/R/The_End.R new file mode 100644 index 00000000..053f8cca --- /dev/null +++ b/inst/milne/R/The_End.R @@ -0,0 +1,40 @@ +Four <- R6::R6Class( + "Four", + public = list( + when_i_was_four = function() {"I was not much more"} + ), + private = list( + more_level = function() {"not much"} + ) +) + +Five <- R6::R6Class( + "Five", + inherit = Four, + public = list( + when_i_was_five = function() {"I was just alive"} + ), + private = list( + ) +) + +Six <- R6::R6Class( + "Six", + inherit = Five, + public = list( + now_i_am_six = function() { + sprintf("I'm as %s as ever", .clever()) + }, + last_time = function() {self$when_i_was_five()} + ), + private = list( + more_level = function() { + gsub("not ", "", super$more_level()) + } + ) +) + +.clever <- function() { + "clever" +} + diff --git a/inst/milne/tests/testthat.R b/inst/milne/tests/testthat.R new file mode 100644 index 00000000..55e1a2cb --- /dev/null +++ b/inst/milne/tests/testthat.R @@ -0,0 +1,12 @@ +# Note that you would never run this file directly. This is used by tools::testInstallPackages() +# and other packages like covr. +# To actually run the tests, you need to set the working directory then run +# devtools::test('milne') + +# This line ensures that R CMD check can run tests. +# See https://github.com/hadley/testthat/issues/144 +Sys.setenv("R_TESTS" = "") + +library(milne) + +testthat::test_check('milne') diff --git a/inst/milne/tests/testthat/test-batting_statistics.R b/inst/milne/tests/testthat/test-batting_statistics.R new file mode 100644 index 00000000..31f2b780 --- /dev/null +++ b/inst/milne/tests/testthat/test-batting_statistics.R @@ -0,0 +1,6 @@ + + +test_that('at_bats runs end-to-end', expect_true({ + AB <- at_bats(c('bb', 'k', '1b', 'hr')) + TRUE +})) \ No newline at end of file From b81b4ff73ec2a5833248c6906be7319850596818 Mon Sep 17 00:00:00 2001 From: Jay Qi Date: Mon, 12 Nov 2018 09:22:32 -0600 Subject: [PATCH 03/10] Added comments/docs --- R/PackageFunctionReporter.R | 60 ++++++++++++++++--- inst/milne/DESCRIPTION | 5 ++ inst/milne/NAMESPACE | 4 ++ inst/milne/R/The_End.R | 22 ++++++- inst/milne/man/Five.Rd | 18 ++++++ inst/milne/man/Four.Rd | 18 ++++++ inst/milne/man/Six.Rd | 18 ++++++ .../tests/testthat/test-batting_statistics.R | 6 -- inst/milne/tests/testthat/test_The_End.R | 14 +++++ 9 files changed, 149 insertions(+), 16 deletions(-) create mode 100644 inst/milne/man/Five.Rd create mode 100644 inst/milne/man/Four.Rd create mode 100644 inst/milne/man/Six.Rd delete mode 100644 inst/milne/tests/testthat/test-batting_statistics.R create mode 100644 inst/milne/tests/testthat/test_The_End.R diff --git a/R/PackageFunctionReporter.R b/R/PackageFunctionReporter.R index fa2dc54d..f941b800 100644 --- a/R/PackageFunctionReporter.R +++ b/R/PackageFunctionReporter.R @@ -344,22 +344,32 @@ FunctionReporter <- R6::R6Class( # [description] parse out a function's body into a character # vector separating the individual symbols .parse_function <- function (x) { - + # If expression x is not an atomic value or symbol (i.e., name of object) or + # an environment pointer then we can break x up into list of components listable <- (!is.atomic(x) && !is.symbol(x) && !is.environment(x)) - if (!is.list(x) && listable) { x <- as.list(x) } if (listable){ + # Filter out atomic values because we don't care about them + x <- Filter(f = Negate(is.atomic), x = x) + + # Parse each listed expression recursively until + # they can't be listed anymore out <- unlist(lapply(x, .parse_function), use.names = FALSE) } else { + + # If not listable, deparse into a character string out <- paste(deparse(x), collapse = "\n") } return(out) } - +# [description] given an R6 class, returns a data.table +# enumerating all of its public, active binding, and private methods +#' @importFrom assertthat assert_that +#' @importFrom R6 is.R6Class .get_R6_class_methods <- function(thisClass) { assertthat::assert_that( R6::is.R6Class(thisClass) @@ -380,6 +390,9 @@ FunctionReporter <- R6::R6Class( return(methodsDT) } +# [description] given a list of R6 class names and the associated package +# environment, return a data.table of their parent classes +#' @importFrom data.table rbindlist .get_R6_class_inheritance <- function(class_names, pkg_name, pkg_env) { inheritanceDT <- data.table::rbindlist(lapply( X = class_names @@ -394,7 +407,9 @@ FunctionReporter <- R6::R6Class( )) } - +# [description] given an R6 method, parse its body and find all +# dependencies that it calls, returning as a pkgnet edge data.table +#' @importFrom data.table data.table .determine_R6_dependencies <- function(method_name , method_type , class_name @@ -457,6 +472,11 @@ FunctionReporter <- R6::R6Class( return(edgeDT) } + +# [description] given a symbol name that is an R6 internal reference +# (self$x or private$x), match to a provided data.table of known R6 methods. +# Searches up inheritance tree. +#' @importFrom asserthat assert_that .match_R6_class_methods <- function(symbol_name, class_name, methodsDT, inheritanceDT) { # Check if symbol matches method in this class splitSymbol <- unlist(strsplit(symbol_name, split = "$", fixed = TRUE)) @@ -492,13 +512,23 @@ FunctionReporter <- R6::R6Class( ) } + # We should only have at most one match + assertthat::assert_that( + assertthat::is.string(out) + ) + return(out) } -# super$method_name calls don't specify public, private, or active -# We have to search all three for a parent class before moving up + +# [description] given a symbol name that is an internal reference to a superclass +# method (super$), match to a provided data.table of known R6 methods +# by checking searching ancestor classes. We need this as a separate function because +# super$method_name calls don't specify public, private, or active. +# So we have to search all three for a parent class before moving up # to the next parent class. Luckily, within one class definition you're not allowed -# to name things the same. +# to name things the same so we should only have one result. +#' @importFrom asserthat assert_that is.string .match_R6_super_methods <- function(method_name, parent_name, methodsDT, inheritanceDT) { out <- methodsDT[CLASS_NAME == parent_name @@ -523,13 +553,21 @@ FunctionReporter <- R6::R6Class( ) } + # We should only have at most one match + assertthat::assert_that( + assertthat::is.string(out) + ) + return(out) } + +# [description] parses R6 expressions into a character vector of symbols and atomic +# values. Will not break up expressions of form self$foo, private$foo, or super$foo .parse_R6_expression <- function(x) { # If expression x is not an atomic type or symbol (i.e., name of object) - # then we can break x up into components + # then we can break x up into list of components listable <- (!is.atomic(x) && !is.symbol(x)) @@ -550,8 +588,14 @@ FunctionReporter <- R6::R6Class( } if (listable){ + # Filter out atomic values because we don't care about them + x <- Filter(f = Negate(is.atomic), x = x) + + # Parse each listed expression recursively until + # they can't be listed anymore out <- unlist(lapply(x, .parse_R6_expression), use.names = FALSE) } else { + # If not listable, deparse into a character string out <- paste(deparse(x), collapse = "\n") } return(out) diff --git a/inst/milne/DESCRIPTION b/inst/milne/DESCRIPTION index 9f476429..c495f5ed 100644 --- a/inst/milne/DESCRIPTION +++ b/inst/milne/DESCRIPTION @@ -8,6 +8,11 @@ Authors@R: c( ) Maintainer: Jay Qi Description: This package is used to test the functions in `pkgnet`. So I think I'll be six now for ever and ever. +Imports: + R6 +Suggests: + covr, + testthat License: file LICENSE LazyData: TRUE RoxygenNote: 6.1.1 diff --git a/inst/milne/NAMESPACE b/inst/milne/NAMESPACE index 6ae92683..2464cc2a 100644 --- a/inst/milne/NAMESPACE +++ b/inst/milne/NAMESPACE @@ -1,2 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(Five) +export(Four) +export(Six) +importFrom(R6,R6Class) diff --git a/inst/milne/R/The_End.R b/inst/milne/R/The_End.R index 053f8cca..9e7df65f 100644 --- a/inst/milne/R/The_End.R +++ b/inst/milne/R/The_End.R @@ -1,3 +1,9 @@ +#' @title Age Four +#' @name Four +#' @family TheEnd +#' @description Age Four +#' @importFrom R6 R6Class +#' @export Four <- R6::R6Class( "Four", public = list( @@ -8,6 +14,12 @@ Four <- R6::R6Class( ) ) +#' @title Age Five +#' @name Five +#' @family TheEnd +#' @description Age Five +#' @importFrom R6 R6Class +#' @export Five <- R6::R6Class( "Five", inherit = Four, @@ -18,12 +30,18 @@ Five <- R6::R6Class( ) ) +#' @title Age Six +#' @name Six +#' @family TheEnd +#' @description Age Six +#' @importFrom R6 R6Class +#' @export Six <- R6::R6Class( "Six", inherit = Five, public = list( now_i_am_six = function() { - sprintf("I'm as %s as ever", .clever()) + sprintf("I'm as %s as clever", .clever()) }, last_time = function() {self$when_i_was_five()} ), @@ -34,7 +52,7 @@ Six <- R6::R6Class( ) ) +# [description] internal function .clever <- function() { "clever" } - diff --git a/inst/milne/man/Five.Rd b/inst/milne/man/Five.Rd new file mode 100644 index 00000000..2b906016 --- /dev/null +++ b/inst/milne/man/Five.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/The_End.R +\docType{data} +\name{Five} +\alias{Five} +\title{Age Five} +\format{An object of class \code{R6ClassGenerator} of length 24.} +\usage{ +Five +} +\description{ +Age Five +} +\seealso{ +Other TheEnd: \code{\link{Four}}, \code{\link{Six}} +} +\concept{TheEnd} +\keyword{datasets} diff --git a/inst/milne/man/Four.Rd b/inst/milne/man/Four.Rd new file mode 100644 index 00000000..7666105c --- /dev/null +++ b/inst/milne/man/Four.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/The_End.R +\docType{data} +\name{Four} +\alias{Four} +\title{Age Four} +\format{An object of class \code{R6ClassGenerator} of length 24.} +\usage{ +Four +} +\description{ +Age Four +} +\seealso{ +Other TheEnd: \code{\link{Five}}, \code{\link{Six}} +} +\concept{TheEnd} +\keyword{datasets} diff --git a/inst/milne/man/Six.Rd b/inst/milne/man/Six.Rd new file mode 100644 index 00000000..7ee8f43c --- /dev/null +++ b/inst/milne/man/Six.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/The_End.R +\docType{data} +\name{Six} +\alias{Six} +\title{Age Six} +\format{An object of class \code{R6ClassGenerator} of length 24.} +\usage{ +Six +} +\description{ +Age Six +} +\seealso{ +Other TheEnd: \code{\link{Five}}, \code{\link{Four}} +} +\concept{TheEnd} +\keyword{datasets} diff --git a/inst/milne/tests/testthat/test-batting_statistics.R b/inst/milne/tests/testthat/test-batting_statistics.R deleted file mode 100644 index 31f2b780..00000000 --- a/inst/milne/tests/testthat/test-batting_statistics.R +++ /dev/null @@ -1,6 +0,0 @@ - - -test_that('at_bats runs end-to-end', expect_true({ - AB <- at_bats(c('bb', 'k', '1b', 'hr')) - TRUE -})) \ No newline at end of file diff --git a/inst/milne/tests/testthat/test_The_End.R b/inst/milne/tests/testthat/test_The_End.R new file mode 100644 index 00000000..7951589f --- /dev/null +++ b/inst/milne/tests/testthat/test_The_End.R @@ -0,0 +1,14 @@ +test_that('Four class can be sucessfully intialized', expect_true({ + myObj <- Four$new() + R6::is.R6(myObj) +})) + +test_that('Five class can be sucessfully intialized', expect_true({ + myObj <- Five$new() + R6::is.R6(myObj) +})) + +test_that('Six class can be sucessfully intialized', expect_true({ + myObj <- Six$new() + R6::is.R6(myObj) +})) \ No newline at end of file From f5f89807e04eeec3856b9b0940930bed8cac26e3 Mon Sep 17 00:00:00 2001 From: Jay Qi Date: Fri, 16 Nov 2018 20:19:26 -0600 Subject: [PATCH 04/10] R6 unit tests --- .gitignore | 5 - R/testing_utils.R | 1 + inst/milne/NAMESPACE | 3 + inst/milne/R/The_End.R | 103 +++++++++++++++++--- inst/milne/man/Five.Rd | 3 +- inst/milne/man/Four.Rd | 3 +- inst/milne/man/One.Rd | 19 ++++ inst/milne/man/Six.Rd | 3 +- inst/milne/man/Three.Rd | 19 ++++ inst/milne/man/Two.Rd | 19 ++++ tests/testthat.R | 2 +- tests/testthat/teardown_setTestEnv.R | 2 +- tests/testthat/test-functional_structure.R | 104 +++++++++++++-------- tests/testthat/testdata/milne_edges.csv | 9 ++ tests/testthat/testdata/milne_nodes.csv | 18 ++++ 15 files changed, 251 insertions(+), 62 deletions(-) create mode 100644 inst/milne/man/One.Rd create mode 100644 inst/milne/man/Three.Rd create mode 100644 inst/milne/man/Two.Rd create mode 100644 tests/testthat/testdata/milne_edges.csv create mode 100644 tests/testthat/testdata/milne_nodes.csv diff --git a/.gitignore b/.gitignore index b8cfcfdb..76003502 100644 --- a/.gitignore +++ b/.gitignore @@ -5,11 +5,6 @@ tests/testthat/Rplots.pdf **/.DS_Store -# data files -**/*.rds -**/*.rda -**/*.csv - # build artifacts **/*.tar.gz pkgnet.Rcheck/* diff --git a/R/testing_utils.R b/R/testing_utils.R index db52727d..fa541e42 100644 --- a/R/testing_utils.R +++ b/R/testing_utils.R @@ -28,6 +28,7 @@ pkgList <- c( baseballstats = file.path(pkgnetSourcePath, "inst", "baseballstats") , sartre = file.path(pkgnetSourcePath, "inst", "sartre") + , milne = file.path(pkgnetSourcePath, "inst", "milne") , pkgnet = pkgnetSourcePath ) diff --git a/inst/milne/NAMESPACE b/inst/milne/NAMESPACE index 2464cc2a..50c2834e 100644 --- a/inst/milne/NAMESPACE +++ b/inst/milne/NAMESPACE @@ -2,5 +2,8 @@ export(Five) export(Four) +export(One) export(Six) +export(Three) +export(Two) importFrom(R6,R6Class) diff --git a/inst/milne/R/The_End.R b/inst/milne/R/The_End.R index 9e7df65f..9391ee77 100644 --- a/inst/milne/R/The_End.R +++ b/inst/milne/R/The_End.R @@ -1,3 +1,65 @@ +#' @title Age One +#' @name One +#' @family TheEnd +#' @description Age One +#' @importFrom R6 R6Class +#' @export +One <- R6::R6Class( + "One", + public = list( + initialize = function() { + cat("The End, by A. A. Milne") + }, + print_poem = function() { + cat("When I was One, \n", + "I had just begun. \n" + ) + }, + how_old_am_i = function() {private$get_age()} + ), + private = list( + get_age = function() {.classname(self)} + ) +) + +#' @title Age Two +#' @name Two +#' @family TheEnd +#' @description Age Two +#' @importFrom R6 R6Class +#' @export +Two <- R6::R6Class( + "Two", + inherit = One, + public = list( + print_poem = function() { + super$print_poem() + cat("When I was Two, \n", + "I was nearly new. \n" + ) + } + ) +) + +#' @title Age Three +#' @name Three +#' @family TheEnd +#' @description Age Three +#' @importFrom R6 R6Class +#' @export +Three <- R6::R6Class( + "Three", + inherit = Two, + public = list( + print_poem = function() { + super$print_poem() + cat("When I was Three, \n", + "I was hardly me. \n" + ) + } + ) +) + #' @title Age Four #' @name Four #' @family TheEnd @@ -6,11 +68,14 @@ #' @export Four <- R6::R6Class( "Four", + inherit = Three, public = list( - when_i_was_four = function() {"I was not much more"} - ), - private = list( - more_level = function() {"not much"} + print_poem = function() { + super$print_poem() + cat("When I was Four, \n", + "I was not much more. \n" + ) + } ) ) @@ -24,7 +89,12 @@ Five <- R6::R6Class( "Five", inherit = Four, public = list( - when_i_was_five = function() {"I was just alive"} + print_poem = function() { + super$print_poem() + cat("When I was Five, \n", + "I was just alive. \n" + ) + } ), private = list( ) @@ -40,19 +110,26 @@ Six <- R6::R6Class( "Six", inherit = Five, public = list( - now_i_am_six = function() { - sprintf("I'm as %s as clever", .clever()) - }, - last_time = function() {self$when_i_was_five()} + print_poem = function() { + super$print_poem() + cat("When I was Six, \n", + "I'm as clever as clever. \n" + ) + private$print_ending() + } ), private = list( - more_level = function() { - gsub("not ", "", super$more_level()) + print_ending = function() { + cat("So I think I'll be Six now, \n", + "Forever and ever." + ) } ) ) # [description] internal function -.clever <- function() { - "clever" +.classname <- function(obj) { + class(obj)[1] } + + diff --git a/inst/milne/man/Five.Rd b/inst/milne/man/Five.Rd index 2b906016..c39c415a 100644 --- a/inst/milne/man/Five.Rd +++ b/inst/milne/man/Five.Rd @@ -12,7 +12,8 @@ Five Age Five } \seealso{ -Other TheEnd: \code{\link{Four}}, \code{\link{Six}} +Other TheEnd: \code{\link{Four}}, \code{\link{One}}, + \code{\link{Six}}, \code{\link{Three}}, \code{\link{Two}} } \concept{TheEnd} \keyword{datasets} diff --git a/inst/milne/man/Four.Rd b/inst/milne/man/Four.Rd index 7666105c..d41179bc 100644 --- a/inst/milne/man/Four.Rd +++ b/inst/milne/man/Four.Rd @@ -12,7 +12,8 @@ Four Age Four } \seealso{ -Other TheEnd: \code{\link{Five}}, \code{\link{Six}} +Other TheEnd: \code{\link{Five}}, \code{\link{One}}, + \code{\link{Six}}, \code{\link{Three}}, \code{\link{Two}} } \concept{TheEnd} \keyword{datasets} diff --git a/inst/milne/man/One.Rd b/inst/milne/man/One.Rd new file mode 100644 index 00000000..8d227d54 --- /dev/null +++ b/inst/milne/man/One.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/The_End.R +\docType{data} +\name{One} +\alias{One} +\title{Age One} +\format{An object of class \code{R6ClassGenerator} of length 24.} +\usage{ +One +} +\description{ +Age One +} +\seealso{ +Other TheEnd: \code{\link{Five}}, \code{\link{Four}}, + \code{\link{Six}}, \code{\link{Three}}, \code{\link{Two}} +} +\concept{TheEnd} +\keyword{datasets} diff --git a/inst/milne/man/Six.Rd b/inst/milne/man/Six.Rd index 7ee8f43c..5baae338 100644 --- a/inst/milne/man/Six.Rd +++ b/inst/milne/man/Six.Rd @@ -12,7 +12,8 @@ Six Age Six } \seealso{ -Other TheEnd: \code{\link{Five}}, \code{\link{Four}} +Other TheEnd: \code{\link{Five}}, \code{\link{Four}}, + \code{\link{One}}, \code{\link{Three}}, \code{\link{Two}} } \concept{TheEnd} \keyword{datasets} diff --git a/inst/milne/man/Three.Rd b/inst/milne/man/Three.Rd new file mode 100644 index 00000000..c6a5d574 --- /dev/null +++ b/inst/milne/man/Three.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/The_End.R +\docType{data} +\name{Three} +\alias{Three} +\title{Age Three} +\format{An object of class \code{R6ClassGenerator} of length 24.} +\usage{ +Three +} +\description{ +Age Three +} +\seealso{ +Other TheEnd: \code{\link{Five}}, \code{\link{Four}}, + \code{\link{One}}, \code{\link{Six}}, \code{\link{Two}} +} +\concept{TheEnd} +\keyword{datasets} diff --git a/inst/milne/man/Two.Rd b/inst/milne/man/Two.Rd new file mode 100644 index 00000000..65cafb21 --- /dev/null +++ b/inst/milne/man/Two.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/The_End.R +\docType{data} +\name{Two} +\alias{Two} +\title{Age Two} +\format{An object of class \code{R6ClassGenerator} of length 24.} +\usage{ +Two +} +\description{ +Age Two +} +\seealso{ +Other TheEnd: \code{\link{Five}}, \code{\link{Four}}, + \code{\link{One}}, \code{\link{Six}}, \code{\link{Three}} +} +\concept{TheEnd} +\keyword{datasets} diff --git a/tests/testthat.R b/tests/testthat.R index 81684475..fbe211fa 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -60,7 +60,7 @@ if (Sys.getenv('PKGNET_REBUILD')){ # Uninstall Fake Packages From Test Library if Not Already Uninstalled try( utils::remove.packages( - pkgs = c('baseballstats', 'sartre', 'pkgnet') + pkgs = c('baseballstats', 'sartre', 'milne', 'pkgnet') , lib = Sys.getenv('PKGNET_TEST_LIB') ) ) diff --git a/tests/testthat/teardown_setTestEnv.R b/tests/testthat/teardown_setTestEnv.R index b15aef5f..1892febc 100644 --- a/tests/testthat/teardown_setTestEnv.R +++ b/tests/testthat/teardown_setTestEnv.R @@ -3,7 +3,7 @@ # Uninstall Fake Packages From Test Library if Not Already Uninstalled try( utils::remove.packages( - pkgs = c('baseballstats', 'sartre', 'pkgnet') + pkgs = c('baseballstats', 'sartre', 'milne', 'pkgnet') , lib = Sys.getenv('PKGNET_TEST_LIB') ) ) diff --git a/tests/testthat/test-functional_structure.R b/tests/testthat/test-functional_structure.R index dd37b05f..ddb9e674 100644 --- a/tests/testthat/test-functional_structure.R +++ b/tests/testthat/test-functional_structure.R @@ -18,46 +18,48 @@ futile.logger::flog.threshold(0) # Note: Packages 'baseballstats' and 'sartre' are installed by Travis CI before testing # and uninstalled after testing. If running these tests locallaly. - test_that('test packages installed alright',{ - expect_true(object = require("baseballstats" - , lib.loc = Sys.getenv('PKGNET_TEST_LIB') - ) - , info = "Fake test package baseballstats is not installed.") - - expect_true(object = require("sartre" - , lib.loc = Sys.getenv('PKGNET_TEST_LIB') - ) - , info = "Fake test package sartre is not installed") - }) - - test_that('FunctionReporter returns graph of functions', { - reporter <- FunctionReporter$new() - reporter$set_package(pkg_name = "baseballstats") - - # Nodes - expect_equivalent(object = sort(reporter$nodes$node) - , expected = sort(as.character(unlist(utils::lsf.str(asNamespace(reporter$pkg_name))))) - , info = "All functions are nodes, even ones without connections.") - - expect_true(object = is.element("node", names(reporter$nodes)) - , info = "Node column created") - - expect_s3_class(object = reporter$nodes - , class = "data.table") - - # Edges - expect_s3_class(object = reporter$edges - , class = "data.table") - - expect_true(object = all(c("TARGET", "SOURCE") %in% names(reporter$edges)) - , info = "TARGET and SCORE fields in edge table at minimum") +test_that('test packages installed correctly',{ + + testPkgNames <- c("baseballstats", "sartre", "milne") + + for (thisTestPkg in testPkgNames) { + expect_true( + object = require(thisTestPkg + , lib.loc = Sys.getenv('PKGNET_TEST_LIB') + , character.only = TRUE) + , info = sprintf("Fake test package %s is not installed.", thisTestPkg) + ) + } +}) - # Plots - expect_true(object = is.element("visNetwork", attributes(reporter$graph_viz))) - - }) +test_that('FunctionReporter returns graph of functions', { + reporter <- FunctionReporter$new() + reporter$set_package(pkg_name = "baseballstats") + + # Nodes + expect_equivalent(object = sort(reporter$nodes$node) + , expected = sort(as.character(unlist(utils::lsf.str(asNamespace(reporter$pkg_name))))) + , info = "All functions are nodes, even ones without connections.") + + expect_true(object = is.element("node", names(reporter$nodes)) + , info = "Node column created") + + expect_s3_class(object = reporter$nodes + , class = "data.table") + + # Edges + expect_s3_class(object = reporter$edges + , class = "data.table") + + expect_true(object = all(c("TARGET", "SOURCE") %in% names(reporter$edges)) + , info = "TARGET and SCORE fields in edge table at minimum") + + # Plots + expect_true(object = is.element("visNetwork", attributes(reporter$graph_viz))) + +}) - test_that('FunctionReporter works on edge case one function', { +test_that('FunctionReporter works on edge case one function', { t2 <- FunctionReporter$new() t2$set_package('sartre') @@ -73,7 +75,31 @@ futile.logger::flog.threshold(0) expect_true(object = is.element("visNetwork", attributes(t2$graph_viz))) - }) +}) + +test_that('FunctionReporter works with R6 classes', { + reporter <- FunctionReporter$new() + reporter$set_package('milne') + + # Test nodes + expect_equivalent( + object = reporter$nodes + , expected = data.table::fread(file.path('testdata/milne_nodes.csv')) + , ignore.col.order = TRUE + , ignore.row.order = TRUE + ) + + # Test edges + expect_equivalent( + object = reporter$edges + , expected = data.table::fread(file.path('testdata/milne_edges.csv')) + , ignore.col.order = TRUE + , ignore.row.order = TRUE + ) + + # Test viz + expect_true(object = is.element("visNetwork", attributes(reporter$graph_viz))) +}) ##### TEST TEAR DOWN ##### diff --git a/tests/testthat/testdata/milne_edges.csv b/tests/testthat/testdata/milne_edges.csv new file mode 100644 index 00000000..c863a9ca --- /dev/null +++ b/tests/testthat/testdata/milne_edges.csv @@ -0,0 +1,9 @@ +SOURCE,TARGET +One$public_methods$print_poem,Two$public_methods$print_poem +Two$public_methods$print_poem,Three$public_methods$print_poem +Three$public_methods$print_poem,Four$public_methods$print_poem +Four$public_methods$print_poem,Five$public_methods$print_poem +One$private_methods$get_age,One$public_methods$how_old_am_i +.classname,One$private_methods$get_age +Five$public_methods$print_poem,Six$public_methods$print_poem +Six$private_methods$print_ending,Six$public_methods$print_poem diff --git a/tests/testthat/testdata/milne_nodes.csv b/tests/testthat/testdata/milne_nodes.csv new file mode 100644 index 00000000..a71106cf --- /dev/null +++ b/tests/testthat/testdata/milne_nodes.csv @@ -0,0 +1,18 @@ +node,type,isExported +.classname,function,FALSE +Two$public_methods$print_poem,R6 method,TRUE +Two$public_methods$clone,R6 method,TRUE +Three$public_methods$print_poem,R6 method,TRUE +Three$public_methods$clone,R6 method,TRUE +Four$public_methods$print_poem,R6 method,TRUE +Four$public_methods$clone,R6 method,TRUE +Five$public_methods$print_poem,R6 method,TRUE +Five$public_methods$clone,R6 method,TRUE +One$public_methods$initialize,R6 method,TRUE +One$public_methods$print_poem,R6 method,TRUE +One$public_methods$how_old_am_i,R6 method,TRUE +One$public_methods$clone,R6 method,TRUE +One$private_methods$get_age,R6 method,TRUE +Six$public_methods$print_poem,R6 method,TRUE +Six$public_methods$clone,R6 method,TRUE +Six$private_methods$print_ending,R6 method,TRUE From c8629663485ae2262b3f538dbab874830bd88860 Mon Sep 17 00:00:00 2001 From: Jay Qi Date: Sat, 17 Nov 2018 13:40:52 -0600 Subject: [PATCH 05/10] Import typo --- R/PackageFunctionReporter.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/PackageFunctionReporter.R b/R/PackageFunctionReporter.R index f941b800..34f7c0eb 100644 --- a/R/PackageFunctionReporter.R +++ b/R/PackageFunctionReporter.R @@ -476,7 +476,7 @@ FunctionReporter <- R6::R6Class( # [description] given a symbol name that is an R6 internal reference # (self$x or private$x), match to a provided data.table of known R6 methods. # Searches up inheritance tree. -#' @importFrom asserthat assert_that +#' @importFrom assertthat assert_that .match_R6_class_methods <- function(symbol_name, class_name, methodsDT, inheritanceDT) { # Check if symbol matches method in this class splitSymbol <- unlist(strsplit(symbol_name, split = "$", fixed = TRUE)) @@ -528,7 +528,7 @@ FunctionReporter <- R6::R6Class( # So we have to search all three for a parent class before moving up # to the next parent class. Luckily, within one class definition you're not allowed # to name things the same so we should only have one result. -#' @importFrom asserthat assert_that is.string +#' @importFrom assertthat assert_that is.string .match_R6_super_methods <- function(method_name, parent_name, methodsDT, inheritanceDT) { out <- methodsDT[CLASS_NAME == parent_name From 7ad3cd70e4cf7a04abbdb6dab35015fd1e19f19d Mon Sep 17 00:00:00 2001 From: Jay Qi Date: Sat, 17 Nov 2018 13:47:20 -0600 Subject: [PATCH 06/10] .gitignore data files in top level dir only --- .gitignore | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 76003502..f7f853c6 100644 --- a/.gitignore +++ b/.gitignore @@ -1,10 +1,14 @@ - # Misc files .Rhistory *.Rproj tests/testthat/Rplots.pdf **/.DS_Store +# data files +/*.rds +/*.rda +/*.csv + # build artifacts **/*.tar.gz pkgnet.Rcheck/* From 1985584fc6a78820cb426b31acacedcf4fe2b7df Mon Sep 17 00:00:00 2001 From: Jay Qi Date: Sat, 17 Nov 2018 15:16:49 -0600 Subject: [PATCH 07/10] Fixed FunctionReporter to use R6 class generator name and not classname attribute --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/PackageFunctionReporter.R | 30 ++++++++++++++++++++++-------- inst/milne/R/The_End.R | 14 ++++++++------ man/FunctionReporter.Rd | 7 +++++++ 5 files changed, 39 insertions(+), 15 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0682f753..51505ec5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,5 +35,5 @@ License: BSD_3_clause + file LICENSE URL: https://github.com/UptakeOpenSource/pkgnet BugReports: https://github.com/UptakeOpenSource/pkgnet/issues LazyData: TRUE -RoxygenNote: 6.1.0 +RoxygenNote: 6.1.1 VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index a20e08e8..c558b17c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,6 +11,7 @@ import(data.table) importFrom(DT,datatable) importFrom(DT,formatRound) importFrom(R6,R6Class) +importFrom(R6,is.R6Class) importFrom(assertthat,assert_that) importFrom(assertthat,is.readable) importFrom(assertthat,is.string) diff --git a/R/PackageFunctionReporter.R b/R/PackageFunctionReporter.R index 34f7c0eb..c090dc9a 100644 --- a/R/PackageFunctionReporter.R +++ b/R/PackageFunctionReporter.R @@ -5,6 +5,14 @@ #' its other functions, determining useful information such as which function is most #' central to the package. Combined with testing information it can be used as a powerful tool #' to plan testing efforts. +#' +#' R6 classes are supported, with methods treated as functions by the Reporter. +#' R6 methods will be named like \code{$$} +#' , e.g., \code{FunctionReporter$private_methods$extract_nodes}. Note that the +#' class name used will be the \emph{name of the generator object in the package's namespace}, +#' and \emph{not} the \code{classname} attribute of the class, which is not required to be defined +#' or to be the same as the generator object name. +#' #' @section Public Methods: #' \describe{ #' \item{\code{set_package(pkg_name, pkg_path)}}{ @@ -92,7 +100,7 @@ FunctionReporter <- R6::R6Class( private$cache$pkg_R6_methods <- data.table::rbindlist(lapply( X = self$pkg_R6_classes , FUN = function(x, p = private$get_pkg_env()) { - .get_R6_class_methods(get(x,p)) + .get_R6_class_methods(x, get(x,p)) } )) } @@ -370,9 +378,10 @@ FunctionReporter <- R6::R6Class( # enumerating all of its public, active binding, and private methods #' @importFrom assertthat assert_that #' @importFrom R6 is.R6Class -.get_R6_class_methods <- function(thisClass) { +.get_R6_class_methods <- function(className, classGenerator) { assertthat::assert_that( - R6::is.R6Class(thisClass) + assertthat::is.string(className) + , R6::is.R6Class(classGenerator) ) method_types <- c('public_methods', 'active', 'private_methods') @@ -380,12 +389,12 @@ FunctionReporter <- R6::R6Class( methodsDT <- data.table::rbindlist(do.call( c, lapply(method_types, function(mtype) { - lapply(names(thisClass[[mtype]]), function(mname) { + lapply(names(classGenerator[[mtype]]), function(mname) { list(METHOD_TYPE = mtype, METHOD_NAME = mname) }) }) )) - methodsDT[, CLASS_NAME := thisClass$classname] + methodsDT[, CLASS_NAME := className] return(methodsDT) } @@ -397,11 +406,16 @@ FunctionReporter <- R6::R6Class( inheritanceDT <- data.table::rbindlist(lapply( X = class_names , FUN = function(x, p = pkg_env) { - parentClass <- get(x, p)$get_inherit() + parentClassName <- deparse(get(x, p)$inherit) + parentClassGenerator <- get(x, p)$get_inherit() return(list( CLASS_NAME = x - , PARENT_NAME = if (!is.null(parentClass)) parentClass$classname else NA_character_ - , PARENT_IN_PKG = (pkg_name == environmentName(parentClass$parent_env)) + , PARENT_NAME = if (!is.null(parentClassGenerator)) { + parentClassName + } else { + NA_character_ + } + , PARENT_IN_PKG = (pkg_name == environmentName(parentClassGenerator$parent_env)) )) } )) diff --git a/inst/milne/R/The_End.R b/inst/milne/R/The_End.R index 9391ee77..ed40388d 100644 --- a/inst/milne/R/The_End.R +++ b/inst/milne/R/The_End.R @@ -5,7 +5,7 @@ #' @importFrom R6 R6Class #' @export One <- R6::R6Class( - "One", + classname = "One", public = list( initialize = function() { cat("The End, by A. A. Milne") @@ -29,7 +29,7 @@ One <- R6::R6Class( #' @importFrom R6 R6Class #' @export Two <- R6::R6Class( - "Two", + classname = "Two", inherit = One, public = list( print_poem = function() { @@ -48,7 +48,8 @@ Two <- R6::R6Class( #' @importFrom R6 R6Class #' @export Three <- R6::R6Class( - "Three", + # R6 classes don't need classname to match generator name + classname = "HardlyThree", inherit = Two, public = list( print_poem = function() { @@ -67,7 +68,8 @@ Three <- R6::R6Class( #' @importFrom R6 R6Class #' @export Four <- R6::R6Class( - "Four", + # R6 classes don't need classname at all + classname = NULL, inherit = Three, public = list( print_poem = function() { @@ -86,7 +88,7 @@ Four <- R6::R6Class( #' @importFrom R6 R6Class #' @export Five <- R6::R6Class( - "Five", + classname = "Five", inherit = Four, public = list( print_poem = function() { @@ -107,7 +109,7 @@ Five <- R6::R6Class( #' @importFrom R6 R6Class #' @export Six <- R6::R6Class( - "Six", + classname = "Six", inherit = Five, public = list( print_poem = function() { diff --git a/man/FunctionReporter.Rd b/man/FunctionReporter.Rd index f48c5a7b..45d7d890 100644 --- a/man/FunctionReporter.Rd +++ b/man/FunctionReporter.Rd @@ -13,6 +13,13 @@ This Reporter takes a package and uncovers the structure from its other functions, determining useful information such as which function is most central to the package. Combined with testing information it can be used as a powerful tool to plan testing efforts. + +R6 classes are supported, with methods treated as functions by the Reporter. +R6 methods will be named like \code{$$} +, e.g., \code{FunctionReporter$private_methods$extract_nodes}. Note that the +class name used will be the \emph{name of the generator object in the package's namespace}, +and \emph{not} the \code{classname} attribute of the class, which is not required to be defined +or to be the same as the generator object name. } \section{Public Methods}{ From 5654fac5d569628467e7cecb339860ff2c6acaf0 Mon Sep 17 00:00:00 2001 From: Jay Qi Date: Sat, 17 Nov 2018 17:17:24 -0600 Subject: [PATCH 08/10] milne typos --- inst/milne/DESCRIPTION | 2 +- inst/milne/R/The_End.R | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/inst/milne/DESCRIPTION b/inst/milne/DESCRIPTION index c495f5ed..a226c2a4 100644 --- a/inst/milne/DESCRIPTION +++ b/inst/milne/DESCRIPTION @@ -7,7 +7,7 @@ Authors@R: c( person("Jay", "Qi", email = "jay.qi@uptake.com", role = c("aut", "cre")) ) Maintainer: Jay Qi -Description: This package is used to test the functions in `pkgnet`. So I think I'll be six now for ever and ever. +Description: This package is used to test object-oriented class functionality for the reporters in `pkgnet`. So I think I'll be six now for ever and ever. Imports: R6 Suggests: diff --git a/inst/milne/R/The_End.R b/inst/milne/R/The_End.R index ed40388d..337bd8cf 100644 --- a/inst/milne/R/The_End.R +++ b/inst/milne/R/The_End.R @@ -8,7 +8,7 @@ One <- R6::R6Class( classname = "One", public = list( initialize = function() { - cat("The End, by A. A. Milne") + cat("The End, by A. A. Milne \n") }, print_poem = function() { cat("When I was One, \n", @@ -55,7 +55,7 @@ Three <- R6::R6Class( print_poem = function() { super$print_poem() cat("When I was Three, \n", - "I was hardly me. \n" + "I was hardly Me. \n" ) } ) @@ -114,7 +114,7 @@ Six <- R6::R6Class( public = list( print_poem = function() { super$print_poem() - cat("When I was Six, \n", + cat("But now I am Six,", "I'm as clever as clever. \n" ) private$print_ending() @@ -122,8 +122,8 @@ Six <- R6::R6Class( ), private = list( print_ending = function() { - cat("So I think I'll be Six now, \n", - "Forever and ever." + cat("So I think I'll be six now", + "for ever and ever." ) } ) From 0499a64f269a3db805a7f1662d395191c3923b19 Mon Sep 17 00:00:00 2001 From: Jay Qi Date: Sat, 24 Nov 2018 11:07:27 -0600 Subject: [PATCH 09/10] Addressed minor PR comments --- .gitignore | 11 +- R/PackageFunctionReporter.R | 128 ++++++++++----------- inst/milne/R/The_End.R | 12 +- inst/milne/tests/testthat/test_The_End.R | 29 +++-- tests/testthat/test-functional_structure.R | 38 +++--- 5 files changed, 113 insertions(+), 105 deletions(-) diff --git a/.gitignore b/.gitignore index f7f853c6..9680d90e 100644 --- a/.gitignore +++ b/.gitignore @@ -4,10 +4,13 @@ tests/testthat/Rplots.pdf **/.DS_Store -# data files -/*.rds -/*.rda -/*.csv +# data files +**/*.rds +**/*.rda +**/*.csv + +# Keep data files in testdata +!/tests/testthat/testdata/*.csv # build artifacts **/*.tar.gz diff --git a/R/PackageFunctionReporter.R b/R/PackageFunctionReporter.R index c090dc9a..b8333c3b 100644 --- a/R/PackageFunctionReporter.R +++ b/R/PackageFunctionReporter.R @@ -5,14 +5,14 @@ #' its other functions, determining useful information such as which function is most #' central to the package. Combined with testing information it can be used as a powerful tool #' to plan testing efforts. -#' -#' R6 classes are supported, with methods treated as functions by the Reporter. +#' +#' R6 classes are supported, with methods treated as functions by the Reporter. #' R6 methods will be named like \code{$$} #' , e.g., \code{FunctionReporter$private_methods$extract_nodes}. Note that the #' class name used will be the \emph{name of the generator object in the package's namespace}, #' and \emph{not} the \code{classname} attribute of the class, which is not required to be defined #' or to be the same as the generator object name. -#' +#' #' @section Public Methods: #' \describe{ #' \item{\code{set_package(pkg_name, pkg_path)}}{ @@ -119,7 +119,7 @@ FunctionReporter <- R6::R6Class( ), private = list( - + get_pkg_env = function() { if (is.null(private$cache$pkg_env)) { # create a custom environment w/ this package's contents @@ -127,7 +127,7 @@ FunctionReporter <- R6::R6Class( } return(private$cache$pkg_env) }, - + # add coverage to nodes table calculate_test_coverage = function(){ @@ -179,11 +179,11 @@ FunctionReporter <- R6::R6Class( extract_network = function(){ # Reset cache, because any cached stuff will be outdated with a new network private$reset_cache() - + log_info(sprintf('Extracting nodes from %s...', self$pkg_name)) private$cache$nodes <- private$extract_nodes() log_info('Done extracting nodes.') - + log_info(sprintf('Extracting edges from %s...', self$pkg_name)) private$cache$edges <- private$extract_edges() log_info('Done extracting edges.') @@ -201,24 +201,24 @@ FunctionReporter <- R6::R6Class( if (is.null(self$pkg_name)) { log_fatal('Must set_package() before extracting nodes.') } - + pkg_env <- private$get_pkg_env() - + ## FUNCTIONS ## - + # Filter objects in package environment to just functions # This will now be a character vector full of function names funs <- Filter( f = function(x, p = pkg_env){is.function(get(x, p))} , x = names(pkg_env) ) - + # Create nodes data.table nodes <- data.table::data.table( node = funs , type = "function" ) - + # Figure out which functions are exported # We need the package to be loaded first suppressPackageStartupMessages({ @@ -228,7 +228,7 @@ FunctionReporter <- R6::R6Class( }) exported_obj_names <- ls(sprintf("package:%s", self$pkg_name)) nodes[, isExported := node %in% exported_obj_names] - + # Check if we have R6 functions if (length(self$pkg_R6_classes) > 0) { r6DT <- self$pkg_R6_methods[, .( @@ -236,10 +236,10 @@ FunctionReporter <- R6::R6Class( , type = "R6 method" , isExported = CLASS_NAME %in% exported_obj_names )] - + nodes <- data.table::rbindlist(list(nodes, r6DT)) } - + return(nodes) }, @@ -249,12 +249,12 @@ FunctionReporter <- R6::R6Class( } log_info(sprintf('Constructing network representation...')) - + # create a custom environment w/ this package's contents pkg_env <- private$get_pkg_env() - + ### FUNCTIONS ### - + # Get table of edges between functions # for each function, check if anything else in the package # was called by it @@ -268,7 +268,7 @@ FunctionReporter <- R6::R6Class( ) , fill = TRUE ) - + ### R6 METHODS ### if (length(self$pkg_R6_classes) > 0) { edgeDT <- data.table::rbindlist(c( @@ -289,8 +289,8 @@ FunctionReporter <- R6::R6Class( , fill = TRUE ) } - - # If there are no edges, we still want to return a length-zero + + # If there are no edges, we still want to return a length-zero # data.table with correct columns if (nrow(edgeDT) == 0) { log_info("Edge list is empty.") @@ -301,7 +301,7 @@ FunctionReporter <- R6::R6Class( } log_info("Done constructing network representation") - + return(edgeDT) } ) @@ -336,8 +336,8 @@ FunctionReporter <- R6::R6Class( if (length(matches) == 0){ return(invisible(NULL)) } - - # Convention: If B depends on A, then B is the TARGET + + # 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 . So fname depends on . # So fname is TARGET and are SOURCEs @@ -362,19 +362,19 @@ FunctionReporter <- R6::R6Class( if (listable){ # Filter out atomic values because we don't care about them x <- Filter(f = Negate(is.atomic), x = x) - + # Parse each listed expression recursively until # they can't be listed anymore out <- unlist(lapply(x, .parse_function), use.names = FALSE) } else { - + # If not listable, deparse into a character string out <- paste(deparse(x), collapse = "\n") } return(out) } -# [description] given an R6 class, returns a data.table +# [description] given an R6 class, returns a data.table # enumerating all of its public, active binding, and private methods #' @importFrom assertthat assert_that #' @importFrom R6 is.R6Class @@ -383,11 +383,11 @@ FunctionReporter <- R6::R6Class( assertthat::is.string(className) , R6::is.R6Class(classGenerator) ) - + method_types <- c('public_methods', 'active', 'private_methods') - + methodsDT <- data.table::rbindlist(do.call( - c, + c, lapply(method_types, function(mtype) { lapply(names(classGenerator[[mtype]]), function(mname) { list(METHOD_TYPE = mtype, METHOD_NAME = mname) @@ -395,7 +395,7 @@ FunctionReporter <- R6::R6Class( }) )) methodsDT[, CLASS_NAME := className] - + return(methodsDT) } @@ -434,12 +434,12 @@ FunctionReporter <- R6::R6Class( ) { # Get body of method mbody <- get(class_name, envir = pkg_env)[[method_type]][[method_name]] - + # Parse into symbols mbodyDT <- data.table::data.table( SYMBOL = unique(.parse_R6_expression(mbody)) ) - + # Match to R6 methods mbodyDT[grepl('(^self\\$|^private\\$)', SYMBOL) , MATCH := vapply(X = SYMBOL @@ -449,7 +449,7 @@ FunctionReporter <- R6::R6Class( , methodsDT = methodsDT , inheritanceDT = inheritanceDT )] - + # Match to R6 superclass methods. This has a different recursion strategy mbodyDT[grepl('(^super\\$)', SYMBOL) , MATCH := vapply(X = unlist(strsplit( @@ -462,19 +462,19 @@ FunctionReporter <- R6::R6Class( , methodsDT = methodsDT , inheritanceDT = inheritanceDT )] - + # Match to functions in package mbodyDT[!grepl('(^self\\$|^private\\$)', SYMBOL) & is.na(MATCH) & SYMBOL %in% pkg_functions , MATCH := SYMBOL ] - + if (nrow(mbodyDT[!is.na(MATCH)]) == 0) { return(NULL) } - - # Convention: If B depends on A, then B is the TARGET + + # 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 . So fname depends on . # So fname is TARGET and are SOURCEs @@ -482,12 +482,12 @@ FunctionReporter <- R6::R6Class( SOURCE = unique(mbodyDT[!is.na(MATCH), MATCH]) , TARGET = paste(class_name, method_type, method_name, sep = "$") ) - + return(edgeDT) } -# [description] given a symbol name that is an R6 internal reference +# [description] given a symbol name that is an R6 internal reference # (self$x or private$x), match to a provided data.table of known R6 methods. # Searches up inheritance tree. #' @importFrom assertthat assert_that @@ -496,26 +496,26 @@ FunctionReporter <- R6::R6Class( splitSymbol <- unlist(strsplit(symbol_name, split = "$", fixed = TRUE)) assertthat::assert_that(splitSymbol[1] %in% c('self', 'private')) if (splitSymbol[1] == "self") { - out <- methodsDT[CLASS_NAME == class_name + out <- methodsDT[CLASS_NAME == class_name & METHOD_TYPE %in% c("public_methods", "active") & splitSymbol[2] == METHOD_NAME , paste(CLASS_NAME, METHOD_TYPE, METHOD_NAME, sep = "$") ] } else if (splitSymbol[1] == "private") { - out <- methodsDT[CLASS_NAME == class_name + out <- methodsDT[CLASS_NAME == class_name & METHOD_TYPE == "private_methods" & splitSymbol[2] == METHOD_NAME , paste(CLASS_NAME, METHOD_TYPE, METHOD_NAME, sep = "$") ] } - + # Above returns character(0) if not matched. Convert to NA_character if (identical(out, character(0))) { out <- NA_character_ } - + # Not not matched, try parent if there is one and it is in package - if (is.na(out) + if (is.na(out) && inheritanceDT[CLASS_NAME == class_name , !is.na(PARENT_NAME) && PARENT_IN_PKG]) { out <- .match_R6_class_methods( @@ -525,12 +525,12 @@ FunctionReporter <- R6::R6Class( , inheritanceDT ) } - + # We should only have at most one match assertthat::assert_that( assertthat::is.string(out) - ) - + ) + return(out) } @@ -538,25 +538,25 @@ FunctionReporter <- R6::R6Class( # [description] given a symbol name that is an internal reference to a superclass # method (super$), match to a provided data.table of known R6 methods # by checking searching ancestor classes. We need this as a separate function because -# super$method_name calls don't specify public, private, or active. +# super$method_name calls don't specify public, private, or active. # So we have to search all three for a parent class before moving up # to the next parent class. Luckily, within one class definition you're not allowed -# to name things the same so we should only have one result. +# to name things the same so we should only have one result. #' @importFrom assertthat assert_that is.string .match_R6_super_methods <- function(method_name, parent_name, methodsDT, inheritanceDT) { - out <- methodsDT[CLASS_NAME == parent_name + out <- methodsDT[CLASS_NAME == parent_name & method_name == METHOD_NAME , paste(CLASS_NAME, METHOD_TYPE, METHOD_NAME, sep = "$") ] - + # Above returns character(0) if not matched. Convert to NA_character if (identical(out, character(0))) { out <- NA_character_ } - + # If not matched, try parent if there is one and it is in package - if (is.na(out) + if (is.na(out) && inheritanceDT[CLASS_NAME == parent_name , !is.na(PARENT_NAME) && PARENT_IN_PKG]) { out <- .match_R6_super_methods( @@ -566,11 +566,11 @@ FunctionReporter <- R6::R6Class( , inheritanceDT ) } - + # We should only have at most one match assertthat::assert_that( assertthat::is.string(out) - ) + ) return(out) } @@ -579,18 +579,18 @@ FunctionReporter <- R6::R6Class( # [description] parses R6 expressions into a character vector of symbols and atomic # values. Will not break up expressions of form self$foo, private$foo, or super$foo .parse_R6_expression <- function(x) { - + # If expression x is not an atomic type or symbol (i.e., name of object) # then we can break x up into list of components - + listable <- (!is.atomic(x) && !is.symbol(x)) - + if (!is.list(x) && listable) { xList <- as.list(x) - + # Check if expression x is of form self$foo, private$foo, or super$foo - if (identical(xList[[1]], quote(`$`)) - && (identical(xList[[2]], quote(self)) + if (identical(xList[[1]], quote(`$`)) + && (identical(xList[[2]], quote(self)) || identical(xList[[2]], quote(private)) || identical(xList[[2]], quote(super)) ) @@ -600,11 +600,11 @@ FunctionReporter <- R6::R6Class( x <- xList } } - + if (listable){ # Filter out atomic values because we don't care about them x <- Filter(f = Negate(is.atomic), x = x) - + # Parse each listed expression recursively until # they can't be listed anymore out <- unlist(lapply(x, .parse_R6_expression), use.names = FALSE) diff --git a/inst/milne/R/The_End.R b/inst/milne/R/The_End.R index 337bd8cf..1382e842 100644 --- a/inst/milne/R/The_End.R +++ b/inst/milne/R/The_End.R @@ -11,7 +11,7 @@ One <- R6::R6Class( cat("The End, by A. A. Milne \n") }, print_poem = function() { - cat("When I was One, \n", + cat("When I was One, \n", "I had just begun. \n" ) }, @@ -34,7 +34,7 @@ Two <- R6::R6Class( public = list( print_poem = function() { super$print_poem() - cat("When I was Two, \n", + cat("When I was Two, \n", "I was nearly new. \n" ) } @@ -54,7 +54,7 @@ Three <- R6::R6Class( public = list( print_poem = function() { super$print_poem() - cat("When I was Three, \n", + cat("When I was Three, \n", "I was hardly Me. \n" ) } @@ -74,7 +74,7 @@ Four <- R6::R6Class( public = list( print_poem = function() { super$print_poem() - cat("When I was Four, \n", + cat("When I was Four, \n", "I was not much more. \n" ) } @@ -93,7 +93,7 @@ Five <- R6::R6Class( public = list( print_poem = function() { super$print_poem() - cat("When I was Five, \n", + cat("When I was Five, \n", "I was just alive. \n" ) } @@ -114,7 +114,7 @@ Six <- R6::R6Class( public = list( print_poem = function() { super$print_poem() - cat("But now I am Six,", + cat("But now I am Six,", "I'm as clever as clever. \n" ) private$print_ending() diff --git a/inst/milne/tests/testthat/test_The_End.R b/inst/milne/tests/testthat/test_The_End.R index 7951589f..88a8645b 100644 --- a/inst/milne/tests/testthat/test_The_End.R +++ b/inst/milne/tests/testthat/test_The_End.R @@ -1,14 +1,19 @@ -test_that('Four class can be sucessfully intialized', expect_true({ - myObj <- Four$new() - R6::is.R6(myObj) -})) +theEndClasses <- c('One', 'Two', 'Three', 'Four', 'Five', 'Six') -test_that('Five class can be sucessfully intialized', expect_true({ - myObj <- Five$new() - R6::is.R6(myObj) -})) +# Helper function to avoid printing +# http://r.789695.n4.nabble.com/Suppressing-output-e-g-from-cat-tp859876p859882.html +.quiet <- function(x) { + sink(tempfile()) + on.exit(sink()) + invisible(force(x)) +} -test_that('Six class can be sucessfully intialized', expect_true({ - myObj <- Six$new() - R6::is.R6(myObj) -})) \ No newline at end of file +for (thisClass in theEndClasses) { + test_that( + sprintf('%s class can be sucessfully intialized', thisClass) + , expect_true({ + .quiet({myObj <- get(thisClass)$new()}) + R6::is.R6(myObj) + }) + ) +} diff --git a/tests/testthat/test-functional_structure.R b/tests/testthat/test-functional_structure.R index ddb9e674..6e7f44b7 100644 --- a/tests/testthat/test-functional_structure.R +++ b/tests/testthat/test-functional_structure.R @@ -16,12 +16,12 @@ futile.logger::flog.threshold(0) ##### RUN TESTS ##### # Note: Packages 'baseballstats' and 'sartre' are installed by Travis CI before testing -# and uninstalled after testing. If running these tests locallaly. +# and uninstalled after testing. If running these tests locallaly. test_that('test packages installed correctly',{ - + testPkgNames <- c("baseballstats", "sartre", "milne") - + for (thisTestPkg in testPkgNames) { expect_true( object = require(thisTestPkg @@ -35,68 +35,68 @@ test_that('test packages installed correctly',{ test_that('FunctionReporter returns graph of functions', { reporter <- FunctionReporter$new() reporter$set_package(pkg_name = "baseballstats") - + # Nodes expect_equivalent(object = sort(reporter$nodes$node) , expected = sort(as.character(unlist(utils::lsf.str(asNamespace(reporter$pkg_name))))) , info = "All functions are nodes, even ones without connections.") - + expect_true(object = is.element("node", names(reporter$nodes)) , info = "Node column created") - + expect_s3_class(object = reporter$nodes , class = "data.table") - + # Edges expect_s3_class(object = reporter$edges , class = "data.table") - + expect_true(object = all(c("TARGET", "SOURCE") %in% names(reporter$edges)) , info = "TARGET and SCORE fields in edge table at minimum") - + # Plots expect_true(object = is.element("visNetwork", attributes(reporter$graph_viz))) - + }) test_that('FunctionReporter works on edge case one function', { t2 <- FunctionReporter$new() t2$set_package('sartre') - + expect_true( object = (nrow(t2$nodes) == 1) , info = "One row in nodes table." ) - + expect_true( object = (nrow(t2$edges) == 0) , info = "Edges table is empty since there are no edges." ) - + expect_true(object = is.element("visNetwork", attributes(t2$graph_viz))) - + }) test_that('FunctionReporter works with R6 classes', { reporter <- FunctionReporter$new() reporter$set_package('milne') - + # Test nodes expect_equivalent( object = reporter$nodes - , expected = data.table::fread(file.path('testdata/milne_nodes.csv')) + , expected = data.table::fread(file.path('testdata', 'milne_nodes.csv')) , ignore.col.order = TRUE , ignore.row.order = TRUE ) - + # Test edges expect_equivalent( object = reporter$edges - , expected = data.table::fread(file.path('testdata/milne_edges.csv')) + , expected = data.table::fread(file.path('testdata', 'milne_edges.csv')) , ignore.col.order = TRUE , ignore.row.order = TRUE ) - + # Test viz expect_true(object = is.element("visNetwork", attributes(reporter$graph_viz))) }) From 26a283f2e6052372eeffa9d1bcedfdae8ffcb671 Mon Sep 17 00:00:00 2001 From: Jay Qi Date: Sat, 24 Nov 2018 11:27:51 -0600 Subject: [PATCH 10/10] R6 parsing handling of environment pointers and complex function objects --- R/PackageFunctionReporter.R | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/R/PackageFunctionReporter.R b/R/PackageFunctionReporter.R index 4dc36230..7a1378a5 100644 --- a/R/PackageFunctionReporter.R +++ b/R/PackageFunctionReporter.R @@ -435,7 +435,7 @@ FunctionReporter <- R6::R6Class( , pkg_functions ) { # Get body of method - mbody <- get(class_name, envir = pkg_env)[[method_type]][[method_name]] + mbody <- body(get(class_name, envir = pkg_env)[[method_type]][[method_name]]) # Parse into symbols mbodyDT <- data.table::data.table( @@ -582,10 +582,9 @@ FunctionReporter <- R6::R6Class( # values. Will not break up expressions of form self$foo, private$foo, or super$foo .parse_R6_expression <- function(x) { - # If expression x is not an atomic type or symbol (i.e., name of object) - # then we can break x up into list of components - - listable <- (!is.atomic(x) && !is.symbol(x)) + # If expression x is not an atomic value or symbol (i.e., name of object) or + # an environment pointer then we can break x up into list of components + listable <- (!is.atomic(x) && !is.symbol(x) && !is.environment(x)) if (!is.list(x) && listable) { xList <- as.list(x)