Skip to content

Commit 17cf1e1

Browse files
jdblischakjdblischak
committed
Refactor summary.fixed_design() to use S3 dispatch per method
1 parent 848cc45 commit 17cf1e1

11 files changed

+157
-30
lines changed

‎NAMESPACE

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,14 @@ S3method(as_gt,gs_design)
1313
S3method(as_gt,simtrial_gs_wlr)
1414
S3method(as_rtf,fixed_design)
1515
S3method(as_rtf,gs_design)
16+
S3method(summary,design_fixed_ahr)
17+
S3method(summary,design_fixed_fh)
18+
S3method(summary,design_fixed_lf)
19+
S3method(summary,design_fixed_maxcombo)
20+
S3method(summary,design_fixed_mb)
21+
S3method(summary,design_fixed_milestone)
22+
S3method(summary,design_fixed_rd)
23+
S3method(summary,design_fixed_rmst)
1624
S3method(summary,fixed_design)
1725
S3method(summary,gs_design)
1826
S3method(to_integer,fixed_design)

‎R/fixed_design_ahr.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -132,6 +132,6 @@ fixed_design_ahr <- function(
132132
input = input, enroll_rate = d$enroll_rate,
133133
fail_rate = d$fail_rate, analysis = ans, design = "ahr"
134134
)
135-
class(y) <- c("fixed_design", class(y))
135+
class(y) <- c("design_fixed_ahr", "fixed_design", class(y))
136136
return(y)
137137
}

‎R/fixed_design_fh.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -132,6 +132,6 @@ fixed_design_fh <- function(
132132
analysis = ans,
133133
design = "fh", design_par = list(rho = rho, gamma = gamma)
134134
)
135-
class(y) <- c("fixed_design", class(y))
135+
class(y) <- c("design_fixed_fh", "fixed_design", class(y))
136136
return(y)
137137
}

‎R/fixed_design_lf.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -189,6 +189,6 @@ fixed_design_lf <- function(
189189
analysis = ans,
190190
design = "lf"
191191
)
192-
class(y) <- c("fixed_design", class(y))
192+
class(y) <- c("design_fixed_lf", "fixed_design", class(y))
193193
return(y)
194194
}

‎R/fixed_design_maxcombo.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -132,6 +132,6 @@ fixed_design_maxcombo <- function(
132132
enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans,
133133
design = "maxcombo", design_par = list(rho = rho, gamma = gamma, tau = tau)
134134
)
135-
class(y) <- c("fixed_design", class(y))
135+
class(y) <- c("design_fixed_maxcombo", "fixed_design", class(y))
136136
return(y)
137137
}

‎R/fixed_design_mb.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -131,6 +131,6 @@ fixed_design_mb <- function(
131131
input = input, enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans,
132132
design = "mb", design_par = list(tau = tau)
133133
)
134-
class(y) <- c("fixed_design", class(y))
134+
class(y) <- c("design_fixed_mb", "fixed_design", class(y))
135135
return(y)
136136
}

‎R/fixed_design_milestone.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -120,6 +120,6 @@ fixed_design_milestone <- function(
120120
enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans,
121121
design = "milestone", design_par = list(tau = tau)
122122
)
123-
class(y) <- c("fixed_design", class(y))
123+
class(y) <- c("design_fixed_milestone", "fixed_design", class(y))
124124
return(y)
125125
}

‎R/fixed_design_rd.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -106,6 +106,6 @@ fixed_design_rd <- function(
106106
input = input,
107107
enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans, design = "rd"
108108
)
109-
class(y) <- c("fixed_design", class(y))
109+
class(y) <- c("design_fixed_rd", "fixed_design", class(y))
110110
return(y)
111111
}

‎R/fixed_design_rmst.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -119,6 +119,6 @@ fixed_design_rmst <- function(
119119
enroll_rate = d$enroll_rate, fail_rate = d$fail_rate, analysis = ans,
120120
design = "rmst", design_par = list(tau = tau), study_duration
121121
)
122-
class(y) <- c("fixed_design", class(y))
122+
class(y) <- c("design_fixed_rmst", "fixed_design", class(y))
123123
return(y)
124124
}

‎R/summary.R

