Added tests for brokering, fixed activity/exclusivity outputs, top3 e…

…tc helpers now work with character outputs

R/motif_census.R

@@ -397,7 +397,7 @@ node_brokering_activity <- function(.data, membership){
     twopaths <- dplyr::filter(twopaths, from_memb != to_memb)
   }
   # tabulate brokerage
-  out <- table(twopaths$to)
+  out <- c(table(twopaths$to))
   # correct ordering for named data
   if(manynet::is_labelled(.data)) out <- out[match(manynet::node_names(.data), names(out))]
   # missings should be none
@@ -424,7 +424,7 @@ node_brokering_exclusivity <- function(.data, membership){
   # get only exclusive paths
   out <- twopaths %>% dplyr::group_by(from, to.y) %>% dplyr::filter(dplyr::n()==1)
   # tabulate brokerage
-  out <- table(out$to)
+  out <- c(table(out$to))
   # correct ordering for named data
   if(manynet::is_labelled(.data)) out <- out[match(manynet::node_names(.data), names(out))]
   # missings should be none

tests/testthat/helper-functions.R

@@ -1,17 +1,25 @@
 top3 <- function(res, dec = 4){
-  unname(round(res, dec))[1:3]
+  if(is.numeric(res)){
+    unname(round(res, dec))[1:3]  
+  } else unname(res)[1:3]
 }
 
 bot3 <- function(res, dec = 4){
   lr <- length(res)
-  unname(round(res, dec))[(lr-2):lr]
+  if(is.numeric(res)){
+    unname(round(res, dec))[(lr-2):lr]
+  } else unname(res)[(lr-2):lr]
 }
 
 top5 <- function(res, dec = 4){
-  unname(round(res, dec))[1:5]
+  if(is.numeric(res)){
+    unname(round(res, dec))[1:5]
+  } else unname(res)[1:3]
 }
 
 bot5 <- function(res, dec = 4){
   lr <- length(res)
-  unname(round(res, dec))[(lr-4):lr]
+  if(is.numeric(res)){
+    unname(round(res, dec))[(lr-4):lr]
+  } else unname(res)[(lr-2):lr]
 }

tests/testthat/test-motif_census.R

@@ -64,3 +64,24 @@ test_that("node path census works", {
   expect_true(nrow(node_path_census(manynet::ison_southern_women)) ==
                 ncol(node_path_census(manynet::ison_southern_women)))
 })
+
+test <- node_brokering_activity(manynet::ison_networkers, "Discipline")
+test_that("node activity works", {
+  expect_s3_class(test, "node_measure")
+  expect_equal(manynet::network_nodes(manynet::ison_networkers), length(test))
+  expect_equal(top3(test), c(333,207,3))
+})
+
+test <- node_brokering_exclusivity(manynet::ison_networkers, "Discipline")
+test_that("node exclusivity works", {
+  expect_s3_class(test, "node_measure")
+  expect_equal(manynet::network_nodes(manynet::ison_networkers), length(test))
+  expect_equal(top3(test), c(1,0,0))
+})
+
+test <- node_brokering(manynet::ison_networkers, "Discipline")
+test_that("node brokering works", {
+  expect_s3_class(test, "node_member")
+  expect_equal(manynet::network_nodes(manynet::ison_networkers), length(test))
+  expect_equal(top3(test), c("Powerhouse","Connectors","Sideliners"))
+})