Refactor methods by passing table metadata as attributes

[jdblischak]

This is an alternative approach to #482 to refactor the classes/methods as discussed in #457

This PR refactors the fixed_design_X() functions to define their own design_display, title, and footnote as attributes, which are then used by summary(), as_gt(), and as_rtf(). This idea was proposed by @yihui, which I described in #482 (comment)

By using the above strategy, I was able to make the following improvements to the classes/methods:

• summary.fixed_design() no longer adds a method class to its output object (eg "ahr") since this is no longer necessary. This was only used to constructed the table metadata, which is now already defined in the attributes of the object produced the respective fixed_design_X() function
• summary.fixed_design() returns an object of class "fixed_design_summary" to distinguish it from the output of a fixed_design_X() function (with class "fixed_design")

Below is example code to test out the changes in this PR:

devtools::load_all(".")

# ahr
x <- fixed_design_ahr(
  alpha = .025,
  enroll_rate = define_enroll_rate(duration = 18, rate = 20),
  fail_rate = define_fail_rate(
    duration = c(4, 100),
    fail_rate = log(2) / 12,
    hr = c(1, .6),
    dropout_rate = .001
  ),
  study_duration = 36
)
attributes(x)
## $names
## [1] "input"       "enroll_rate" "fail_rate"   "analysis"    "design"
##
## $design_display
## [1] "Average hazard ratio"
##
## $title
## [1] "Fixed Design under AHR Method"
##
## $footnote
## [1] "Power computed with average hazard ratio method."
##
## $class
## [1] "fixed_design" "list"
xsum <- summary(x)
attributes(xsum)
## $row.names
## [1] 1
##
## $names
## [1] "Design" "N"      "Events" "Time"   "Bound"  "alpha"  "Power"
##
## $class
## [1] "fixed_design_summary" "tbl_df"               "tbl"                  "data.frame"
##
## $title
## [1] "Fixed Design under AHR Method"
##
## $footnote
## [1] "Power computed with average hazard ratio method."
as_gt(xsum)
as_gt(xsum, title = "Custom title", footnote = "Custom footnote")
as_rtf(xsum, file = "refactor.rtf")
as_rtf(xsum, file = "refactor.rtf", title = "Custom title", footnote = "Custom footnote")

# fh
x <- fixed_design_fh(
  alpha = .025,
  enroll_rate = define_enroll_rate(duration = 18, rate = 20),
  fail_rate = define_fail_rate(
    duration = c(4, 100),
    fail_rate = log(2) / 12,
    hr = c(1, .6),
    dropout_rate = .001
  ),
  study_duration = 36,
  rho = 1, gamma = 1
)
attributes(x)
xsum <- summary(x)
attributes(xsum)
as_gt(xsum)
as_rtf(xsum, file = "refactor.rtf")

# mb
x <- fixed_design_mb(
  alpha = .025,
  enroll_rate = define_enroll_rate(duration = 18, rate = 20),
  fail_rate = define_fail_rate(
    duration = c(4, 100),
    fail_rate = log(2) / 12,
    hr = c(1, .6),
    dropout_rate = .001
  ),
  study_duration = 36,
  tau = 4,
  w_max = 2
)
attributes(x)
xsum <- summary(x)
attributes(xsum)
as_gt(xsum)
as_rtf(xsum, file = "refactor.rtf")

# lf
x <- fixed_design_lf(
  alpha = .025, power = .9,
  enroll_rate = define_enroll_rate(duration = 18, rate = 1),
  fail_rate = define_fail_rate(
    duration = 100,
    fail_rate = log(2) / 12,
    hr = .7,
    dropout_rate = .001
  ),
  study_duration = 36
)
attributes(x)
xsum <- summary(x)
attributes(xsum)
as_gt(xsum)
as_rtf(xsum, file = "refactor.rtf")

# rd
x <- fixed_design_rd(
  alpha = 0.025, power = 0.9, p_c = .15, p_e = .1,
  rd0 = 0, ratio = 1
)
attributes(x)
xsum <- summary(x)
attributes(xsum)
as_gt(xsum)
as_rtf(xsum, file = "refactor.rtf")

