tests/testthat/test-DirectedGraph.R

In UptakeOpenSource/pkgnet: Get Network Representation of an R Package

##### TEST SET UP #####

milneNodes <- data.table::fread(file.path('testdata', 'milne_function_nodes.csv'))
milneEdges <- data.table::fread(file.path('testdata', 'milne_function_edges.csv'))

##### TESTS #####

## PUBLIC INTERFACE ##

test_that('DirectedGraph public interface is as expected', {

    publicInterfaceExpected <- c(
        # R6 Special Methods
        ".__enclos_env__"
        , "initialize"
        , "clone"
        , "print"

        # AbstractGraph methods
        , "node_measures"
        , "available_node_measures"
        , "default_node_measures"
        , "graph_measures"
        , "available_graph_measures"
        , "default_graph_measures"

        # AbstractGraph fields and active bindings
        , "nodes"
        , "edges"
        , "igraph"
    )

    graphObj <- pkgnet:::DirectedGraph$new(
        nodes = milneNodes
        , edges = milneEdges
    )
    expect_setequal(object = names(graphObj)
                    , expected = publicInterfaceExpected)

})

### USAGE OF PUBLIC METHODS AND FIELDS ###

test_that('DirectedGraph public methods are properly defined and run end-to-end', {

    nodeDT <- data.table::fread(file.path('testdata', 'milne_function_nodes.csv'))
    edgeDT <- data.table::fread(file.path('testdata', 'milne_function_edges.csv'))

    testObj <- pkgnet:::DirectedGraph$new(nodes = nodeDT, edges = edgeDT)

    # $node_measures() returns node table
    expect_true({data.table::is.data.table(testObj$node_measures())})

    # $available_node_measures returns values
    expect_true({is.character(testObj$available_node_measures)})
    expect_true({length(testObj$default_node_measures) > 0})

    # $default_node_measures returns values
    expect_true({is.character(testObj$default_node_measures)})
    expect_true({length(testObj$default_node_measures) > 0})
    expect_true({
        all(testObj$default_node_measures %in% testObj$available_node_measures)
    })

    # $graph_measures() returns list
    expect_true({is.list(testObj$graph_measures())})

    # $available_graph_measures returns values
    expect_true({is.character(testObj$available_graph_measures)})
    expect_true({length(testObj$default_graph_measures) > 0})

    # $default_graph_measures returns values
    expect_true({is.character(testObj$default_graph_measures)})
    expect_true({length(testObj$default_graph_measures) > 0})
    expect_true({
        all(testObj$default_graph_measures %in% testObj$available_graph_measures)
    })

    # $print() runs without error
    expect_true({
        testObj$print
        TRUE
    })
})

### VALUES OF MEASURE FUNCTIONS ARE EXPECTED ###

testList <- list(
    list(pkg = 'baseballstats', reporter = 'DependencyReporter')
    , list(pkg = 'baseballstats', reporter = 'FunctionReporter')
    , list(pkg = 'milne', reporter = 'InheritanceReporter')
)

for (thisTest in testList) {
    test_that(
        sprintf('DirectedGraph node measure values are expected for %s, %s'
            , thisTest[['pkg']], thisTest[['reporter']]
        ), {

        expectedNodeMeasuresDT <- data.table::fread(file.path('testdata'
            , sprintf('node_measures_%s_%s.csv'
                      , thisTest[['pkg']], thisTest[['reporter']])
        ))

        reporter <- get(thisTest[['reporter']])$new()$set_package(thisTest[['pkg']])
        
        for (nodeMeas in reporter$pkg_graph$available_node_measures) {
            expect_equivalent(
                object = reporter$pkg_graph$node_measures(nodeMeas)
                , expected = expectedNodeMeasuresDT[, lapply(.SD, function(x) replace(x, is.na(x), NaN)), .SDcols = c('node', nodeMeas)]
                , ignore.col.order = TRUE
                , ignore.row.order = TRUE
                , info = sprintf("Value testing for %s, %s : %s /n obj: %s /n exp %s"
                                 , thisTest[['pkg']]
                                 , thisTest[['reporter']]
                                 , nodeMeas
                                 , reporter$pkg_graph$node_measures(nodeMeas)
                                 , expectedNodeMeasuresDT[, lapply(.SD, function(x) replace(x, is.na(x), NaN)), .SDcols = c('node', nodeMeas)]
                                 )
            )
        } # /for nodeMeas
    }) # /test_that
} # /for thisTest

for (thisTest in testList) {
    test_that(
        sprintf('DirectedGraph graph measure values are expected for %s, %s'
                , thisTest[['pkg']], thisTest[['reporter']]
        ), {

        expectedGraphMeasuresDT <- data.table::fread(file.path('testdata'
            , sprintf('graph_measures_%s_%s.csv'
            , thisTest[['pkg']], thisTest[['reporter']])
        ))

        reporter <- get(thisTest[['reporter']])$new()$set_package(thisTest[['pkg']])

        for (graphMeas in reporter$pkg_graph$available_graph_measures) {

            # NAs to NaNs 
            expected_value <- expectedGraphMeasuresDT[measure == graphMeas, value]
            expected_value <- ifelse(is.na(expected_value), NaN, expected_value)
          
            expect_equivalent(
                object = reporter$pkg_graph$graph_measures(graphMeas)[[graphMeas]]
                , expected = expected_value
                , ignore.col.order = TRUE
                , ignore.row.order = TRUE
                , info = sprintf("Value testing for %s, %s : %s"
                                 , thisTest[['pkg']]
                                 , thisTest[['reporter']]
                                 , graphMeas)
            )
        } # /for graphMeas
        }) # /test_that
} # /for thisTest


### EXPECTED ERRORS ###

test_that('DirectedGraph constructor errors on bad inputs', {

    # Inputs are data.tables
    expect_error(
        object = pkgnet:::DirectedGraph$new(
            nodes = 'not_a_data.table'
            , edges = milneEdges
        )
        , regexp = "data.table::is.data.table(x = nodes) is not TRUE"
        , fixed = TRUE
    )
    expect_error(
        object = pkgnet:::DirectedGraph$new(
            nodes = milneNodes
            , edges = 'note_a_data.table'
        )
        , regexp = "data.table::is.data.table(x = edges) is not TRUE"
        , fixed = TRUE
    )

    # Inputs have expected columns
    expect_error(
        object = pkgnet:::DirectedGraph$new(
            nodes = data.table::copy(milneNodes)[, id := node][, node := NULL]
            , edges = milneEdges
        )
        , regexp = '`%in%`(x = "node", table = names(nodes))'
        , fixed = TRUE
    )
    expect_error(
        object = pkgnet:::DirectedGraph$new(
            nodes = milneNodes
            , edges = data.table::copy(milneEdges)[, from := SOURCE][, SOURCE := NULL]
        )
        , regexp = 'c("SOURCE", "TARGET") %in% names(edges)'
        , fixed = TRUE
    )
    expect_error(
        object = pkgnet:::DirectedGraph$new(
            nodes = milneNodes
            , edges = data.table::copy(milneEdges)[, to := TARGET][, TARGET := NULL]
        )
        , regexp = 'c("SOURCE", "TARGET") %in% names(edges)'
        , fixed = TRUE
    )
})