Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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="sebastian.weber@novartis.com", role=c("aut", "cre"))
,person("Beat", "Neuenschwander", email="beat.neuenschwander@novartis.com", role="ctb")
Expand Down
25 changes: 23 additions & 2 deletions Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down
18 changes: 18 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -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
Expand Down
11 changes: 6 additions & 5 deletions R/AS.R
Original file line number Diff line number Diff line change
Expand Up @@ -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"
44 changes: 21 additions & 23 deletions R/BinaryExactCI.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}
11 changes: 5 additions & 6 deletions R/Curry.R
Original file line number Diff line number Diff line change
@@ -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(...)))
}
Loading
Loading