Merge pull request #23 from weberse2/issue-prep-1-8-0-release

1.8-0 release

DESCRIPTION

@@ -8,8 +8,8 @@ Description: Tool-set to support Bayesian evidence synthesis.  This
     for details on applying this package while Neuenschwander et al. (2010)
     <doi:10.1177/1740774509356002> and Schmidli et al. (2014)
     <doi:10.1111/biom.12242> explain details on the methodology.
-Version: 1.7-4
-Date: 2024-11-21
+Version: 1.8-0
+Date: 2025-01-08
 Authors@R: c(person("Novartis", "Pharma AG", role = "cph")
             ,person("Sebastian", "Weber", email="[email protected]", role=c("aut", "cre"))
             ,person("Beat", "Neuenschwander", email="[email protected]", role="ctb")

Makefile

@@ -49,12 +49,12 @@ all : $(TARGET)
 	cd $(@D); echo running $(RCMD) -e "rmarkdown::render('$(<F)', output_format=rmarkdown::html_document(self_contained=TRUE))"
 	cd $(@D); $(RCMD) -e "rmarkdown::render('$(<F)', output_format=rmarkdown::html_document(self_contained=TRUE))"
 
-tests/%.Rtest : tests/%.R
+tests/%.Rtest : tests/%.R $(R_PKG_SRCS) NAMESPACE
 	NOT_CRAN=true $(RCMD) -e "devtools::load_all()" -e "test_file('$<')" > $@ 2>&1
 	@printf "Test summary for $(<F): "
 	@grep '^\[' $@ | tail -n 1
 
-tests/%.Rtestfast : tests/%.R
+tests/%.Rtestfast : tests/%.R $(R_PKG_SRCS) NAMESPACE
 	NOT_CRAN=false $(RCMD) -e "devtools::load_all()" -e "test_file('$<')" > $@ 2>&1
 	@printf "Test summary for $(<F): "
 	@grep '^\[' $@ | tail -n 1
@@ -181,6 +181,27 @@ retestfast-all : clean-test $(R_TESTFAST_OBJS)
 PHONY += retest-all
 retest-all : clean-test $(R_TEST_OBJS)
 
+PHONY += check-winbuilder-devel
+check-winbuilder-devel : r-source-release
+	cd build; $(RCMD) -e 'target <- tempdir()' \
+			  -e 'untar("$(RPKG)_$(PKG_VERSION).tar.gz", exdir=target)' \
+			  -e 'devtools::check_win_devel(pkg=file.path(target, "RBesT"))'
+
+PHONY += check-winbuilder-release
+check-winbuilder-release : r-source-release
+	cd build; $(RCMD) -e 'target <- tempdir()' \
+			  -e 'untar("$(RPKG)_$(PKG_VERSION).tar.gz", exdir=target)' \
+			  -e 'devtools::check_win_release(pkg=file.path(target, "RBesT"))'
+
+PHONY += check-winbuilder-oldrelease
+check-winbuilder-oldrelease : r-source-release
+	cd build; $(RCMD) -e 'target <- tempdir()' \
+			  -e 'untar("$(RPKG)_$(PKG_VERSION).tar.gz", exdir=target)' \
+			  -e 'devtools::check_win_oldrelease(pkg=file.path(target, "RBesT"))'
+
+PHONY += check-winbuilder
+check-winbuilder : check-winbuilder-devel check-winbuilder-release check-winbuilder-oldrelease
+
 #$(DIR_OBJ)/%.o: %.c $(INCS)
 #    mkdir -p $(@D)
 #    $(CC) -o $@ $(CFLAGS) -c $< $(INC_DIRS)

NEWS.md

@@ -1,3 +1,21 @@
+# RBesT 1.8-0 - January 8th, 2025
+
+## Enhancements
+
+* Enable ESS calculation for normal mixture densities when used in the
+  context of a standard one-parameter exponential family through the
+  new `family` argument. For example, this can be used to calculate
+  the ESS of a normal mixture density representing a logit transformed
+  response scale.
+* Reformat R sources using `styler`.
+
+## Bugfixes
+
+* Correct boundary behavior of `BinaryExactCI` function whenever no
+  responses or no non-responses are observed. Fixes issue #21.
+* Stabilize internal beta mixture information function, which corrects
+  unstable ESS ELIR computations. Addresses issue #22.
+
 # RBesT 1.7-4 - November 21st, 2024
 
 ## Enhancements

R/AS.R

@@ -17,10 +17,11 @@
 #' @template example-start
 #' @examples
 #' set.seed(34563)
-#' map_AS <- gMAP(cbind(r, n-r) ~ 1 | study,
-#'                family=binomial,
-#'                data=AS,
-#'                tau.dist="HalfNormal", tau.prior=1,
-#'                beta.prior=2)
+#' map_AS <- gMAP(cbind(r, n - r) ~ 1 | study,
+#'   family = binomial,
+#'   data = AS,
+#'   tau.dist = "HalfNormal", tau.prior = 1,
+#'   beta.prior = 2
+#' )
 #' @template example-stop
 "AS"

R/BinaryExactCI.R

@@ -3,44 +3,42 @@
 #' This function calculates the exact confidendence interval for a
 #' response rate presented by \eqn{n} and \eqn{r}.
 #'
-#' @param r Number of success or responder 
+#' @param r Number of success or responder
 #' @param n Sample size
 #' @param alpha  confidence level
 #' @param drop Determines if \code{\link{drop}} will be called on the result
-#' 
+#'
 #' @details
-#' Confidence intervals are obtained by a procedure first given in 
-#' Clopper and Pearson (1934). This guarantees that the confidence 
+#' Confidence intervals are obtained by a procedure first given in
+#' Clopper and Pearson (1934). This guarantees that the confidence
 #' level is at least (1-\eqn{\alpha}).
 #'
 #' Details can be found in the publication listed below.
-#' 
+#'
 #' @return 100 (1-\eqn{\alpha})\% exact confidence interval for given
 #' response rate
 #'
 #' @references Clopper, C. J. & Pearson, E. S. The use of confidence or
-#' fiducial limits illustrated in the case of the binomial. Biometrika 1934. 
-#'  
+#' fiducial limits illustrated in the case of the binomial. Biometrika 1934.
+#'
 #' @examples
-#' BinaryExactCI(3,20,0.05)
-#' 
+#' BinaryExactCI(3, 20, 0.05)
+#'
 #' @export
-BinaryExactCI <- function(r, n, alpha=0.05, drop=TRUE) {
-    alpha2 <- alpha/2
-    Low <- alpha2
-    High <- 1-alpha2
-
-    pLow <- qbeta( Low, r+(r==0), n-r+1)
-    pHigh <- qbeta( High, r+1, n-r+((n-r)==0))
+BinaryExactCI <- function(r, n, alpha = 0.05, drop = TRUE) {
+  alpha2 <- alpha / 2
+  Low <- alpha2
+  High <- 1 - alpha2
 
-    nms <- c( paste(round(100*Low,1),"%",sep=""),paste(round(100*High,1),"%",sep="") )
+  pLow <- qbeta(Low, r, n - r + 1)
+  pHigh <- qbeta(High, r + 1, n - r)
 
-    CI <- cbind(pLow,pHigh)
-    colnames(CI) <- nms
+  nms <- c(paste(round(100 * Low, 1), "%", sep = ""), paste(round(100 * High, 1), "%", sep = ""))
 
-    if(drop) CI <- drop(CI)
-
-    return( CI )
-}
+  CI <- cbind(pLow, pHigh)
+  colnames(CI) <- nms
 
+  if (drop) CI <- drop(CI)
 
+  return(CI)
+}

R/Curry.R

@@ -1,10 +1,9 @@
 #' Functional programming utilities
-#' 
+#'
 #' function from functional
-#' 
+#'
 #' @keywords internal
-Curry <- function (FUN, ...) 
-{
-    .orig = list(...)
-    function(...) do.call(FUN, c(.orig, list(...)))
+Curry <- function(FUN, ...) {
+  .orig <- list(...)
+  function(...) do.call(FUN, c(.orig, list(...)))
 }