R Oop

# S7 class definition
Range <- new_class("Range",
  properties = list(
    start = class_double,
    end = class_double
  ),
  validator = function(self) {
    if (self@end < self@start) {
      "@end must be >= @start"
    }
  }
)

# Usage - constructor and property access
x <- Range(start = 1, end = 10)
x@start  # 1
x@end <- 20  # automatic validation

# Methods
inside <- new_generic("inside", "x")
method(inside, Range) <- function(x, y) {
  y >= x@start & y <= x@end
}

Use vctrs when:
- Need data frame integration (columns/rows)
- Want type-stable vector operations
- Building factor-like, date-like, or numeric-like classes
- Need consistent coercion/casting behavior
- Working with existing tidyverse infrastructure

Examples: custom date classes, units, categorical data

Use S7 when:
- NEW projects that need formal classes
- Want property validation and safe property access (@)
- Need multiple dispatch (beyond S3's double dispatch)
- Converting from S3 and want better structure
- Building class hierarchies with inheritance
- Want better error messages and discoverability

Use S3 when:
- Simple classes with minimal structure needs
- Maximum compatibility and minimal dependencies
- Quick prototyping or internal classes
- Contributing to existing S3-based ecosystems
- Performance is absolutely critical (minimal overhead)

Use S4 when:
- Working in Bioconductor ecosystem
- Need complex multiple inheritance (S7 doesn't support this)
- Existing S4 codebase that works well

# Complex validation needs
Range <- new_class("Range",
  properties = list(start = class_double, end = class_double),
  validator = function(self) {
    if (self@end < self@start) "@end must be >= @start"
  }
)

# Multiple dispatch needs
method(generic, list(ClassA, ClassB)) <- function(x, y) ...

# Class hierarchies with clear inheritance
Child <- new_class("Child", parent = Parent)

# Vector-like behavior in data frames
percent <- new_vctr(0.5, class = "percentage")
data.frame(x = 1:3, pct = percent(c(0.1, 0.2, 0.3)))  # works seamlessly

# Type-stable operations
vec_c(percent(0.1), percent(0.2))  # predictable behavior
vec_cast(0.5, percent())          # explicit, safe casting

# Simple classes without complex needs
new_simple <- function(x) structure(x, class = "simple")
print.simple <- function(x, ...) cat("Simple:", x)

# Maximum performance needs (rare)
# Existing S3 ecosystem contributions

# Constructor
new_person <- function(name, age) {
  stopifnot(is.character(name), length(name) == 1)
  stopifnot(is.numeric(age), length(age) == 1)

  structure(
    list(name = name, age = age),
    class = "person"
  )
}

# Print method
print.person <- function(x, ...) {
  cat("Person:", x$name, "(age", x$age, ")\n")
  invisible(x)
}

# Generic + method
greet <- function(x) UseMethod("greet")
greet.person <- function(x) {
  cat("Hello, my name is", x$name, "\n")
}
greet.default <- function(x) {
  cat("Hello!\n")
}

# Child class
new_employee <- function(name, age, company) {
  obj <- new_person(name, age)
  obj$company <- company
  class(obj) <- c("employee", class(obj))
  obj
}

# Method with inheritance
print.employee <- function(x, ...) {
  NextMethod()  # Call parent print method
  cat("Works at:", x$company, "\n")
  invisible(x)
}

library(S7)

# Define class
Person <- new_class("Person",
  properties = list(
    name = class_character,
    age = class_numeric
  ),
  validator = function(self) {
    if (self@age < 0) {
      "@age must be non-negative"
    }
  }
)

# Create instance
bob <- Person(name = "Bob", age = 30)
bob@name  # "Bob"
bob@age <- 31  # Validated assignment

# Define generic
greet <- new_generic("greet", "x")

# Add method
method(greet, Person) <- function(x) {
  cat("Hello, my name is", x@name, "\n")
}

# Default method
method(greet, class_any) <- function(x) {
  cat("Hello!\n")
}

Employee <- new_class("Employee",
  parent = Person,
  properties = list(
    company = class_character
  )
)

# Override method
method(greet, Employee) <- function(x) {
  super(x, Person)@greet()  # Call parent method
  cat("I work at", x@company, "\n")
}

# Generic with multiple dispatch
combine <- new_generic("combine", c("x", "y"))

# Method for specific combination
method(combine, list(Person, Person)) <- function(x, y) {
  cat(x@name, "meets", y@name, "\n")
}

method(combine, list(Person, class_character)) <- function(x, y) {
  cat(x@name, "receives message:", y, "\n")
}

# Original S3
new_person_s3 <- function(name, age) {
  structure(list(name = name, age = age), class = "person")
}

# Migrated S7
Person <- new_class("Person",
  properties = list(
    name = class_character,
    age = class_numeric
  )
)

# S7 is backwards compatible with S3 generics
# Existing S3 methods still work

# Don't create a class for simple data
# BAD
Point <- new_class("Point", properties = list(x = class_double, y = class_double))

# GOOD - just use a named list or vector
point <- c(x = 1.5, y = 2.3)

# Don't create classes for one-off operations
# Use functions instead
distance <- function(p1, p2) {
  sqrt((p1["x"] - p2["x"])^2 + (p1["y"] - p2["y"])^2)
}