Valgrind issue 353 (#357)

* valgrind issue solved

* updating cran comments

R/compute_mallows.R

@@ -77,6 +77,7 @@ compute_mallows <- function(
   validate_class(compute_options, "BayesMallowsComputeOptions")
   validate_class(priors, "BayesMallowsPriors")
   validate_class(initial_values, "BayesMallowsInitialValues")
+  validate_rankings(data)
   validate_preferences(data, model_options)
   validate_initial_values(initial_values, data)
 

R/validation_functions.R

@@ -57,6 +57,10 @@ validate_preferences <- function(data, model) {
   }
 }
 
+validate_rankings <- function(data) {
+  if (nrow(data$rankings) <= 0) stop("Data must have at least one row.")
+}
+
 validate_initial_values <- function(initial_values, data) {
   if (!is.null(initial_values$rho)) {
     if (length(unique(initial_values$rho)) != length(initial_values$rho)) {

cran-comments.md

@@ -1,5 +1,7 @@
 ## Resubmission Note
 
+UPDATE: The original resubmission did not fix a valgrind error. We have reproduced the error and fixed it.
+
 This is a resubmission, fixing issues with "clang-UBSAN", "gcc-UBSAN", and "valgrind". We have reproduced the errors using the Docker images rocker/r-devel-san, and made the necessary changes. 
 
 There are also two failing unit tests on noLD. We believe these to be cause be differences in floating point numbers, since the test expectations are based on values after running thousands of steps of an MCMC algorithm. We have added testthat::skip_on_cran() to the two tests in question.

src/classes.h

@@ -84,11 +84,7 @@ struct Clustering {
   void update_dist_mat(const Data& dat, const Parameters& pars,
                        const std::unique_ptr<Distance>& distfun);
 
-  arma::mat cluster_probs;
   arma::vec current_cluster_probs;
-  arma::umat cluster_assignment;
-  arma::uvec current_cluster_assignment;
-  arma::mat within_cluster_distance;
   const bool clustering;
   const unsigned int clus_thinning;
 
@@ -97,6 +93,13 @@ struct Clustering {
   arma::mat dist_mat;
   const bool include_wcd;
   const bool save_ind_clus;
+  int n_cluster_assignments;
+
+public:
+  arma::mat cluster_probs;
+  arma::umat cluster_assignment;
+  arma::uvec current_cluster_assignment;
+  arma::mat within_cluster_distance;
 };
 
 struct Augmentation {

src/clustering_class.cpp

@@ -8,21 +8,20 @@ Clustering::Clustering(const Parameters& pars,
   clustering {pars.n_clusters > 1},
   clus_thinning { compute_options["clus_thinning"] },
   index { regspace<uvec>(0, pars.n_clusters - 1) },
+  dist_mat { zeros(n_assessors, pars.n_clusters) },
   include_wcd { compute_options["include_wcd"] },
-  save_ind_clus { compute_options["save_ind_clus"] } {
-    int n_cluster_assignments = pars.n_clusters > 1 ?
-    std::ceil(static_cast<double>(pars.nmc * 1.0 / clus_thinning)) : 1;
-    cluster_probs.set_size(pars.n_clusters, n_cluster_assignments);
+  save_ind_clus { compute_options["save_ind_clus"] },
+  n_cluster_assignments { pars.n_clusters > 1 ?
+    static_cast<int>(std::ceil(static_cast<double>(pars.nmc * 1.0 / clus_thinning))) : 1 },
+  cluster_probs { zeros(pars.n_clusters, n_cluster_assignments) },
+  cluster_assignment { zeros<umat>(n_assessors, n_cluster_assignments) },
+  current_cluster_assignment { cluster_assignment.col(0) },
+  within_cluster_distance { zeros(pars.n_clusters, include_wcd ? pars.nmc : 1) }
+{
     cluster_probs.col(0).fill(1.0 / pars.n_clusters);
     current_cluster_probs = cluster_probs.col(0);
-    cluster_assignment.set_size(n_assessors, n_cluster_assignments);
     ivec a = Rcpp::sample(pars.n_clusters, n_assessors, true) - 1;
     cluster_assignment.col(0) = conv_to<uvec>::from(a);
-    current_cluster_assignment = cluster_assignment.col(0);
-
-    dist_mat.set_size(n_assessors, pars.n_clusters);
-    within_cluster_distance.set_size(
-      pars.n_clusters, include_wcd ? pars.nmc : 1);
     update_wcd(0);
   }
 

tests/testthat/test-assign_cluster.R

@@ -20,7 +20,7 @@ test_that("assign_cluster works", {
   a1 <- assign_cluster(mod, soft = FALSE, expand = FALSE)
   expect_equal(dim(a1), c(60, 3))
   agg1 <- aggregate(assessor ~ map_cluster, a1, length)
-  expect_equal(agg1$assessor, c(23, 17, 20))
+  expect_equal(agg1$assessor, c(21, 20, 19))
 
   a2 <- assign_cluster(mod, soft = TRUE, expand = FALSE)
   expect_equal(ncol(a2), 4)

tests/testthat/test-compute_posterior_intervals.R

@@ -47,8 +47,8 @@ test_that("compute_posterior_intervals works with clusters", {
   )
 
   pi <- compute_posterior_intervals(mod)
-  expect_equal(pi$hpdi[[3]], "[0.536,0.766]")
-  expect_equal(pi$central_interval[[2]], "[1.263,1.846]")
+  expect_equal(pi$hpdi[[3]], "[0.608,0.753]")
+  expect_equal(pi$central_interval[[2]], "[0.710,1.140]")
 
   pi <- compute_posterior_intervals(mod, parameter = "rho")
   expect_equal(unique(pi$cluster), factor(paste("Cluster", 1:3)))
@@ -57,8 +57,8 @@ test_that("compute_posterior_intervals works with clusters", {
     parameter = "cluster_probs",
     level = .96, decimals = 4
   )
-  expect_equal(pi$hpdi[[2]], "[0.3623,0.5374]")
-  expect_equal(pi$central_interval[[1]], "[0.2129,0.3812]")
+  expect_equal(pi$hpdi[[2]], "[0.2552,0.3708]")
+  expect_equal(pi$central_interval[[1]], "[0.3184,0.4840]")
 })
 
 test_that("compute_posterior_intervals works for SMC", {

work-docs/docker.sh

@@ -6,3 +6,6 @@ docker run -v "$(pwd)":"/opt/$(basename $(pwd))" -it --cap-add=SYS_PTRACE rocker
 
 # To get httr package:
 apt-get install libssl-dev
+
+
+RD -d "valgrind --tool=memcheck --leak-check=full --track-origins=yes"