now returns silently

Author: smasongarrison

NEWS.md

@@ -4,6 +4,7 @@
 * Add function to extract family tree from wiki family tree template
 * Add tests for readWikifamilytree
 * Create vignette for adjacency matrix methods
+* Silences invisible list for plot
 
 # BGmisc 1.3.4.1
 * Hot fix to resolve issue with list of adjacency matrix not loading saved version

R/plotPedigree.R

@@ -109,7 +109,7 @@ plotPedigree <- function(ped,
 
       # Ensure the output is reverted back to console when function exits
       #     on.exit(if (sink.number() > 0) sink(), add = TRUE)
-
+      if (verbose) {
       plot_picture <- kinship2::plot.pedigree(p3,
         cex = cex,
         col = col,
@@ -120,15 +120,35 @@ plotPedigree <- function(ped,
         density = density,
         angle = angle, keep.par = keep.par,
         pconnect = pconnect,
-        mar = mar
+        mar = mar,
+        ...
       )
 
       # Explicitly revert the standard output back to the console
       #      if (sink.number() > 0) {
       #        sink()
       #      }
+      return(plot_picture)
+        }else{
+          plot_picture <- suppressMessages(kinship2::plot.pedigree(p3,
+                                                  cex = cex,
+                                                  col = col,
+                                                  symbolsize = symbolsize,
+                                                  branch = branch,
+                                                  packed = packed, align = align,
+                                                  width = width,
+                                                  density = density,
+                                                  angle = angle, keep.par = keep.par,
+                                                  pconnect = pconnect,
+                                                  mar = mar,
+                                                  ...
+          ))
 
+      plot_picture[c("plist", "x", "y", "boxw", "boxh","call")] <- NULL
+      class(plot_picture) <- NULL
       return(plot_picture)
+      }
+
     }
   } else {
     stop("The structure of the provided pedigree data does not match the expected structure.")

tests/testthat/test-plotPedigree.R

@@ -0,0 +1,31 @@
+test_that("simulated pedigree plots correctly", {
+  set.seed(5)
+  Ngen <- 4
+  kpc <- 4
+  sexR <- .50
+  marR <- .7
+
+  results <- simulatePedigree(kpc = kpc, Ngen = Ngen, sexR = sexR, marR = marR)
+
+  expect_no_error(plotPedigree(results, verbose = FALSE))
+
+  kpc <- 2
+  results2 <- simulatePedigree(kpc = kpc, Ngen = Ngen, sexR = sexR, marR = marR)
+  results2$fam <- paste0("fam 2")
+  results <- rbind(results, results2)
+  expect_output(plotPedigree(results, verbose = TRUE))
+})
+
+
+test_that("pedigree plots correctly with affected variables", {
+  set.seed(5)
+  Ngen <- 4
+  kpc <- 4
+  sexR <- .50
+  marR <- .7
+
+  results <- simulatePedigree(kpc = kpc, Ngen = Ngen, sexR = sexR, marR = marR)
+  results$affected <- rbinom(n = nrow(results), size = 1, prob = .1)
+  expect_output(plotPedigree(results, verbose = TRUE, affected = "affected"))
+  expect_output(plotPedigree(results, verbose = TRUE, affected = results$affected))
+})

tests/testthat/test-simulatePedigree.R

@@ -17,22 +17,6 @@ test_that("simulated pedigree generates expected data structure", {
   expect_equal(mean(results$sex == "M"), sexR, tolerance = .05)
 })
 
-test_that("simulated pedigree plots correctly", {
-  set.seed(5)
-  Ngen <- 4
-  kpc <- 4
-  sexR <- .50
-  marR <- .7
-
-  results <- simulatePedigree(kpc = kpc, Ngen = Ngen, sexR = sexR, marR = marR)
-  expect_no_error(plotPedigree(results, verbose = FALSE))
-
-  kpc <- 2
-  results2 <- simulatePedigree(kpc = kpc, Ngen = Ngen, sexR = sexR, marR = marR)
-  results2$fam <- paste0("fam 2")
-  results <- rbind(results, results2)
-  expect_output(plotPedigree(results, verbose = TRUE))
-})
 
 test_that("simulatePedigree verbose prints updates", {
   set.seed(5)
@@ -44,15 +28,3 @@ test_that("simulatePedigree verbose prints updates", {
   expect_output(simulatePedigree(kpc = kpc, Ngen = Ngen, sexR = sexR, marR = marR, verbose = TRUE), regexp = "Let's build the connection within each generation first")
 })
 
-test_that("pedigree plots correctly with affected variables", {
-  set.seed(5)
-  Ngen <- 4
-  kpc <- 4
-  sexR <- .50
-  marR <- .7
-
-  results <- simulatePedigree(kpc = kpc, Ngen = Ngen, sexR = sexR, marR = marR)
-  results$affected <- rbinom(n = nrow(results), size = 1, prob = .1)
-  expect_output(plotPedigree(results, verbose = TRUE, affected = "affected"))
-  expect_output(plotPedigree(results, verbose = TRUE, affected = results$affected))
-})