Merge pull request #461 from yihui/summary-cleanup

Clean up `summary` functions

Author: LittleBeannie

NAMESPACE

@@ -75,6 +75,7 @@ importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
 importFrom(dplyr,one_of)
 importFrom(dplyr,rename)
+importFrom(dplyr,row_number)
 importFrom(dplyr,select)
 importFrom(dplyr,summarize)
 importFrom(dplyr,ungroup)
@@ -83,6 +84,7 @@ importFrom(gsDesign,sfLDOF)
 importFrom(mvtnorm,GenzBretz)
 importFrom(stats,pnorm)
 importFrom(stats,qnorm)
+importFrom(stats,setNames)
 importFrom(stats,stepfun)
 importFrom(stats,uniroot)
 importFrom(survival,Surv)

R/as_gt.R

@@ -89,10 +89,11 @@ as_gt.fixed_design <- function(x, title = NULL, footnote = NULL, ...) {
   return(ans)
 }
 
+get_method <- function(x, methods) intersect(methods, class(x))[1]
+
 # get the fixed design method
 fd_method <- function(x) {
-  methods <- c("ahr", "fh", "mb", "lf", "rd", "maxcombo", "milestone", "rmst")
-  intersect(methods, class(x))[1]
+  get_method(x, c("ahr", "fh", "mb", "lf", "rd", "maxcombo", "milestone", "rmst"))
 }
 
 # get the default title

R/gsDesign2-package.R

@@ -17,10 +17,7 @@
 #  along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
 #' @keywords internal
-"_PACKAGE"
-
 #' @useDynLib gsDesign2, .registration = TRUE
-NULL
-
+#' @importFrom stats setNames
 #' @importFrom Rcpp sourceCpp
-NULL
+"_PACKAGE"

R/gs_design_ahr.R

@@ -380,10 +380,6 @@ gs_design_ahr <- function(
     analysis = analysis
   )
 
-  class(ans) <- c("ahr", "gs_design", class(ans))
-  if (!binding) {
-    class(ans) <- c("non_binding", class(ans))
-  }
-
+  ans <- add_class(ans, if (!binding) "non_binding", "ahr", "gs_design")
   return(ans)
 }

R/gs_design_rd.R

@@ -281,10 +281,6 @@ gs_design_rd <- function(p_c = tibble::tibble(stratum = "All", rate = .2),
     analysis = analysis
   )
 
-  class(ans) <- c("rd", "gs_design", class(ans))
-  if (!binding) {
-    class(ans) <- c("non_binding", class(ans))
-  }
-
+  ans <- add_class(ans, if (!binding) "non_binding", "rd", "gs_design")
   return(ans)
 }

R/gs_design_wlr.R

@@ -268,10 +268,6 @@ gs_design_wlr <- function(
     analysis = analysis
   )
 
-  class(ans) <- c("wlr", "gs_design", class(ans))
-  if (!binding) {
-    class(ans) <- c("non_binding", class(ans))
-  }
-
+  ans <- add_class(ans, if (!binding) "non_binding", "wlr", "gs_design")
   return(ans)
 }

R/gs_power_ahr.R

@@ -280,10 +280,6 @@ gs_power_ahr <- function(
     analysis = analysis
   )
 
-  class(ans) <- c("ahr", "gs_design", class(ans))
-  if (!binding) {
-    class(ans) <- c("non_binding", class(ans))
-  }
-
+  ans <- add_class(ans, if (!binding) "non_binding", "ahr", "gs_design")
   return(ans)
 }

R/gs_power_rd.R

@@ -348,10 +348,6 @@ gs_power_rd <- function(
     analysis = analysis
   )
 
-  class(ans) <- c("rd", "gs_design", class(ans))
-  if (!binding) {
-    class(ans) <- c("non_binding", class(ans))
-  }
-
+  ans <- add_class(ans, if (!binding) "non_binding", "rd", "gs_design")
   return(ans)
 }

R/gs_power_wlr.R

@@ -306,11 +306,7 @@ gs_power_wlr <- function(enroll_rate = define_enroll_rate(duration = c(2, 2, 10)
     analysis = analysis
   )
 
-  class(ans) <- c("wlr", "gs_design", class(ans))
-  if (!binding) {
-    class(ans) <- c("non_binding", class(ans))
-  }
-
+  ans <- add_class(ans, if (!binding) "non_binding", "wlr", "gs_design")
   return(ans)
 }