17.1. S3 Classes

S3 system builds up on two concepts:

• A class attribute attached to an object
• Class specific implementation for generic methods

In the following, we provide an implementation of the generic method print for an object of class mylist:

print.mylist <- function(lst, ...){
  for (name in names(lst)){
      cat(name); cat(': '); cat(lst[[name]]); cat(' ')
  }
  cat('\n')
}

Now let us create a list object:

> l <- list(a=1, b=2, c=1:4)

Standard printing of list objects:

> l
$a
[1] 1

$b
[1] 2

$c
[1] 1 2 3 4

Let us change the class of l now:

> class(l) <- 'mylist'

Print l will now pick the new implementation:

> print(l)
a: 1 b: 2 c: 1 2 3 4
> l
a: 1 b: 2 c: 1 2 3 4

17.1.1. A Modified Gram Schmidt Algorithm Implementation

The function below implements the Modified Gram Schmidt. While the algorithm implementation is straightforward and not important for the discussion in this section, look at the returned object. The function is returning a list object whose class has been set to mgs:

mgs <- function(X){

  # Ensure that X is a matrix
  X <- as.matrix(X)
  # Number of rows
  m <- nrow(X)
  # Number of columns
  n <- ncol(X)
  if (m < n) {
    stop('Wide matrices are not supported.')
  }
  # Construct the empty Q and R matrices
  Q <- matrix(0, m, n)
  R <- matrix(0, n, n)
  for (j in 1:n){
    # Pick up the j-th column of X
    v <- X[, j]
    # compute the projection of v on existing columns
    if (j > 1){
      for (i in 1:(j-1)){
        # pick up the i-th Q vector
        q <- Q[, i]
        #cat('q: '); print(q)
        # compute projection of v on qi
        projection <- as.vector(q %*% v)
        #cat('projection: '); print(projection)
        # Store the projection in R
        R[i, j] <- projection
        # subtract the projection from v
        v <- v - projection * q
      }
    }
    # cat('v: ') ; print(v)
    # Compute the norm of the remaining vector
    v.norm <- sqrt(sum(v^2))
    # cat('v-norm: '); print(v.norm)
    # Store the norm in R
    R[j,j] <- v.norm
    # Place the normalized vector in Q
    Q[, j] <- v / v.norm
  }
  # Prepare the result
  result <- list(Q=Q, R=R, call=match.call())
  # Set the class of the result
  class(result) <- 'mgs'
  result
}

We can now provide implementations of generic methods for the objects returned by this object. For example, let us implement print for objects of type mgs:

print.mgs <- function(mgs){
  cat("Call: \n")
  print(mgs$call)
  cat('Q: \n')
  print(mgs$Q)
  cat('R: \n')
  print(mgs$R)
}

Let us compute the QR decomposition of a matrix using this algorithm:

> A <- matrix(c(3, 2, -1, 2, -2, .5, -1, 4, -1), nrow=3)
> res <- mgs(A)

When we print the result object, print.mgs will be called:

> res
Call:
mgs(X = A)
Q:
           [,1]       [,2]      [,3]
[1,]  0.8017837  0.5901803 0.0939682
[2,]  0.5345225 -0.7785358 0.3288887
[3,] -0.2672612  0.2134695 0.9396820
R:
         [,1]      [,2]       [,3]
[1,] 3.741657 0.4008919  1.6035675
[2,] 0.000000 2.8441670 -3.9177929
[3,] 0.000000 0.0000000  0.2819046

We can implement other (non-generic) methods for this class too:

mgs.q <- function(mgs){
  mgs$Q
}

mgs.r <- function(mgs){
  mgs$R
}

mgs.x <- function(mgs){
  mgs$Q %*% mgs$R
}

Note that these methods don’t verify that the object being passed is of class mgs.