Merge pull request #94 from reconhub/contact-handle-na

Handle NAs for epicontacts

R/as.igraph.epicontacts.R

@@ -56,8 +56,11 @@ as.igraph.epicontacts <- function(x){
     verts$epicontacts_name <- verts$name
     verts$name <- NULL
   }
-
-
+  missing_contacts <- anyNA(x$contacts$from) || anyNA(x$contacts$to)
+  missing_vertex   <- anyNA(x$linelist$id)
+  if (missing_contacts && !missing_vertex) {
+    verts <- dplyr::add_row(verts, id = NA) 
+  }
   ## Creating igraph object
 
   net <- igraph::graph_from_data_frame(x$contacts, vertices = verts,

R/get_degree.R

@@ -44,11 +44,8 @@ get_degree <- function(x, type = c("in", "out", "both"),
     }
     type <- match.arg(type)
 
-    if (only_linelist) {
-        all_nodes <- x$linelist$id
-    } else {
-        all_nodes <- unique(c(x$contacts$from, x$contacts$to))
-    }
+    what      <- if (only_linelist) "linelist" else "contacts"
+    all_nodes <- get_id(x, which = what, na.rm = TRUE)
 
     if (!x$directed) {
         type <- "both"

R/print.summary_epicontacts.R

@@ -30,6 +30,14 @@ print.summary_epicontacts <- function(x, ...){
         cat("\n  // number of contacts:", x$n_contacts)
     }
 
+    if (!is.null(x$na_from)) {
+        cat("\n     // number missing 'from':", x$na_from)
+    }
+
+    if (!is.null(x$na_to)) {
+        cat("\n     // number missing 'to':", x$na_to)
+    }
+
     if (!is.null(x$prop_contacts_in_linelist)) {
         cat("\n  // contacts with both cases in linelist:",
             round(100 * x$prop_contacts_in_linelist,3), "%")

R/summary.epicontacts.R

@@ -20,8 +20,13 @@ summary.epicontacts <- function(object, ...){
 
     res$n_id_linelist <- length(get_id(x, "linelist"))
     res$n_id_contacts <- length(get_id(x,"contacts"))
-    res$n_id_common <- length(get_id(x, "common"))
-
+    res$n_id_common   <- length(get_id(x, "common"))
+
+    na_from     <- sum(is.na(x$contacts$from))
+    res$na_from <- if (na_from == 0) NULL else na_from
+    na_to       <- sum(is.na(x$contacts$to))
+    res$na_to   <- if (na_to == 0) NULL else na_to
+
     res$n_contacts <- nrow(x$contacts)
 
     from_in_linelist <- x$contacts$from %in% get_id(x, "linelist")

tests/testthat/test_as.igraph.epicontacts.R

@@ -19,3 +19,20 @@ test_that("Name column check behaves as expected", {
   expect_equal(igraph::vertex_attr(net)$epicontacts_name, x$linelist$name)
 
 })
+
+
+test_that("missing data will e added to the linelist", {
+  skip_on_cran()
+  x <- make_epicontacts(ebola_sim$linelist, ebola_sim$contacts,
+                        id = "case_id",
+                        to = "case_id",
+                        from = "infector",
+                        directed = FALSE)
+  x <- thin(x[1:100], 2)
+
+  x$contacts[6:9, ] <- NA
+  expect_warning(net <- as.igraph.epicontacts(x), "NA")
+  expect_is(net, "igraph")
+  expect_identical(igraph::vertex_attr(net)$id, c(get_id(x, "linelist"), "NA"))
+
+})

tests/testthat/test_subset.epicontacts.R

@@ -111,11 +111,12 @@ test_that("Returns epicontacts object subsetted correctly", {
 
     id <- names(which.max(get_degree(x, "out")))
     z <- thin(subset(x, cluster_id = id), 2)
-    expect_equal_to_reference(z, file = "rds/z.rds")
+    nocoords <- grep("(lat|lon)", names(z$linelist), perl = TRUE, invert = TRUE) - 1
+    expect_equal_to_reference(z[k = nocoords], file = "rds/z.rds")
 
 
     zz <- subset(x, cs = 10)
-    expect_equal_to_reference(zz, file = "rds/zz.rds")
+    expect_equal_to_reference(zz[k = nocoords], file = "rds/zz.rds")
     expect_true(all(get_clusters(zz, "data.frame")$cluster_size == 10L))
 
 

tests/testthat/test_summary.epicontacts.R

@@ -12,5 +12,13 @@ test_that("Printing summaries", {
 
     expect_equal_to_reference(capture.output(print(res)),
                               file = "rds/print2.rds")
+
+    y <- x
+    y$contacts <- y$contacts[1:10, ]
+    y <- thin(y)
+    y$contacts$from[6:9] <- NA
+    y$contacts$to[1]     <- NA
+   expect_output(print(summary(y)), "number missing 'from': 4") 
+   expect_output(print(summary(y)), "number missing 'to': 1") 
 
 })