Support S7 classes

[mvankessel-EMC]

library(S7)

# Class specification
Person <- new_class(
  "Person",
  properties = list(
    age = class_integer,
    name = class_character
  ),
  validator = function(self) {
    if (length(self@age) != 1) {
      "@age must be length 1"
    }  else if (self@age < 0) {
      "@age must be greater than or equal to 0"
    } else if (length(self@name) != 1) {
      "@name must be length 1"
    }
  }
)

person <- Person(age = 32L, name = "Steve")
person
#> <Person>
#>  @ age : int 32
#>  @ name: chr "Steve"

# Generic method specification
method(print, Person) <- function(Person) {
  cat(
    sprintf(
      "Name: %s\nAge: %s",
      Person@name, Person@age
    )
  )
}

print(person)
#> Name: Steve
#> Age: 32

# New generic
say <- new_generic("say", "x", function(x, ..., text) {
  S7_dispatch()
})

method(say, Person) <- function(x, text) {
  cat(
    sprintf(
      "%s says: %s.",
      Person@name, text
    )
  )
}

say(person, text = "stuff")
#> Person says: stuff.

^{Created on 2024-11-29 with reprex v2.1.1}