# maxcombo
x <- fixed_design_maxcombo(
  alpha = .025,
  enroll_rate = define_enroll_rate(duration = 18, rate = 20),
  fail_rate = define_fail_rate(
    duration = c(4, 100),
    fail_rate = log(2) / 12,
    hr = c(1, .6),
    dropout_rate = .001
  ),
  study_duration = 36,
  rho = c(0, 0.5), gamma = c(0, 0), tau = c(-1, -1)
)
attributes(x)
xsum <- summary(x)
attributes(xsum)
as_gt(xsum)
as_rtf(xsum, file = "refactor.rtf")

# milestone
x <- fixed_design_milestone(
  alpha = .025,
  enroll_rate = define_enroll_rate(duration = 18, rate = 20),
  fail_rate = define_fail_rate(
    duration = 100,
    fail_rate = log(2) / 12,
    hr = .7,
    dropout_rate = .001
  ),
  study_duration = 36,
  tau = 18
)
attributes(x)
xsum <- summary(x)
attributes(xsum)
as_gt(xsum)
as_rtf(xsum, file = "refactor.rtf")

# rmst
x <- fixed_design_rmst(
  alpha = .025,
  enroll_rate = define_enroll_rate(duration = 18, rate = 20),
  fail_rate = define_fail_rate(
    duration = 100,
    fail_rate = log(2) / 12,
    hr = .7,
    dropout_rate = .001
  ),
  study_duration = 36,
  tau = 18
)
attributes(x)
xsum <- summary(x)
attributes(xsum)
as_gt(xsum)
as_rtf(xsum, file = "refactor.rtf")

[nanxstats]

This looks clear to me. I apologize for the complexity - if we could have written this in classical OOP, things would have been much more straightforward. This is one of the few things where I think Python gets it right but base R didn't.

[yihui]

This is fantastic. I absolutely love it! Previously I felt like we invented a homemade and awkward "S2" paradigm (via switch(class(x), ...)) inside S3.

[jdblischak]

class = "fixed_design",

I had trouble finding a source that explicitly said it was fine to omit the class "list" (currently we assign the classes c("fixed_design", "list")). However, from the experiment below, I think it is fine to drop "list". The only difference is in the result for inherits(x, "list"), which {gsDesign2} doesn't use. For example, the result of print() is still the same.

x <- list()
class(x)
#> [1] "list"
is.list(x)
#> [1] TRUE
inherits(x, "list")
#> [1] TRUE
print(x)
#> list()

class(x) <- "custom"
class(x)
#> [1] "custom"
is.list(x)
#> [1] TRUE
inherits(x, "list")
#> [1] FALSE
print(x)
#> list()
#> attr(,"class")
#> [1] "custom"

class(x) <- c("custom", "list")
class(x)
#> [1] "custom" "list"
is.list(x)
#> [1] TRUE
inherits(x, "list")
#> [1] TRUE
print(x)
#> list()
#> attr(,"class")
#> [1] "custom" "list"

[nanxstats]

I think the following might be the canonical approaches of creating and assigning S3 classes to a list, that also shows they are equivalent:

x <- list()
class(x) <- "my_class"

is.list(x)
#> [1] TRUE
inherits(x, "list")
#> [1] FALSE

x <- structure(list(), class = "my_class")

is.list(x)
#> [1] TRUE
inherits(x, "list")
#> [1] FALSE

I'd do the entire thing because any intermediate results can generate some surprises.

And yes, I feel assigning class "list" to a list created by list() is unusual, for... good reasons I can't fit in this comment.

[LittleBeannie]

Hi @jdblischak, I saw this PR is in progress. Is it ready for merge?

[jdblischak]

Is it ready for merge?

No. It is still a Draft. I have updated the fixed_design methods but still have to do the gs_design methods. And I still haven't decided if I'll include updates to to_integer() in this PR or a separate one. It'll depend on how intertwined the changes to the class names are.