Lines changed: 90 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@
1919
#' Summary for fixed design or group sequential design objects
2020
#'
2121
#' @param object A design object returned by fixed_design_xxx() and gs_design_xxx().
22+
#' @param design_display The display name for the design method.
2223
#' @param ... Additional parameters (not used).
2324
#'
2425
#' @return A summary table (data frame).
@@ -77,35 +78,103 @@
7778
#' ratio = ratio
7879
#' ) %>% summary()
7980
#'
80-
summary.fixed_design <- function(object, ...) {
81-
x <- object
82-
p <- x$design_par
83-
ans <- x$analysis
84-
ans$design <- switch(
85-
x$design,
86-
ahr = "Average hazard ratio",
87-
lf = "Lachin and Foulkes",
88-
rd = "Risk difference",
89-
milestone = paste0("Milestone: tau = ", p$tau),
90-
rmst = paste0("RMST: tau = ", p$tau),
91-
mb = paste0("Modestly weighted LR: tau = ", p$tau),
92-
fh = paste0(
93-
"Fleming-Harrington FH(", p$rho, ", ", p$gamma, ")",
94-
if (p$rho == 0 && p$gamma == 0) " (logrank)"
95-
),
96-
maxcombo = gsub("FH(0, 0)", "logrank", paste(
97-
"MaxCombo:", paste0("FHC(", p[[1]], ", ", p[[2]], ")", collapse = ", ")
98-
), fixed = TRUE)
99-
)
81+
summary.fixed_design <- function(object, design_display, ...) {
82+
ans <- object$analysis
83+
ans$design <- design_display
10084

10185
# capitalize names
10286
ans <- cap_names(ans)
10387
ans <- add_class(ans, paste0("fixed_design"))
10488
ans <- add_class(ans, paste0("design_fixed_summary"))
105-
ans <- add_class(ans, paste0("design_fixed_", x$design, "_summary"))
89+
ans <- add_class(ans, paste0("design_fixed_", object$design, "_summary"))
10690
return(ans)
10791
}
10892

93+
#' @rdname summary
94+
#' @export
95+
summary.design_fixed_ahr <- function(
96+
object,
97+
design_display = "Average hazard ratio",
98+
...
99+
) {
100+
NextMethod("summary", object, design_display = design_display, ...)
101+
}
102+
103+
#' @rdname summary
104+
#' @export
105+
summary.design_fixed_fh <- function(
106+
object,
107+
design_display = paste0(
108+
"Fleming-Harrington FH(", object$design_par$rho, ", ", object$design_par$gamma, ")",
109+
if (object$design_par$rho == 0 && object$design_par$gamma == 0) " (logrank)"
110+
),
111+
...
112+
) {
113+
NextMethod("summary", object, design_display = design_display, ...)
114+
}
115+
116+
#' @rdname summary
117+
#' @export
118+
summary.design_fixed_mb <- function(
119+
object,
120+
design_display = paste0("Modestly weighted LR: tau = ", object$design_par$tau),
121+
...
122+
) {
123+
NextMethod("summary", object, design_display = design_display, ...)
124+
}
125+
126+
#' @rdname summary
127+
#' @export
128+
summary.design_fixed_lf <- function(
129+
object,
130+
design_display = "Lachin and Foulkes",
131+
...
132+
) {
133+
NextMethod("summary", object, design_display = design_display, ...)
134+
}
135+
136+
#' @rdname summary
137+
#' @export
138+
summary.design_fixed_rd <- function(
139+
object,
140+
design_display = "Risk difference",
141+
...
142+
) {
143+
NextMethod("summary", object, design_display = design_display, ...)
144+
}
145+
146+
#' @rdname summary
147+
#' @export
148+
summary.design_fixed_maxcombo <- function(
149+
object,
150+
design_display = gsub("FH(0, 0)", "logrank", paste(
151+
"MaxCombo:", paste0("FHC(", object$design_par[[1]], ", ", object$design_par[[2]], ")", collapse = ", ")
152+
), fixed = TRUE),
153+
...
154+
) {
155+
NextMethod("summary", object, design_display = design_display, ...)
156+
}
157+
158+
#' @rdname summary
159+
#' @export
160+
summary.design_fixed_milestone <- function(
161+
object,
162+
design_display = paste0("Milestone: tau = ", object$design_par$tau),
163+
...
164+
) {
165+
NextMethod("summary", object, design_display = design_display, ...)
166+
}
167+
168+
#' @rdname summary
169+
#' @export
170+
summary.design_fixed_rmst <- function(
171+
object,
172+
design_display = paste0("RMST: tau = ", object$design_par$tau),
173+
...
174+
) {
175+
NextMethod("summary", object, design_display = design_display, ...)
176+
}
177+
109178
#' @rdname summary
110179
#'
111180
#' @param analysis_vars The variables to be put at the summary header of each analysis.

0 commit comments

Comments
 (0)