Merge pull request #187 from Merck/issue-185

Fix issues identified by CRAN

Author: LittleBeannie

.Rbuildignore

@@ -1,5 +1,6 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
+^data-raw$
 ^_pkgdown\.yml$
 ^pkgdown$
 ^docs$
@@ -11,3 +12,4 @@
 ^\.lintr$
 ^vignettes/articles$
 ^inst/check_with_old_version/.*\.html$
+^cran-comments\.md$

.lintr

@@ -10,10 +10,7 @@ linters:
 exclusions:
     list(
       "inst/",
-      "R/gridpts_h1_hupdate.R" = list(
-        object_name_linter = Inf
-      ),
-      "tests/testthat/fixtures/simu_test_gs_design_combo.R" = list(
+      "data-raw/simu_test_gs_design_combo.R" = list(
         object_name_linter = Inf,
         commented_code_linter = Inf
       ),

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gsDesign2
 Title: Group Sequential Design with Non-Constant Effect
-Version: 1.0.5
+Version: 1.0.6
 Authors@R: c(
     person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut")),
     person("Yilong", "Zhang", email = "elong0527@gmail.com", role = c("aut")),

NAMESPACE

@@ -12,7 +12,9 @@ export(expected_accrual)
 export(expected_event)
 export(expected_time)
 export(fixed_design)
+export(gridpts)
 export(gs_b)
+export(gs_create_arm)
 export(gs_design_ahr)
 export(gs_design_combo)
 export(gs_design_npe)
@@ -29,6 +31,8 @@ export(gs_power_rd)
 export(gs_power_wlr)
 export(gs_spending_bound)
 export(gs_spending_combo)
+export(h1)
+export(hupdate)
 export(ppwe)
 export(s2pwe)
 export(to_integer)

NEWS.md

@@ -1,3 +1,12 @@
+# gsDesign2 1.0.6
+
+## Improvements
+
+- Export functions `gridpts()`, `h1()`, `hupdate()`, and `gs_create_arm()`
+  to avoid the use of `:::` in code examples.
+- Fix the write path issue by moving the test fixture generation script to
+  `data-raw/` which is not included in the package.
+
 # gsDesign2 1.0.5
 
 First submission to CRAN in March 2023.

R/gridpts_h1_hupdate.R

@@ -51,7 +51,7 @@
 #' }
 #' \if{html}{The contents of this section are shown in PDF user manual only.}
 #'
-#' @noRd
+#' @export
 #'
 #' @examples
 #' # Approximate variance of standard normal (i.e., 1)
@@ -71,7 +71,7 @@ gridpts <- function(r = 18, mu = 0, a = -Inf, b = Inf) {
 #'
 #' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull.
 #' @param theta Drift parameter for first analysis.
-#' @param I Information at first analysis.
+#' @param info Information at first analysis.
 #' @param a Lower limit of integration (scalar).
 #' @param b Upper limit of integration (scalar `> a`).
 #'
@@ -93,19 +93,19 @@ gridpts <- function(r = 18, mu = 0, a = -Inf, b = Inf) {
 #' }
 #' \if{html}{The contents of this section are shown in PDF user manual only.}
 #'
-#' @noRd
+#' @export
 #'
 #' @examples
 #' # Replicate variance of 1, mean of 35
-#' g <- h1(theta = 5, I = 49)
+#' g <- h1(theta = 5, info = 49)
 #' mu <- sum(g$z * g$h)
 #' var <- sum((g$z - mu)^2 * g$h)
 #'
 #' # Replicate p-value of 0.0001 by numerical integration of tail
 #' g <- h1(a = qnorm(0.9999))
 #' sum(g$h)
-h1 <- function(r = 18, theta = 0, I = 1, a = -Inf, b = Inf) {
-  h1_rcpp(r = r, theta = theta, I = I, a = a, b = b)
+h1 <- function(r = 18, theta = 0, info = 1, a = -Inf, b = Inf) {
+  h1_rcpp(r = r, theta = theta, I = info, a = a, b = b)
 }
 
 #' Update numerical integration for group sequential design
@@ -114,12 +114,18 @@ h1 <- function(r = 18, theta = 0, I = 1, a = -Inf, b = Inf) {
 #'
 #' @param r Integer, at least 2; default of 18 recommended by Jennison and Turnbull.
 #' @param theta Drift parameter for current analysis.
-#' @param I Information at current analysis.
+#' @param info Information at current analysis.
 #' @param a Lower limit of integration (scalar).
 #' @param b Upper limit of integration (scalar `> a`).
 #' @param thetam1 Drift parameter for previous analysis.
-#' @param Im1 Information at previous analysis.
+#' @param im1 Information at previous analysis.
 #' @param gm1 Numerical integration grid from [h1()] or previous run of [hupdate()].
+#'
+#' @return A list with grid points in `z`,
+#'   numerical integration weights in `w`,
+#'   a normal density with mean `mu = theta * sqrt{I}`
+#'   and variance 1 times the weight in `h`.
+#'
 #' @section Specification:
 #' \if{latex}{
 #'  \itemize{
@@ -131,18 +137,13 @@ h1 <- function(r = 18, theta = 0, I = 1, a = -Inf, b = Inf) {
 #' }
 #' \if{html}{The contents of this section are shown in PDF user manual only.}
 #'
-#' @return A list with grid points in `z`,
-#'   numerical integration weights in `w`,
-#'   a normal density with mean `mu = theta * sqrt{I}`
-#'   and variance 1 times the weight in `h`.
-#'
-#' @noRd
+#' @export
 #'
 #' @examples
 #' # 2nd analysis with no interim bound and drift 0 should have mean 0, variance 1
 #' g <- hupdate()
 #' mu <- sum(g$z * g$h)
 #' var <- sum((g$z - mu)^2 * g$h)
-hupdate <- function(r = 18, theta = 0, I = 2, a = -Inf, b = Inf, thetam1 = 0, Im1 = 1, gm1 = h1()) {
-  hupdate_rcpp(r = r, theta = theta, I = I, a = a, b = b, thetam1 = thetam1, Im1 = Im1, gm1 = gm1)
+hupdate <- function(r = 18, theta = 0, info = 2, a = -Inf, b = Inf, thetam1 = 0, im1 = 1, gm1 = h1()) {
+  hupdate_rcpp(r = r, theta = theta, I = info, a = a, b = b, thetam1 = thetam1, Im1 = im1, gm1 = gm1)
 }

R/gs_power_npe.R

@@ -297,19 +297,19 @@ gs_power_npe <- function(theta = .1, theta0 = NULL, theta1 = NULL, # 3 theta
         0
       }
       # update the grids
-      hgm1_0 <- h1(r = r, theta = theta0[1], I = info0[1], a = if (binding) {
+      hgm1_0 <- h1(r = r, theta = theta0[1], info = info0[1], a = if (binding) {
         a[1]
       } else {
         -Inf
       }, b = b[1])
-      hgm1_1 <- h1(r = r, theta = theta1[1], I = info1[1], a = a[1], b = b[1])
-      hgm1 <- h1(r = r, theta = theta[1], I = info[1], a = a[1], b = b[1])
+      hgm1_1 <- h1(r = r, theta = theta1[1], info = info1[1], a = a[1], b = b[1])
+      hgm1 <- h1(r = r, theta = theta[1], info = info[1], a = a[1], b = b[1])
     } else {
       # compute the probability to cross upper bound
       upper_prob[k] <- if (b[k] < Inf) {
         sum(hupdate(
           theta = theta[k], thetam1 = theta[k - 1],
-          I = info[k], Im1 = info[k - 1],
+          info = info[k], im1 = info[k - 1],
           a = b[k], b = Inf, gm1 = hgm1, r = r
         )$h)
       } else {
@@ -319,7 +319,7 @@ gs_power_npe <- function(theta = .1, theta0 = NULL, theta1 = NULL, # 3 theta
       lower_prob[k] <- if (a[k] > -Inf) {
         sum(hupdate(
           theta = theta[k], thetam1 = theta[k - 1],
-          I = info[k], Im1 = info[k - 1],
+          info = info[k], im1 = info[k - 1],
           a = -Inf, b = a[k], gm1 = hgm1, r = r
         )$h)
       } else {
@@ -328,20 +328,20 @@ gs_power_npe <- function(theta = .1, theta0 = NULL, theta1 = NULL, # 3 theta
 
       # update the grids
       if (k < n_analysis) {
-        hgm1_0 <- hupdate(r = r, theta = theta0[k], I = info0[k], a = if (binding) {
+        hgm1_0 <- hupdate(r = r, theta = theta0[k], info = info0[k], a = if (binding) {
           a[k]
         } else {
           -Inf
-        }, b = b[k], thetam1 = 0, Im1 = info0[k - 1], gm1 = hgm1_0)
+        }, b = b[k], thetam1 = 0, im1 = info0[k - 1], gm1 = hgm1_0)
         hgm1_1 <- hupdate(
-          r = r, theta = theta1[k], I = info1[k],
+          r = r, theta = theta1[k], info = info1[k],
           a = a[k], b = b[k], thetam1 = theta1[k - 1],
-          Im1 = info1[k - 1], gm1 = hgm1_1
+          im1 = info1[k - 1], gm1 = hgm1_1
         )
         hgm1 <- hupdate(
-          r = r, theta = theta[k], I = info[k],
+          r = r, theta = theta[k], info = info[k],
           a = a[k], b = b[k], thetam1 = theta[k - 1],
-          Im1 = info[k - 1], gm1 = hgm1
+          im1 = info[k - 1], gm1 = hgm1
         )
       }
     }

R/gs_spending_bound.R

@@ -105,13 +105,13 @@
 #' a2 <- gs_spending_bound(
 #'   k = 2, efficacy = FALSE, theta = 0,
 #'   par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, timing = info_frac, param = NULL),
-#'   hgm1 = gsDesign2:::h1(r = 18, theta = 0, I = info[1], a = a1, b = b1)
+#'   hgm1 = h1(r = 18, theta = 0, info = info[1], a = a1, b = b1)
 #' )
 #'
 #' b2 <- gs_spending_bound(
 #'   k = 2, efficacy = TRUE, theta = 0,
 #'   par = list(sf = gsDesign::sfLDOF, total_spend = 0.025, timing = info_frac, param = NULL),
-#'   hgm1 = gsDesign2:::h1(r = 18, theta = 0, I = info[1], a = a1, b = b1)
+#'   hgm1 = h1(r = 18, theta = 0, info = info[1], a = a1, b = b1)
 #' )
 #' cat("The upper boundary at the 2nd analysis is (", a2, ", ", b2, ").\n")
 gs_spending_bound <- function(k = 1,
@@ -217,9 +217,9 @@ gs_spending_bound <- function(k = 1,
     while (abs(adelta) > tol) {
       # get grid for rejection region
       hg <- hupdate(
-        theta = theta[k], I = info[k], a = -Inf,
+        theta = theta[k], info = info[k], a = -Inf,
         b = a, thetam1 = theta[k - 1],
-        Im1 = info[k - 1], gm1 = hgm1, r = r
+        im1 = info[k - 1], gm1 = hgm1, r = r
       )
       i <- length(hg$h)
 
@@ -285,7 +285,7 @@ gs_spending_bound <- function(k = 1,
 
     while (abs(bdelta) > tol) {
       # sub-density for final analysis in rejection region
-      hg <- hupdate(theta = 0, I = info[k], a = b, b = Inf, thetam1 = 0, Im1 = info[k - 1], gm1 = hgm1, r = r)
+      hg <- hupdate(theta = 0, info = info[k], a = b, b = Inf, thetam1 = 0, im1 = info[k - 1], gm1 = hgm1, r = r)
 
       # compute probability of crossing bound
       pik <- sum(hg$h)

R/utility_wlr.R

@@ -20,6 +20,8 @@
 #' @inheritParams gs_info_ahr
 #' @param total_time Total analysis time.
 #'
+#' @return A list of the two arms.
+#'
 #' @section Specification:
 #' \if{latex}{
 #'  \itemize{
@@ -44,7 +46,24 @@
 #' }
 #' \if{html}{The contents of this section are shown in PDF user manual only.}
 #'
-#' @noRd
+#' @export
+#'
+#' @examples
+#' enroll_rate <- tibble::tibble(
+#'   stratum = "All",
+#'   duration = c(2, 2, 10),
+#'   rate = c(3, 6, 9)
+#' )
+#'
+#' fail_rate <- tibble::tibble(
+#'   stratum = "All",
+#'   duration = c(3, 100),
+#'   fail_rate = log(2) / c(9, 18),
+#'   hr = c(.9, .6),
+#'   dropout_rate = rep(.001, 2)
+#' )
+#'
+#' gs_create_arm(enroll_rate, fail_rate, ratio = 1)
 gs_create_arm <- function(enroll_rate,
                           fail_rate,
                           ratio,

R/wlr_weight.R

@@ -67,7 +67,7 @@
 #'   dropout_rate = rep(.001, 2)
 #' )
 #'
-#' gs_arm <- gsDesign2:::gs_create_arm(enroll_rate, fail_rate, ratio = 1)
+#' gs_arm <- gs_create_arm(enroll_rate, fail_rate, ratio = 1)
 #' arm0 <- gs_arm$arm0
 #' arm1 <- gs_arm$arm1
 #'
@@ -110,7 +110,7 @@ wlr_weight_fh <- function(x, arm0, arm1, rho = 0, gamma = 0, tau = NULL) {
 #'   dropout_rate = rep(.001, 2)
 #' )
 #'
-#' gs_arm <- gsDesign2:::gs_create_arm(enroll_rate, fail_rate, ratio = 1)
+#' gs_arm <- gs_create_arm(enroll_rate, fail_rate, ratio = 1)
 #' arm0 <- gs_arm$arm0
 #' arm1 <- gs_arm$arm1
 #'
@@ -140,7 +140,7 @@ wlr_weight_1 <- function(x, arm0, arm1) {
 #'   dropout_rate = rep(.001, 2)
 #' )
 #'
-#' gs_arm <- gsDesign2:::gs_create_arm(enroll_rate, fail_rate, ratio = 1)
+#' gs_arm <- gs_create_arm(enroll_rate, fail_rate, ratio = 1)
 #' arm0 <- gs_arm$arm0
 #' arm1 <- gs_arm$arm1
 #'
@@ -175,7 +175,7 @@ wlr_weight_n <- function(x, arm0, arm1, power = 1) {
 #'   dropout_rate = rep(.001, 2)
 #' )
 #'
-#' gs_arm <- gsDesign2:::gs_create_arm(enroll_rate, fail_rate, ratio = 1)
+#' gs_arm <- gs_create_arm(enroll_rate, fail_rate, ratio = 1)
 #' arm0 <- gs_arm$arm0
 #' arm1 <- gs_arm$arm1
 #'