Merge branch 'master' into develop

CRAN-SUBMISSION

@@ -0,0 +1,3 @@
+Version: 2.0.1
+Date: 2024-01-22 07:22:47 UTC
+SHA: a1d3ee857fdfb5fc0a3934c82db5507788fbeecb

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_rankings(data)
   validate_initial_values(initial_values, data)

cran-comments.md

@@ -1,15 +1,22 @@
 ## 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.
 
 
 ## Test Environments
+
+* Local Ubuntu 22.04, R 4.3.2, running R CMD check with --use-valgrind option.
+* Local Ubuntu 23.04 with R 4.3.2 built from source with option "--with-valgrind-instrumentation=2", running R CMD check with --use-valgrind option.
+* r-devel-san via rocker/r-devel-san, running R CMD check with --use-valgrind option.
 * r-devel-san via rocker/r-devel-san.
 * local Windows install, R 4.3.2.
 * windows, devel, release and old-release.
 * R-CMD-check via GitHub Actions on windows-latest, macOS-latest, ubuntu-20.04 (release), and ubuntu-20.04 (devel).
+* M1 builder.
 
 ## R CMD CHECK results
 

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"

work-docs/segfault.cpp

@@ -0,0 +1,13 @@
+#include <Rcpp.h>
+using namespace Rcpp;
+
+// [[Rcpp::export]]
+NumericVector ouch() {
+  NumericVector x(10);
+  x[1000000] = 1;
+  return x;
+}
+
+/*** R
+ouch()
+*/