Bugfix (#26)

* Fix warning division * Fix reject syntax * Disable bw specification in add_metrics2_c Because of a bug in scoringRules::logs_sample * Fix global variable note * Add flexibility to test * Update Roxygen * Update stan files * Update workflows
ghurault · Oct 7, 2023 · f6d37d8 · f6d37d8
1 parent de70d71
commit f6d37d8
Show file tree

Hide file tree

Showing 12 changed files with 17 additions and 17 deletions.
diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
@@ -33,7 +33,7 @@ jobs:
 
       - uses: r-lib/actions/setup-pandoc@v1
 
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-r@v2
         with:
           r-version: ${{ matrix.config.r }}
           http-user-agent: ${{ matrix.config.http-user-agent }}

diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml
@@ -17,7 +17,7 @@ jobs:
 
       - uses: r-lib/actions/setup-pandoc@v1
 
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-r@v2
         with:
           use-public-rspm: true
 

diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml
@@ -17,7 +17,7 @@ jobs:
     steps:
       - uses: actions/checkout@v2
 
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-r@v2
         with:
           use-public-rspm: true
 

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -15,7 +15,7 @@ Language: en-GB
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.0
+RoxygenNote: 7.2.3
 Biarch: true
 Depends: 
     R (>= 3.4.0)

diff --git a/R/metrics.R b/R/metrics.R
@@ -170,6 +170,7 @@ add_metrics2_c <- function(df, add_samples = NULL, bw = NULL) {
     stopifnot(is_scalar(bw),
               is.numeric(bw))
     bw <- rep(bw, nrow(df))
+    stop("Specifying bw is disabled because of a bug in the scoringRules package.")
   }
 
   df <- df %>%

diff --git a/R/utils_longitudinal.R b/R/utils_longitudinal.R
@@ -42,7 +42,7 @@ get_index <- function(train, test = NULL) {
   tmp <- full_df %>%
     group_by(.data$Patient) %>%
     summarise(t_max = max(.data$Time)) %>%
-    arrange(Patient)
+    arrange(.data$Patient)
 
   out <- lapply(1:nrow(tmp),
                 function(i) {

diff --git a/inst/stan/SmoothingAR1.stan b/inst/stan/SmoothingAR1.stan
@@ -52,7 +52,7 @@ transformed data {
 
   if (discrete == 1) {
     if (M_int <= 0 || (M_int != M)) {
-      reject("When discrete=TRUE, M should be a stricly positive integer.")
+      reject("When discrete=TRUE, M should be a stricly positive integer.");
     }
     for (i in 1:N_test) {
       yi_test[i] = bin_search(y_test[i], 0, M_int);

diff --git a/inst/stan/include/bin_search.stan b/inst/stan/include/bin_search.stan
@@ -1,15 +1,15 @@
 int bin_search(real x, int min_val, int max_val) {
   // Find the integer equivalent to x between min_val and max_val
 
-  int range = (max_val - min_val + 1) / 2;
+  int range = (max_val - min_val + 1) %/% 2;
   int mid_pt = min_val + range;
   real y = round(x);
 
   while(range > 0) {
     if (y == mid_pt) {
       range = 0;
     } else {
-      range =  (range + 1) / 2;
+      range = (range + 1) %/% 2;
       mid_pt += y > mid_pt ? range: -range;
     }
   }

diff --git a/man/default_prior.Rd b/man/default_prior.Rd
diff --git a/src/Makevars.win b/src/Makevars.win
@@ -2,9 +2,9 @@
 
 STANHEADERS_SRC = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "message()" -e "cat(system.file('include', 'src', package = 'StanHeaders', mustWork = TRUE))" -e "message()" | grep "StanHeaders")
 
-STANC_FLAGS = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "cat(ifelse(utils::packageVersion('rstan') >= 2.26, '-DUSE_STANC3',''))")
-PKG_CPPFLAGS = -I"../inst/include" -I"$(STANHEADERS_SRC)" -DBOOST_DISABLE_ASSERTS -DEIGEN_NO_DEBUG -DRCPP_PARALLEL_USE_TBB=1 $(STANC_FLAGS)
+STANC_FLAGS = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "cat(ifelse(utils::packageVersion('rstan') >= '2.26', '-DUSE_STANC3',''))")
+PKG_CPPFLAGS = -I"../inst/include" -I"$(STANHEADERS_SRC)" -DBOOST_DISABLE_ASSERTS -DEIGEN_NO_DEBUG -DRCPP_PARALLEL_USE_TBB=1 $(STANC_FLAGS) -D_HAS_AUTO_PTR_ETC=0
 PKG_CXXFLAGS = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "RcppParallel::CxxFlags()") $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "StanHeaders:::CxxFlags()")
 PKG_LIBS = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "RcppParallel::RcppParallelLibs()") $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "StanHeaders:::LdFlags()")
 
-CXX_STD = CXX14
+CXX_STD = CXX17
diff --git a/tests/testthat/test-model_MC.R b/tests/testthat/test-model_MC.R
@@ -14,7 +14,7 @@ test_that("sample_prior_MC returns a stanfit object", {
 test_that("estimates from sample_prior_MC are accurate", {
   p_mean <- apply(rstan::extract(fit_prior, pars = "p")[[1]], c(2, 3), mean)
   p_se <- apply(rstan::extract(fit_prior, pars = "p")[[1]], c(2, 3), function(x) {sd(x) / sqrt(length(x))})
-  expect_true(all(abs(c(p_mean) - 1 / K1) < c(p_se) * 2.5)) # cf. default prior is symmetric
+  expect_true(all(abs(c(p_mean) - 1 / K1) < c(p_se) * 3)) # cf. default prior is symmetric
 })
 
 # Test fitting -------------------------------------------------------------

diff --git a/tests/testthat/test-predictions.R b/tests/testthat/test-predictions.R
@@ -52,7 +52,6 @@ test_that("add_uniform_pred returns samples when prompted", {
   for (x in ll) {
     expect_true(all(c("Samples") %in% colnames(x)))
     expect_true(is.list(x[["Samples"]]))
-
   }
   for (x in ll[c(1, 3)]) {
     expect_true(all(vapply(x[["Samples"]], length, numeric(1)) == 50))
@@ -121,8 +120,8 @@ test_that("add_metrics2_c returns a correct dataframe", {
 
   list(
     add_metrics2_c(tmp),
-    add_metrics2_c(tmp, add_samples = 0:RW_setup$max_score),
-    add_metrics2_c(tmp, bw = 1)
+    add_metrics2_c(tmp, add_samples = 0:RW_setup$max_score)#,
+    #add_metrics2_c(tmp, bw = 1)
   ) %>%
     lapply(function(perf) {
       test_when_continuous(select(perf, -Samples),