Fixed bug where ccdr.run was truncating solution paths that did not meet edge threshold (set by alpha)

Author: itsrainingdata

R/ccdrAlgorithm-main.R

@@ -290,11 +290,12 @@ ccdr_gridR <- function(cors,
         # 7-16-14: Added code below to check edge threshold via alpha parameter
         if(ccdr.out[[i]]$nedge > alpha * pp){
             if(verbose) message("Edge threshold met, terminating algorithm with ", ccdr.out[[i-1]]$nedge, " edges.")
+            ccdr.out <- ccdr.out[1:(i-1)] # only return up to i - 1 since the last (ith) model did not finish
             break
         }
     }
 
-    ccdr.out[1:(i-1)] # only return up to i - 1 since the last (ith) model would not have finished running anyway
+    ccdr.out
 } # END CCDR_GRIDR
 
 # ccdr_singleR

tests/testthat/test-default_run.R

@@ -14,9 +14,11 @@ test_that("Testing default behaviour of ccdr.run", {
     expect_is(final, "list")
 
     ### Check output types
-    for(i in seq_along(final)){
-        expect_is(final[[i]], "sparsebnFit")
-    }
+    check_sbf <- check_list_class(final, "sparsebnFit")
+    expect_true(check_sbf)
+    # for(i in seq_along(final)){
+    #     expect_is(final[[i]], "sparsebnFit")
+    # }
 
     ### Check consistency of nedge
     for(i in seq_along(final)){
@@ -33,9 +35,11 @@ test_that("Testing ccdr.run with manual settings", {
     expect_is(final, "list")
 
     ### Check output types
-    for(i in seq_along(final)){
-        expect_is(final[[i]], "sparsebnFit")
-    }
+    check_sbf <- check_list_class(final, "sparsebnFit")
+    expect_true(check_sbf)
+    # for(i in seq_along(final)){
+    #     expect_is(final[[i]], "sparsebnFit")
+    # }
 
     ### Check consistency of nedge
     for(i in seq_along(final)){
@@ -45,38 +49,12 @@ test_that("Testing ccdr.run with manual settings", {
     }
 })
 
-### OLD TEST CODE
-# source('~/Dropbox/PhD Research/Programming Projects/bncompare_dev/bncompare/R/bncompare-generate.R')
-# # depends on
-# source('~/Dropbox/PhD Research/Programming Projects/bncompare_dev/bncompare/R/s3-trueGraph.R')
-# # depends on
-# source('~/Dropbox/PhD Research/Programming Projects/bncompare_dev/bncompare/R/bncompare-utils.R')
-# # depends on
-# source('~/Dropbox/PhD Research/Programming Projects/bncompare_dev/bncompare/R/bncompare-functions.R')
-#
-# R_DEBUG_ON <<- FALSE # This is just a hack since we aren't using load_bncompare.R to load the package
-#
-# ### Generate some random data
-# pp <- 10
-# nn <- 100
-# ss <- 2
-#
-# g <- generate_ordered_dag(pp, ss)
-# d <- generate_data(g, nn)
-# final <- ccdr.run(data = d$dat, lambdas.length = 20, alpha = 3, verbose = FALSE)
-#
-# test_that("Testing default behaviour of ccdr.gridR", {
-#     expect_is(final, "list")
-#
-#     ### Check output types
-#     for(i in seq_along(final)){
-#         expect_is(final[[i]], "sparsebnFit")
-#     }
-#
-#     ### Check consistency of nedge
-#     for(i in seq_along(final)){
-#         matrix.nedge <- sum(as.matrix(final[[i]]$sbm) != 0)
-#         sbm.nedge <- .num_edges(final[[i]]$sbm)
-#         expect_equal(final[[i]]$nedge, sbm.nedge, matrix.nedge)
-#     }
-# })
+test_that("Bugfix: ccdr.run returns the correct number of solutions", {
+    ### Edge threshold not met, return all solutions
+    final <- ccdr.run(data = data, lambdas.length = 5)
+    expect_equal(length(final), 5)
+
+    ### Edge threshold met, only return subpath of complete solutions
+    final <- ccdr.run(data = data, lambdas.length = 5, alpha = 0.1)
+    expect_equal(length(final), 1)
+})