v2.7.6

.github/workflows/r.yml

@@ -44,13 +44,13 @@ jobs:
           http-user-agent: ${{ matrix.config.http-user-agent }}
           use-public-rspm: true
 
-      - name: Cache R packages
-        uses: actions/cache@v3
-        with:
-          path: ${{ env.R_LIBS_USER }}
-          key: ${{ runner.os }}-r-${{ matrix.config.r }}-${{ hashFiles('DESCRIPTION') }}
-          restore-keys: |
-            ${{ runner.os }}-r-${{ matrix.config.r }}-
+#      - name: Cache R packages
+#        uses: actions/cache@v3
+#        with:
+#          path: ${{ env.R_LIBS_USER }}
+#          key: ${{ runner.os }}-r-${{ matrix.config.r }}-${{ hashFiles('DESCRIPTION') }}
+#          restore-keys: |
+#            ${{ runner.os }}-r-${{ matrix.config.r }}-
       - name: Install dependencies
         run: |
           install.packages(c("sandwich", "CVXR", "multcomp", "gridExtra", "isotone", 

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: bmd
 Type: Package
 Title: Benchmark dose estimation for dose-response data
-Version: 2.7.5
+Version: 2.7.6
 Date: 2025-03-24
 Author: Signe M.Jensen, Christian Ritz and Jens Riis Baalkilde
 Maintainer: Signe M. Jensen <smj@plen.ku.dk>
@@ -36,7 +36,7 @@ Encoding: UTF-8
 LazyData: true
 Config/testthat/edition: 3
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
 Depends: 
     R (>= 3.5)
 VignetteBuilder: knitr
+Config/roxygen2/version: 8.1.0

NAMESPACE

@@ -43,37 +43,42 @@ import(dplyr)
 import(drc)
 import(ggplot2)
 importFrom(graphics,lines)
-importFrom(stats,AIC)
-importFrom(stats,BIC)
-importFrom(stats,aggregate)
-importFrom(stats,approx)
-importFrom(stats,as.formula)
-importFrom(stats,coef)
-importFrom(stats,complete.cases)
-importFrom(stats,confint)
-importFrom(stats,constrOptim)
-importFrom(stats,df.residual)
-importFrom(stats,dnorm)
-importFrom(stats,fitted)
-importFrom(stats,lm)
-importFrom(stats,logLik)
-importFrom(stats,model.frame)
-importFrom(stats,model.matrix)
-importFrom(stats,optim)
-importFrom(stats,pnorm)
-importFrom(stats,predict)
-importFrom(stats,qchisq)
-importFrom(stats,qnorm)
-importFrom(stats,qt)
-importFrom(stats,quantile)
-importFrom(stats,rbinom)
-importFrom(stats,resid)
-importFrom(stats,residuals)
-importFrom(stats,rnorm)
-importFrom(stats,sd)
-importFrom(stats,uniroot)
-importFrom(stats,update)
-importFrom(stats,var)
-importFrom(stats,vcov)
-importFrom(utils,setTxtProgressBar)
-importFrom(utils,txtProgressBar)
+importFrom(stats,
+  AIC,
+  BIC,
+  aggregate,
+  approx,
+  as.formula,
+  coef,
+  complete.cases,
+  confint,
+  constrOptim,
+  df.residual,
+  dnorm,
+  fitted,
+  lm,
+  logLik,
+  model.frame,
+  model.matrix,
+  optim,
+  pnorm,
+  predict,
+  qchisq,
+  qnorm,
+  qt,
+  quantile,
+  rbinom,
+  resid,
+  residuals,
+  rnorm,
+  sd,
+  uniroot,
+  update,
+  var,
+  vcov
+)
+importFrom(utils,
+  packageVersion,
+  setTxtProgressBar,
+  txtProgressBar
+)

R/bmd-package.R

@@ -11,7 +11,7 @@
 #' @importFrom stats lm model.frame model.matrix optim pnorm predict
 #' @importFrom stats qchisq qnorm qt quantile rbinom resid residuals
 #' @importFrom stats rnorm sd uniroot update var vcov AIC BIC logLik
-#' @importFrom utils setTxtProgressBar txtProgressBar
+#' @importFrom utils setTxtProgressBar txtProgressBar packageVersion
 #'
 #' @name bmd-package
 #' @aliases bmd-package

R/bmdMA.R

@@ -285,8 +285,8 @@ bmdMA <- function(modelList, modelWeights, bmr,
       modelWeights0 <- modelWeights
     }
 
-    if(identical(modelList[[1]]$type,"continuous")){
-      my.fun<-function(x,y){drm(y$call$formula, data = x, fct = y[["fct"]])}
+    if(identical(modelList[[1]]$type,"continuous") | identical(modelList[[1]]$type,"Poisson")){
+      my.fun<-function(x,y){drm(y$call$formula, data = x, fct = y[["fct"]], type = y[["type"]])}
 
       if(identical(type,"Kang")){
         maBMD <- sum(modelWeights0 * sapply(bmdList, function(x){x$Results[,1]}))
@@ -321,7 +321,7 @@ bmdMA <- function(modelList, modelWeights, bmr,
 
         bmdMAboot <- function(data){
           bootModelList <- lapply(modelList, function(model) try(
-            eval(substitute(drm(formula = formula0, data = data, fct = model$fct, weights = weights0, start = start0,
+            eval(substitute(drm(formula = formula0, data = data, fct = model$fct, type = model$type, weights = weights0, start = start0,
                                 control = drmc(noMessage = TRUE)),
                             list(formula0 = model$call$formula, 
                                  weights0 = model$call$weights,
@@ -723,6 +723,7 @@ bmdMA <- function(modelList, modelWeights, bmr,
         }
       }
     }
+
   } 
 
   if (nCurves > 1){
@@ -755,7 +756,7 @@ bmdMA <- function(modelList, modelWeights, bmr,
         modelWeights0 <- modelWeights
       }
 
-      if(identical(modelList[[1]]$type,"continuous")){
+      if(identical(modelList[[1]]$type,"continuous") | identical(modelList[[1]]$type,"Poisson")){
         if(identical(type,"Kang")){
           maBMD <- colSums(modelWeights0 * t(sapply(bmdList, function(x) x$Results[,1])))
           maBMDL <- colSums(modelWeights0 * t(sapply(bmdList, function(x) x$interval[,1])))
@@ -1274,6 +1275,7 @@ bmdMA <- function(modelList, modelWeights, bmr,
           }
         }
       }
+
     } else {
       # CURVES FITTED INDEPENDENTLY
       modelListList <- lapply(1:length(modelList[[1]]$objList), function(i) lapply(modelList, function(object) object$objList[[i]]))

R/getStackingWeights.R

@@ -57,8 +57,8 @@ computeWeightsFromSplit <- function(trainData, validateData, modelList){
     objective <- CVXR::Minimize(sum((predMatrix %*% alphaHat - validateData[[as.character(modelList[[1]]$call$formula[[2]][[2]])]])^2))
   }
   problem <- CVXR::Problem(objective, constraints = list(alphaHat <= 1, alphaHat >= 0,sum(alphaHat) == 1))
-  result <- CVXR::solve(problem)
-  res <- result$getValue(alphaHat)
+  opt_value <- CVXR::psolve(problem) # solves the constrained optimisation problem
+  res <- CVXR::value(alphaHat) # returns the value of alpha under the constrained optimisation
 
   # Initialise weights to zero
   tmpWeights <- numeric(length(modelList))
@@ -245,6 +245,10 @@ getStackingWeights <- function(modelList, nSplits = 2){
     stop('package "CVXR" must be installed to estimate stacking weights')
   }
 
+  if (packageVersion("CVXR") < "1.8.0") {
+    stop("Please update CVXR. Version 1.8.0 or newer is required.")
+  }
+
   if(nSplits %in% c("LOO")){
     nSplits <- ifelse(modelList[[1]]$type == "binomial", sum(modelList[[1]]$data$weights), modelList[[1]]$sumList$lenData)
   } else if(!is.numeric(nSplits)){

R/qplotDrc.R

@@ -395,7 +395,7 @@ qplotDrc <- function(x, add = FALSE, level = NULL, type = c("average", "all", "b
       obsLayer +
       scale_x_continuous(trans = xtrans, limits = xLimits) +
       scale_y_continuous(trans = ytrans, limits = yLimits) +
-      labs(x = xlab, y = ylab, col = "", fill = "", shape = "", linetype = "")
+      labs(x = xlab, y = ylab, col = NULL, fill = NULL, shape = NULL, linetype = NULL)
   } else {
     list(
       confBandLayer = confBandLayer,

tests/testthat/test-bmd.R

@@ -1523,8 +1523,8 @@ test_that("bmd function works on drcMMRE object", {
   bmdMMRE <- bmd(modMMRE, bmr = 0.1, backgType = "modelBased", def = "relative", display = FALSE)
 
   expect_true(all(!is.na(bmdMMRE$Results[, "BMD"])))
-  expect_equal(bmdMMRE$Results[, "BMD"], 1.66913593445629)
-  expect_equal(bmdMMRE$bmrScaled[,1], 9.15712352078559)
+  expect_equal(bmdMMRE$Results[, "BMD"], 1.66913593445629, tolerance = 1e-6)
+  expect_equal(bmdMMRE$bmrScaled[,1], 9.15712352078559, tolerance = 1e-6)
   expect_equal(unname(bmdMMRE$bmrScaled[,1]), drop(modMMRE$curve[[1]](bmdMMRE$Results[, "BMD"])))
   expect_equal(bmdMMRE$interval[1,], c(Lower = 1.3166277025622, Upper = 2.02164416635037), tolerance = 1e-4)
   expect_equal(bmdMMRE$SE[,"SE"], 0.214309787885148, tolerance = 1e-4)