Add tests for GSL seed and OpenMP thread change. Fix memory leak issu…

…es identified by valgrind due to GSL seed. Fixed issue with inconsistent test results

.Rbuildignore

@@ -1,4 +1,5 @@
 ^.*\.Rproj$
+^.*\.Rcheck$
 ^\.DS_Store$
 ^\.(RData|Rhistory|RProj\.user)$
 ^\.gitignore$

.github/workflows/builds.yml

@@ -11,8 +11,8 @@ name: Valgrind Check
 on:
   pull_request:
     branches: [ "main" ]
-  # push:
-  #   branches: [ "github-actions-build" ]
+  push:
+    branches: [ "seeder-valgrind" ]
   workflow_dispatch: 
 
 

.github/workflows/sanitizer.yml

@@ -3,8 +3,6 @@ name: UBSAN/ASAN Checks
 on:
   pull_request:
     branches: [ "main" ]
-  push:
-    branches: [ "github-actions-build", "brian-bk22-plotting-patch", "bounds-check-testing" ]
   workflow_dispatch: 
 
 

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: ToxicR
 Type: Package
 Title: Analyzing Toxicology Dose-Response Data
-Version: 24.1.1.2.1
-Date: 2024-07-02
+Version: 24.1.1.2.2
+Date: 2024-07-17
 Authors@R: 
     c(
     person(given = "Matt",

R/RcppExports.R

@@ -5,32 +5,32 @@
     .Call(`_ToxicR_owenst_fn`, x, fx)
 }
 
-.run_single_dichotomous <- function(model, data, pr, options1, options2) {
-    .Call(`_ToxicR_run_single_dichotomous`, model, data, pr, options1, options2)
+.run_single_dichotomous <- function(model, data, pr, options1, options2, seed) {
+    .Call(`_ToxicR_run_single_dichotomous`, model, data, pr, options1, options2, seed)
 }
 
-.run_continuous_single <- function(model, Y, X, prior, options, dist_type) {
-    .Call(`_ToxicR_run_continuous_single`, model, Y, X, prior, options, dist_type)
+.run_continuous_single <- function(model, Y, X, prior, options, dist_type, seed) {
+    .Call(`_ToxicR_run_continuous_single`, model, Y, X, prior, options, dist_type, seed)
 }
 
-.run_continuous_ma_laplace <- function(model_priors, model_type, dist_type, Y, X, options) {
-    .Call(`_ToxicR_run_continuous_ma_laplace`, model_priors, model_type, dist_type, Y, X, options)
+.run_continuous_ma_laplace <- function(model_priors, model_type, dist_type, Y, X, options, seed) {
+    .Call(`_ToxicR_run_continuous_ma_laplace`, model_priors, model_type, dist_type, Y, X, options, seed)
 }
 
-.run_continuous_ma_mcmc <- function(model_priors, model_type, dist_type, Y, X, options) {
-    .Call(`_ToxicR_run_continuous_ma_mcmc`, model_priors, model_type, dist_type, Y, X, options)
+.run_continuous_ma_mcmc <- function(model_priors, model_type, dist_type, Y, X, options, seed) {
+    .Call(`_ToxicR_run_continuous_ma_mcmc`, model_priors, model_type, dist_type, Y, X, options, seed)
 }
 
-.run_ma_dichotomous <- function(data, priors, models, model_p, is_MCMC, options1, options2) {
-    .Call(`_ToxicR_run_ma_dichotomous`, data, priors, models, model_p, is_MCMC, options1, options2)
+.run_ma_dichotomous <- function(data, priors, models, model_p, is_MCMC, options1, options2, seed) {
+    .Call(`_ToxicR_run_ma_dichotomous`, data, priors, models, model_p, is_MCMC, options1, options2, seed)
 }
 
-.run_dichotomous_single_mcmc <- function(model, Y, D, pr, options) {
-    .Call(`_ToxicR_run_dichotomous_single_mcmc`, model, Y, D, pr, options)
+.run_dichotomous_single_mcmc <- function(model, Y, D, pr, options, seed) {
+    .Call(`_ToxicR_run_dichotomous_single_mcmc`, model, Y, D, pr, options, seed)
 }
 
-.run_continuous_single_mcmc <- function(model, Y, D, priors, options, is_logNormal, suff_stat) {
-    .Call(`_ToxicR_run_continuous_single_mcmc`, model, Y, D, priors, options, is_logNormal, suff_stat)
+.run_continuous_single_mcmc <- function(model, Y, D, priors, options, is_logNormal, suff_stat, seed) {
+    .Call(`_ToxicR_run_continuous_single_mcmc`, model, Y, D, priors, options, is_logNormal, suff_stat, seed)
 }
 
 .polykCPP <- function(dose, tumor, daysOnStudy) {

R/continuous_wrappers.R

@@ -123,7 +123,6 @@ single_continuous_fit <- function(D,Y,model_type="hill", fit_type = "laplace",
                                    alpha = 0.05, samples = 25000, degree=2,
                                    burnin = 1000, BMD_priors = FALSE, ewald = FALSE,
                                    transform = FALSE, BMD_TYPE = NA, threads = 2, seed = 12331){
-    .setseedGSL(seed)
     Y <- as.matrix(Y) 
     D <- as.matrix(D) 
 
@@ -362,7 +361,7 @@ single_continuous_fit <- function(D,Y,model_type="hill", fit_type = "laplace",
 
       .set_threads(threads)
       rvals <- .run_continuous_single_mcmc(fitmodel,model_data$SSTAT,model_data$X,
-                                          PR ,options, is_log_normal, sstat) 
+                                          PR ,options, is_log_normal, sstat, seed) 
 
       if (model_type == "exp-3"){
         rvals$PARMS = rvals$PARMS[,-3]
@@ -418,7 +417,7 @@ single_continuous_fit <- function(D,Y,model_type="hill", fit_type = "laplace",
       options[7] <- (ewald == TRUE)*1
       .set_threads(threads)
       rvals   <- .run_continuous_single(fitmodel,model_data$SSTAT,model_data$X,
-  						                          PR,options, dist_type)
+  						                          PR,options, dist_type, seed)
 
       rvals$bmd_dist = rvals$bmd_dist[!is.infinite(rvals$bmd_dist[,1]),,drop=F]
       rvals$bmd_dist = rvals$bmd_dist[!is.na(rvals$bmd_dist[,1]),,drop=F]

R/dichotomous_wrappers.R

@@ -57,7 +57,6 @@ single_dichotomous_fit <- function(D, Y, N, model_type, fit_type = "laplace",
                                    prior = NULL, BMR = 0.1,
                                    alpha = 0.05, degree = 2, samples = 21000,
                                    burnin = 1000, threads=2, seed = 12331) {
-  .setseedGSL(seed)
   Y <- as.matrix(Y)
   D <- as.matrix(D)
   N <- as.matrix(N)
@@ -115,7 +114,7 @@ single_dichotomous_fit <- function(D, Y, N, model_type, fit_type = "laplace",
   if (fitter == 1) { # MLE fit
     bounds <- .bmd_default_frequentist_settings(model_type, degree)
     .set_threads(threads)
-    temp <- .run_single_dichotomous(dmodel, DATA, bounds, o1, o2)
+    temp <- .run_single_dichotomous(dmodel, DATA, bounds, o1, o2, seed)
     # class(temp$bmd_dist) <- "BMD_CDF"
     temp_me <- temp$bmd_dist
 
@@ -137,7 +136,7 @@ single_dichotomous_fit <- function(D, Y, N, model_type, fit_type = "laplace",
 
   if (fitter == 2) { # laplace fit
     .set_threads(threads)
-    temp <- .run_single_dichotomous(dmodel, DATA, prior$priors, o1, o2)
+    temp <- .run_single_dichotomous(dmodel, DATA, prior$priors, o1, o2, seed)
     # class(temp$bmd_dist) <- "BMD_CDF"
     temp_me <- temp$bmd_dist
     temp_me <- temp_me[!is.infinite(temp_me[, 1]), ]
@@ -159,7 +158,7 @@ single_dichotomous_fit <- function(D, Y, N, model_type, fit_type = "laplace",
     .set_threads(threads)
     temp <- .run_dichotomous_single_mcmc(
       dmodel, DATA[, 2:3, drop = F], DATA[, 1, drop = F], prior$priors,
-      c(BMR, alpha, samples, burnin)
+      c(BMR, alpha, samples, burnin), seed
     )
     # class(temp$fitted_model$bmd_dist) <- "BMD_CDF"
     temp$bmd_dist <- cbind(quantile(temp$mcmc_result$BMD_samples, seq(0.005, 0.995, 0.005),na.rm=TRUE), seq(0.005, 0.995, 0.005))

R/model_averaging_fits.R

@@ -50,19 +50,17 @@ ma_continuous_fit <- function(D, Y, model_list = NA, fit_type = "laplace",
                               BMR_TYPE = "sd", BMR = 0.1, point_p = 0.01,
                               alpha = 0.05, EFSA = TRUE, samples = 21000,
                               burnin = 1000, BMD_TYPE = NA, threads=2, seed = 12331) {
-  .setseedGSL(seed)
+  # .setseedGSL(seed)
   myD <- Y
   Y <- as.matrix(Y)
   D <- as.matrix(D)
-
   is_neg <- .check_negative_response(Y)
 
   DATA <- cbind(D, Y)
   test <- .check_for_na(DATA)
   Y <- Y[test == TRUE, , drop = F]
   D <- D[test == TRUE, , drop = F]
   DATA <- cbind(D, Y)
-
   current_models <- c("hill", "exp-3", "exp-5", "power", "FUNL", "exp-aerts", "invexp-aerts", 
         "gamma-aerts", "invgamma-aerts", "hill-aerts", "lomax-aerts", "invlomax-aerts", "lognormal-aerts",
         "logskew-aerts", "invlogskew-aerts", "logistic-aerts", "probit-aerts", "LMS", "gamma-efsa")
@@ -185,7 +183,6 @@ ma_continuous_fit <- function(D, Y, model_list = NA, fit_type = "laplace",
     dlists[ii] <- which(prior_list[[ii]]$dist == current_dists)
   }
 
-
   ###################
   DATA <- cbind(D, Y)
   if (ncol(DATA) == 4) {
@@ -226,7 +223,7 @@ ma_continuous_fit <- function(D, Y, model_list = NA, fit_type = "laplace",
   if (fit_type == "mcmc") {
     temp_r <- .run_continuous_ma_mcmc(
       priors, models, dlists, Y, D,
-      options
+      options, seed
     )
     tempn <- temp_r$ma_results
 
@@ -315,7 +312,7 @@ ma_continuous_fit <- function(D, Y, model_list = NA, fit_type = "laplace",
   } else {
     temp <- .run_continuous_ma_laplace(
       priors, models, dlists, Y, D,
-      options
+      options, seed
     )
     t_names <- names(temp)
 
@@ -516,7 +513,7 @@ ma_dichotomous_fit <- function(D, Y, N, model_list = integer(0), fit_type = "lap
     # Laplace Run
     temp <- .run_ma_dichotomous(
       data, priors, model_i,
-      model_p, FALSE, o1, o2
+      model_p, FALSE, o1, o2, seed
     )
     # clean up the run
     temp$ma_bmd <- temp$BMD_CDF
@@ -579,7 +576,7 @@ ma_dichotomous_fit <- function(D, Y, N, model_list = integer(0), fit_type = "lap
     # MCMC run
     temp_r <- .run_ma_dichotomous(
       data, priors, model_i,
-      model_p, TRUE, o1, o2
+      model_p, TRUE, o1, o2, seed
     )
     tempn <- temp_r$ma_results
     tempm <- temp_r$mcmc_runs

R/opening_messages.R

@@ -25,7 +25,7 @@
     | |/ _ \\ \\/ / |/ __|  _  /
     | | (_) >  <| | (__| | \\ \\
     |_|\\___/_/\\_\\_|\\___|_|  \\_\\
-                           24.1.1.2.1
+                           24.1.1.2.2
     ___
     | |
     / \\                   ____()()

src/Makevars.in

@@ -1,6 +1,8 @@
-PKG_CXXFLAGS=  -I./code_base -I./include @OPENMP@ @NLOPT_CPPFLAGS@ @GSL_CPPFLAGS@ -DR_COMPILATION
-PKG_LIBS= $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) @NLOPT_LIBS@  @GSL_LIBS@ @OPENMP@
-# CXXFLAGS+=-Wno-ignored-attributes -DEIGEN_PERMANENTLY_DISABLE_STUPID_WARNINGS
+PKG_CXXFLAGS=-I./code_base -I./include @OPENMP@ @NLOPT_CPPFLAGS@ @GSL_CPPFLAGS@ -DR_COMPILATION
+PKG_LIBS=$(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) @NLOPT_LIBS@  @GSL_LIBS@ @OPENMP@
+
+# Debug / clear eigen warnings from compilation 
+#PKG_CXXFLAGS+=-Wno-ignored-attributes -DEIGEN_PERMANENTLY_DISABLE_STUPID_WARNINGS -DToxicR_DEBUG
 # Include all C++ files in src/ and its subdirectories
 SOURCES=@SRC_SOURCES@ @SUBDIR_SOURCES@
 

src/Makevars.ucrt

@@ -1,7 +1,7 @@
-PKG_CXXFLAGS+=-I./code_base -I./include $(SHLIB_OPENMP_CXXFLAGS) -I$(R_TOOLS_SOFT)/include/nlopt -I$(R_TOOLS_SOFT)/include/gsl -DR_COMPILATION -ftree-vectorize -Os
-PKG_LIBS+=$(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(SHLIB_OPENMP_CXXFLAGS) -lgsl -lgslcblas -lnlopt
-# CXXFLAGS+=-Wno-ignored-attributes -DEIGEN_PERMANENTLY_DISABLE_STUPID_WARNINGS
-
+PKG_CXXFLAGS=-I./code_base -I./include $(SHLIB_OPENMP_CXXFLAGS) -I$(R_TOOLS_SOFT)/include/nlopt -I$(R_TOOLS_SOFT)/include/gsl -DR_COMPILATION -ftree-vectorize -Os
+PKG_LIBS=$(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(SHLIB_OPENMP_CXXFLAGS) -lgsl -lgslcblas -lnlopt 
+# Debug / clear eigen warnings from compilation 
+#PKG_CXXFLAGS+=-Wno-ignored-attributes -DEIGEN_PERMANENTLY_DISABLE_STUPID_WARNINGS -DToxicR_DEBUG
 
 POLYK        = $(wildcard polyK/*.cpp)
 MAIN         = $(wildcard *.cpp)

src/Makevars.win

@@ -1,8 +1,7 @@
-PKG_CPPFLAGS+=-I../windows/gsl-2.7/include -I../windows/nlopt-2.7.1/include  -I./ -I./code_base  -I./include -DR_COMPILATION -ftree-vectorize -Os 
-PKG_LIBS+=-L../windows/nlopt-2.7.1/lib${R_ARCH}${CRT}  -L../windows/gsl-2.7/lib${R_ARCH}${CRT} -lgsl -lgslcblas -lnlopt
-
-# CXXFLAGS+=-Wno-ignored-attributes -DEIGEN_PERMANENTLY_DISABLE_STUPID_WARNINGS
-
+PKG_CPPFLAGS=-I../windows/gsl-2.7/include -I../windows/nlopt-2.7.1/include  -I./ -I./code_base  -I./include -DR_COMPILATION -ftree-vectorize -Os
+PKG_LIBS=-L../windows/nlopt-2.7.1/lib${R_ARCH}${CRT}  -L../windows/gsl-2.7/lib${R_ARCH}${CRT} -lgsl -lgslcblas -lnlopt
+# Debug / clear eigen warnings from compilation 
+#PKG_CPPFLAGS += -Wno-ignored-attributes -DEIGEN_PERMANENTLY_DISABLE_STUPID_WARNINGS -DToxicR_DEBUG -g -O0
 
 POLYK        = $(wildcard polyK/*.cpp)
 MAIN         = $(wildcard *.cpp)