Skip to content

Commit

Permalink
Use CamelCase for all class names in docs and vignettes. (#485)
Browse files Browse the repository at this point in the history
* Project-level canonical markdown `wrap: sentence`

* update all `new_class()` usage in vignettes

* update all `new_class()` usage in docs/examples

* redocument

* enable `workflow_dispatch` on R-CMD-check CI action

* whitespace
  • Loading branch information
t-kalinowski authored Nov 4, 2024
1 parent 4ced878 commit 89ff0c7
Show file tree
Hide file tree
Showing 31 changed files with 275 additions and 272 deletions.
1 change: 1 addition & 0 deletions .github/workflows/R-CMD-check.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@
# check-standard.yaml is likely a better choice.
# usethis::use_github_action("check-standard") will install it.
on:
workflow_dispatch:
push:
branches: [main, master]
pull_request:
Expand Down
2 changes: 1 addition & 1 deletion R/S3.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@
#'
#' ```R
#' method(my_generic, new_S3_class("factor")) <- function(x) "A factor"
#' new_class("my_class", properties = list(types = new_S3_class("factor")))
#' new_class("MyClass", properties = list(types = new_S3_class("factor")))
#' new_union("character", new_S3_class("factor"))
#' ```
#'
Expand Down
8 changes: 4 additions & 4 deletions R/S4.R
Original file line number Diff line number Diff line change
Expand Up @@ -12,11 +12,11 @@
#' standardGeneric("S4_generic")
#' })
#'
#' foo <- new_class("foo")
#' S4_register(foo)
#' method(S4_generic, foo) <- function(x) "Hello"
#' Foo <- new_class("Foo")
#' S4_register(Foo)
#' method(S4_generic, Foo) <- function(x) "Hello"
#'
#' S4_generic(foo())
#' S4_generic(Foo())
S4_register <- function(class, env = parent.frame()) {
if (!is_class(class)) {
msg <- sprintf("`class` must be an S7 class, not a %s", obj_desc(class))
Expand Down
20 changes: 10 additions & 10 deletions R/class.R
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@
#'
#' @param name The name of the class, as a string. The result of calling
#' `new_class()` should always be assigned to a variable with this name,
#' i.e. `foo <- new_class("foo")`.
#' i.e. `Foo <- new_class("Foo")`.
#' @param parent The parent class to inherit behavior from.
#' There are three options:
#'
Expand Down Expand Up @@ -56,25 +56,25 @@
#' @export
#' @examples
#' # Create an class that represents a range using a numeric start and end
#' range <- new_class("range",
#' Range <- new_class("Range",
#' properties = list(
#' start = class_numeric,
#' end = class_numeric
#' )
#' )
#' r <- range(start = 10, end = 20)
#' r <- Range(start = 10, end = 20)
#' r
#' # get and set properties with @
#' r@start
#' r@end <- 40
#' r@end
#'
#' # S7 automatically ensures that properties are of the declared types:
#' try(range(start = "hello", end = 20))
#' try(Range(start = "hello", end = 20))
#'
#' # But we might also want to use a validator to ensure that start and end
#' # are length 1, and that start is < end
#' range <- new_class("range",
#' Range <- new_class("Range",
#' properties = list(
#' start = class_numeric,
#' end = class_numeric
Expand All @@ -89,10 +89,10 @@
#' }
#' }
#' )
#' try(range(start = c(10, 15), end = 20))
#' try(range(start = 20, end = 10))
#' try(Range(start = c(10, 15), end = 20))
#' try(Range(start = 20, end = 10))
#'
#' r <- range(start = 10, end = 20)
#' r <- Range(start = 10, end = 20)
#' try(r@start <- 25)
new_class <- function(
name,
Expand Down Expand Up @@ -322,8 +322,8 @@ str.S7_object <- function(object, ..., nest.lev = 0) {
#' @returns An [S7 class][new_class].
#' @export
#' @examples
#' foo <- new_class("foo")
#' S7_class(foo())
#' Foo <- new_class("Foo")
#' S7_class(Foo())
S7_class <- function(object) {
attr(object, "S7_class", exact = TRUE)
}
Expand Down
28 changes: 14 additions & 14 deletions R/convert.R
Original file line number Diff line number Diff line change
Expand Up @@ -41,36 +41,36 @@
#' is not possible.
#' @export
#' @examples
#' foo1 <- new_class("foo1", properties = list(x = class_integer))
#' foo2 <- new_class("foo2", foo1, properties = list(y = class_double))
#' Foo1 <- new_class("Foo1", properties = list(x = class_integer))
#' Foo2 <- new_class("Foo2", Foo1, properties = list(y = class_double))
#'
#' # Downcasting: S7 provides a default implementation for coercing an object
#' # to one of its parent classes:
#' convert(foo2(x = 1L, y = 2), to = foo1)
#' convert(Foo2(x = 1L, y = 2), to = Foo1)
#'
#' # Upcasting: S7 also provides a default implementation for coercing an object
#' # to one of its child classes:
#' convert(foo1(x = 1L), to = foo2)
#' convert(foo1(x = 1L), to = foo2, y = 2.5) # Set new property
#' convert(foo1(x = 1L), to = foo2, x = 2L, y = 2.5) # Override existing and set new
#' convert(Foo1(x = 1L), to = Foo2)
#' convert(Foo1(x = 1L), to = Foo2, y = 2.5) # Set new property
#' convert(Foo1(x = 1L), to = Foo2, x = 2L, y = 2.5) # Override existing and set new
#'
#' # For all other cases, you'll need to provide your own.
#' try(convert(foo1(x = 1L), to = class_integer))
#' try(convert(Foo1(x = 1L), to = class_integer))
#'
#' method(convert, list(foo1, class_integer)) <- function(from, to) {
#' method(convert, list(Foo1, class_integer)) <- function(from, to) {
#' from@x
#' }
#' convert(foo1(x = 1L), to = class_integer)
#' convert(Foo1(x = 1L), to = class_integer)
#'
#' # Note that conversion does not respect inheritance so if we define a
#' # convert method for integer to foo1
#' method(convert, list(class_integer, foo1)) <- function(from, to) {
#' foo1(x = from)
#' method(convert, list(class_integer, Foo1)) <- function(from, to) {
#' Foo1(x = from)
#' }
#' convert(1L, to = foo1)
#' convert(1L, to = Foo1)
#'
#' # Converting to foo2 will still error
#' try(convert(1L, to = foo2))
#' # Converting to Foo2 will still error
#' try(convert(1L, to = Foo2))
#' # This is probably not surprising because foo2 also needs some value
#' # for `@y`, but it definitely makes dispatch for convert() special
convert <- function(from, to, ...) {
Expand Down
4 changes: 2 additions & 2 deletions R/data.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,8 +11,8 @@
#' invisibly.
#' @export
#' @examples
#' text <- new_class("text", parent = class_character)
#' y <- text(c(foo = "bar"))
#' Text <- new_class("Text", parent = class_character)
#' y <- Text(c(foo = "bar"))
#' y
#' S7_data(y)
#'
Expand Down
4 changes: 2 additions & 2 deletions R/external-generic.R
Original file line number Diff line number Diff line change
Expand Up @@ -24,10 +24,10 @@
#' `S7_external_generic`.
#' @export
#' @examples
#' my_class <- new_class("my_class")
#' MyClass <- new_class("MyClass")
#'
#' your_generic <- new_external_generic("stats", "median", "x")
#' method(your_generic, my_class) <- function(x) "Hi!"
#' method(your_generic, MyClass) <- function(x) "Hi!"
new_external_generic <- function(package, name, dispatch_args, version = NULL) {
out <- list(
package = package,
Expand Down
14 changes: 7 additions & 7 deletions R/inherits.R
Original file line number Diff line number Diff line change
Expand Up @@ -12,15 +12,15 @@
#' * `check_is_S7()` returns nothing; it's called for its side-effects.
#' @export
#' @examples
#' foo1 <- new_class("foo1")
#' foo2 <- new_class("foo2")
#' Foo1 <- new_class("Foo1")
#' Foo2 <- new_class("Foo2")
#'
#' S7_inherits(foo1(), foo1)
#' check_is_S7(foo1())
#' check_is_S7(foo1(), foo1)
#' S7_inherits(Foo1(), Foo1)
#' check_is_S7(Foo1())
#' check_is_S7(Foo1(), Foo1)
#'
#' S7_inherits(foo1(), foo2)
#' try(check_is_S7(foo1(), foo2))
#' S7_inherits(Foo1(), Foo2)
#' try(check_is_S7(Foo1(), Foo2))
S7_inherits <- function(x, class = NULL) {
if (!(is.null(class) || inherits(class, "S7_class"))) {
stop("`class` must be an <S7_class> or NULL")
Expand Down
10 changes: 5 additions & 5 deletions R/method-introspect.R
Original file line number Diff line number Diff line change
Expand Up @@ -69,14 +69,14 @@ method <- function(generic, class = NULL, object = NULL) {
#' @return Nothing; this function is called for it's side effects.
#' @export
#' @examples
#' foo1 <- new_class("foo1")
#' foo2 <- new_class("foo2", foo1)
#' Foo1 <- new_class("Foo1")
#' Foo2 <- new_class("Foo2", Foo1)
#'
#' add <- new_generic("add", c("x", "y"))
#' method(add, list(foo2, foo1)) <- function(x, y) c(2, 1)
#' method(add, list(foo1, foo1)) <- function(x, y) c(1, 1)
#' method(add, list(Foo2, Foo1)) <- function(x, y) c(2, 1)
#' method(add, list(Foo1, Foo1)) <- function(x, y) c(1, 1)
#'
#' method_explain(add, list(foo2, foo2))
#' method_explain(add, list(Foo2, Foo2))
method_explain <- function(generic, class = NULL, object = NULL) {
check_is_S7(generic, S7_generic)
dispatch <- as_dispatch(generic, class = class, object = object)
Expand Down
26 changes: 13 additions & 13 deletions R/property.R
Original file line number Diff line number Diff line change
Expand Up @@ -47,31 +47,31 @@
#' @export
#' @examples
#' # Simple properties store data inside an object
#' pizza <- new_class("pizza", properties = list(
#' Pizza <- new_class("Pizza", properties = list(
#' slices = new_property(class_numeric, default = 10)
#' ))
#' my_pizza <- pizza(slices = 6)
#' my_pizza <- Pizza(slices = 6)
#' my_pizza@slices
#' my_pizza@slices <- 5
#' my_pizza@slices
#'
#' your_pizza <- pizza()
#' your_pizza <- Pizza()
#' your_pizza@slices
#'
#' # Dynamic properties can compute on demand
#' clock <- new_class("clock", properties = list(
#' Clock <- new_class("Clock", properties = list(
#' now = new_property(getter = function(self) Sys.time())
#' ))
#' my_clock <- clock()
#' my_clock <- Clock()
#' my_clock@now; Sys.sleep(1)
#' my_clock@now
#' # This property is read only, because there is a 'getter' but not a 'setter'
#' try(my_clock@now <- 10)
#'
#' # Because the property is dynamic, it is not included as an
#' # argument to the default constructor
#' try(clock(now = 10))
#' args(clock)
#' try(Clock(now = 10))
#' args(Clock)
new_property <- function(class = class_any,
getter = NULL,
setter = NULL,
Expand Down Expand Up @@ -176,12 +176,12 @@ prop_default <- function(prop, envir, package) {
#' the modified object, invisibly.
#' @export
#' @examples
#' horse <- new_class("horse", properties = list(
#' Horse <- new_class("Horse", properties = list(
#' name = class_character,
#' colour = class_character,
#' height = class_numeric
#' ))
#' lexington <- horse(colour = "bay", height = 15, name = "Lex")
#' lexington <- Horse(colour = "bay", height = 15, name = "Lex")
#' lexington@colour
#' prop(lexington, "colour")
#'
Expand Down Expand Up @@ -352,8 +352,8 @@ prop_label <- function(object, name) {
#' a single `TRUE` or `FALSE`.
#' @export
#' @examples
#' foo <- new_class("foo", properties = list(a = class_character, b = class_integer))
#' f <- foo()
#' Foo <- new_class("Foo", properties = list(a = class_character, b = class_integer))
#' f <- Foo()
#'
#' prop_names(f)
#' prop_exists(f, "a")
Expand Down Expand Up @@ -404,12 +404,12 @@ prop_exists <- function(object, name) {
#' @returns A named list of property values.
#' @export
#' @examples
#' horse <- new_class("horse", properties = list(
#' Horse <- new_class("Horse", properties = list(
#' name = class_character,
#' colour = class_character,
#' height = class_numeric
#' ))
#' lexington <- horse(colour = "bay", height = 15, name = "Lex")
#' lexington <- Horse(colour = "bay", height = 15, name = "Lex")
#'
#' props(lexington)
#' props(lexington) <- list(height = 14, name = "Lexington")
Expand Down
44 changes: 22 additions & 22 deletions R/super.R
Original file line number Diff line number Diff line change
Expand Up @@ -26,18 +26,18 @@
#' For example, imagine that you have made a subclass of "integer":
#'
#' ```{r}
#' myint <- new_class("myint", parent = class_integer, package = NULL)
#' MyInt <- new_class("MyInt", parent = class_integer, package = NULL)
#' ```
#'
#' Now you go to write a custom print method:
#'
#' ```{r}
#' method(print, myint) <- function(x, ...) {
#' cat("<myint>")
#' method(print, MyInt) <- function(x, ...) {
#' cat("<MyInt>")
#' print(super(x, to = class_integer))
#' }
#'
#' myint(10L)
#' MyInt(10L)
#' ```
#'
#' This doesn't work because `print()` isn't an S7 generic so doesn't
Expand All @@ -47,12 +47,12 @@
#' the underlying base object:
#'
#' ```{r}
#' method(print, myint) <- function(x, ...) {
#' cat("<myint>")
#' method(print, MyInt) <- function(x, ...) {
#' cat("<MyInt>")
#' print(S7_data(x))
#' }
#'
#' myint(10L)
#' MyInt(10L)
#' ```
#'
#' @param from An S7 object to cast.
Expand All @@ -62,41 +62,41 @@
#' immediately to a generic. It has no other special behavior.
#' @export
#' @examples
#' foo1 <- new_class("foo1", properties = list(x = class_numeric, y = class_numeric))
#' foo2 <- new_class("foo2", foo1, properties = list(z = class_numeric))
#' Foo1 <- new_class("Foo1", properties = list(x = class_numeric, y = class_numeric))
#' Foo2 <- new_class("Foo2", Foo1, properties = list(z = class_numeric))
#'
#' total <- new_generic("total", "x")
#' method(total, foo1) <- function(x) x@x + x@y
#' method(total, Foo1) <- function(x) x@x + x@y
#'
#' # This won't work because it'll be stuck in an infinite loop:
#' method(total, foo2) <- function(x) total(x) + x@z
#' method(total, Foo2) <- function(x) total(x) + x@z
#'
#' # We could write
#' method(total, foo2) <- function(x) x@x + x@y + x@z
#' method(total, Foo2) <- function(x) x@x + x@y + x@z
#' # but then we'd need to remember to update it if the implementation
#' # for total(<foo1>) ever changed.
#' # for total(<Foo1>) ever changed.
#'
#' # So instead we use `super()` to call the method for the parent class:
#' method(total, foo2) <- function(x) total(super(x, to = foo1)) + x@z
#' total(foo2(1, 2, 3))
#' method(total, Foo2) <- function(x) total(super(x, to = Foo1)) + x@z
#' total(Foo2(1, 2, 3))
#'
#' # To see the difference between convert() and super() we need a
#' # method that calls another generic
#'
#' bar1 <- new_generic("bar1", "x")
#' method(bar1, foo1) <- function(x) 1
#' method(bar1, foo2) <- function(x) 2
#' method(bar1, Foo1) <- function(x) 1
#' method(bar1, Foo2) <- function(x) 2
#'
#' bar2 <- new_generic("bar2", "x")
#' method(bar2, foo1) <- function(x) c(1, bar1(x))
#' method(bar2, foo2) <- function(x) c(2, bar1(x))
#' method(bar2, Foo1) <- function(x) c(1, bar1(x))
#' method(bar2, Foo2) <- function(x) c(2, bar1(x))
#'
#' obj <- foo2(1, 2, 3)
#' obj <- Foo2(1, 2, 3)
#' bar2(obj)
#' # convert() affects every generic:
#' bar2(convert(obj, to = foo1))
#' bar2(convert(obj, to = Foo1))
#' # super() only affects the _next_ call to a generic:
#' bar2(super(obj, to = foo1))
#' bar2(super(obj, to = Foo1))
super <- function(from, to) {
check_is_S7(from)

Expand Down
2 changes: 2 additions & 0 deletions S7.Rproj
Original file line number Diff line number Diff line change
Expand Up @@ -20,3 +20,5 @@ BuildType: Package
PackageUseDevtools: Yes
PackageInstallArgs: --no-multiarch --with-keep.source
PackageRoxygenize: rd,collate,namespace

MarkdownWrap: Sentence
Loading

0 comments on commit 89ff0c7

Please sign in to comment.