tests/testthat/test_glasso_cv.R

In MalteLond/rfcd: Random Forest Change Point Detection

context("glasso inner cross validation")

#set.seed(0)
#x <- simulate_from_model(create_model(200, 10, c(70, 120), RandomNetwork))
#x_del <- delete_values(x, 0.3, 'blockwise')
#saveRDS(x_del, './tests/data/reference_glasso_x_del_blockwise_03')
#x_del <- readRDS('./tests/data/reference_glasso_x_del_blockwise_03')

test_that("cv inner search lambda", {
  
  x_del <- readRDS('../data/reference_glasso_x_del_blockwise_03')
  
  # we start with a lambda far from a reasonable value (e.g. 0.1)
  tree_search <- hdcd(x_del[1 : 100, ], method = 'glasso', optimizer = 'section_search', delta = 0.1, lambda = 1e-5,
                      control = hdcd_control(glasso_NA_method = 'loh', cv_inner = TRUE, cv_inner_search_lambda = TRUE, cv_inner_lambda_step = 0.1))
  
  expect_equal(get_change_points_from_tree(tree_search), 70)
  
})

test_that("cv inner fixed lambda", {
  
  x_del <- readRDS('../data/reference_glasso_x_del_blockwise_03')
  
  control <- hdcd_control(glasso_NA_method = 'loh', cv_inner = TRUE)
  control$cv_inner_lambda <- log_space(control$cv_inner_min_grid_ratio * 1e-2,
                                                  1e-2 / control$cv_inner_min_grid_ratio,
                                                  length.out = 5)

  tree_fixed <- hdcd(x_del[1 : 100, ], method = 'glasso', optimizer = 'section_search', delta = 0.1, lambda = 1e-2,
                     control = control)
  expect_equal(get_change_points_from_tree(tree_fixed), 70)
})