1.1 Fonctionnement du système S3

Nous avons déjà mentionné que les fonctions suivantes sont génériques : plot, print, summary, coef et plusieurs autres fonctions d’extraction d’informations de la sortie d’une fonction d’ajustement de modèle. La fonction print est probablement la fonction de cette liste que nous utilisons le plus souvent, puisqu’elle est appelée à chaque fois que nous soumettons dans la console une commande contenant uniquement le nom d’un objet. La définition de cette fonction est la suivante :

print

## function (x, ...) 
## UseMethod("print")
## <bytecode: 0x000000000e417ca8>
## <environment: namespace:base>

Il n’y a qu’une seule instruction dans le corps de cette fonction : un appel à la fonction UseMethod. Toutes les fonctions génériques du système S3 ont cette forme. De plus, la plupart d’entre elles possèdent un argument « ... ».

Lorsqu’une fonction générique est appelée, la fonction UseMethod vérifie d’abord la classe de l’objet fourni au premier argument, ici x. Ensuite, elle appelle la méthode correspondant à la classe obtenue, si elle existe, en lui fournissant en entrée les arguments qui ont été fournis dans l’appel à la fonction générique.

Par exemple, considérons le data frame suivant (il s’agit d’un jeu de données du package datasets).

str(women)

## 'data.frame':    15 obs. of  2 variables:
##  $ height: num  58 59 60 61 62 63 64 65 66 67 ...
##  $ weight: num  115 117 120 123 126 129 132 135 139 142 ...

Les data frames possèdent un attribut nommé class.

attributes(women)

## $names
## [1] "height" "weight"
## 
## $class
## [1] "data.frame"
## 
## $row.names
##  [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15

Lors de l’évaluation de l’appel à la fonction print suivant :

print(women)

R va d’abord vérifier la classe de l’objet assigné au premier argument dans l’appel de la fonction, ici l’objet women :

class(women)

## [1] "data.frame"

Puis R va vérifier si une méthode print est définie pour cette classe. La fonction methods nous permet de connaître toutes les méthodes définies pour une fonction générique présente dans le chemin de recherche de notre session R.

methods(print)

Le résultat n’est pas affiché en entier, car le nombre de méthodes pour la fonction générique print est trop grand. Voici cependant un extrait de la sortie que j’obtiens.

## . . .
## [67] print.condition                                    print.connection  
## [69] print.CRAN_package_reverse_dependencies_and_views* print.data.frame
## [71] print.Date                                         print.default
## [73] print.dendrogram*                                  print.density* 
## . . .
## see '?methods' for accessing help and source code

Pour une classe spécifique, une méthode de type S3 portera le nom : nom_fonction_generique.nom_classe. Nous voyons ici que la méthode print.data.frame existe. Celle-ci est une fonction, dont la définition est la suivante :

print.data.frame

## function (x, ..., digits = NULL, quote = FALSE, right = TRUE, 
##     row.names = TRUE, max = NULL) 
## {
##     n <- length(row.names(x))
##     if (length(x) == 0L) {
##         cat(sprintf(ngettext(n, "data frame with 0 columns and %d row", 
##             "data frame with 0 columns and %d rows"), n), "\n", 
##             sep = "")
##     }
##     else if (n == 0L) {
##         print.default(names(x), quote = FALSE)
##         cat(gettext("<0 rows> (or 0-length row.names)\n"))
##     }
##     else {
##         if (is.null(max)) 
##             max <- getOption("max.print", 99999L)
##         if (!is.finite(max)) 
##             stop("invalid 'max' / getOption(\"max.print\"): ", 
##                 max)
##         omit <- (n0 <- max%/%length(x)) < n
##         m <- as.matrix(format.data.frame(if (omit) 
##             x[seq_len(n0), , drop = FALSE]
##         else x, digits = digits, na.encode = FALSE))
##         if (!isTRUE(row.names)) 
##             dimnames(m)[[1L]] <- if (isFALSE(row.names)) 
##                 rep.int("", if (omit) 
##                   n0
##                 else n)
##             else row.names
##         print(m, ..., quote = quote, right = right, max = max)
##         if (omit) 
##             cat(" [ reached 'max' / getOption(\"max.print\") -- omitted", 
##                 n - n0, "rows ]\n")
##     }
##     invisible(x)
## }
## <bytecode: 0x00000000102e8e40>
## <environment: namespace:base>

R va donc finalement appeler cette fonction.

Donc, la commande

women

qui revient en fait à la commande

print(women)

cache l’évaluation de la commande suivante

print.data.frame(women)

qui produit le résultat suivant.

##    height weight
## 1      58    115
## 2      59    117
## 3      60    120
## 4      61    123
## 5      62    126
## 6      63    129
## 7      64    132
## 8      65    135
## 9      66    139
## 10     67    142
## 11     68    146
## 12     69    150
## 13     70    154
## 14     71    159
## 15     72    164

methods(class = "data.frame")

##  [1] $<-           [             [[            [[<-          [<-           aggregate    
##  [7] anyDuplicated anyNA         as.data.frame as.list       as.matrix     by           
## [13] cbind         coerce        dim           dimnames      dimnames<-    droplevels   
## [19] duplicated    edit          format        formula       head          initialize   
## [25] is.na         Math          merge         na.exclude    na.omit       Ops          
## [31] plot          print         prompt        rbind         row.names     row.names<-  
## [37] rowsum        show          slotsFromS3   split         split<-       stack        
## [43] str           subset        summary       Summary       t             tail         
## [49] transform     type.convert  unique        unstack       within       
## see '?methods' for accessing help and source code

inherits(women, what = "data.frame")

## [1] TRUE

attr(women, which = "class")

## [1] "data.frame"

women_2 <- unclass(women)
attr(women_2, which = "class")

## NULL

class(women_2)

## [1] "list"

x <- 1:5
x

## [1] 1 2 3 4 5

class(x)

## [1] "integer"

x_factor <- factor(x)
x_factor

## [1] 1 2 3 4 5
## Levels: 1 2 3 4 5

attributes(x_factor)

## $levels
## [1] "1" "2" "3" "4" "5"
## 
## $class
## [1] "factor"

class(x_factor)

## [1] "factor"

print(women_2)

## $height
##  [1] 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
## 
## $weight
##  [1] 115 117 120 123 126 129 132 135 139 142 146 150 154 159 164
## 
## attr(,"row.names")
##  [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15

any(methods(print) == "print.list")

## [1] FALSE

print.default(women_2)

## $height
##  [1] 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
## 
## $weight
##  [1] 115 117 120 123 126 129 132 135 139 142 146 150 154 159 164
## 
## attr(,"row.names")
##  [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15

methods(anova)

## [1] anova.glm*     anova.glmlist* anova.lm*      anova.lmlist*  anova.loess*  
## [6] anova.mlm*     anova.nls*    
## see '?methods' for accessing help and source code

anova(women_2)

## Error in UseMethod("anova") : 
##   no applicable method for 'anova' applied to an object of class "list"

model <- aov(Sepal.Length ~ Species, data = iris)
class(model)

## [1] "aov" "lm"

plot

## function (x, y, ...) 
## UseMethod("plot")
## <bytecode: 0x000000000e748d30>
## <environment: namespace:base>

graphics:::plot.factor

## function (x, y, legend.text = NULL, ...) 
## {
##     if (missing(y) || is.factor(y)) {
##         dargs <- list(...)
##         axisnames <- if (!is.null(dargs$axes)) 
##             dargs$axes
##         else if (!is.null(dargs$xaxt)) 
##             dargs$xaxt != "n"
##         else TRUE
##     }
##     if (missing(y)) {
##         barplot(table(x), axisnames = axisnames, ...)
##     }
##     else if (is.factor(y)) {
##         if (is.null(legend.text)) 
##             spineplot(x, y, ...)
##         else {
##             args <- c(list(x = x, y = y), list(...))
##             args$yaxlabels <- legend.text
##             do.call("spineplot", args)
##         }
##     }
##     else if (is.numeric(y)) 
##         boxplot(y ~ x, ...)
##     else NextMethod("plot")
## }
## <bytecode: 0x00000000110600c0>
## <environment: namespace:graphics>

1.2 Création de méthodes de type S3

Il est facile de créer de nouvelles méthodes pour des fonctions génériques existantes, telles que print, plot et summary. Par exemple, supposons que nous voulons modifier l’impression de l’objet suivant.

valeurs_aleatoires <- rnorm(7)
print(valeurs_aleatoires)

## [1]  0.4319268  0.4780331 -0.6331304 -0.0511430 -0.1312676 -1.1149903  0.1742424

Cet objet a la classe implicite suivante.

class(valeurs_aleatoires)

## [1] "numeric"

Est-ce qu’une méthode de la fonction générique print existe pour cette classe ?

methods(class = "numeric")

## [1] all.equal     as.data.frame as.Date       as.POSIXct    as.POSIXlt   
## [6] as.raster     coerce        Ops          
## see '?methods' for accessing help and source code

any(methods(class = "numeric") == "print.numeric")

## [1] FALSE

Non. Ainsi, l’impression produite par la commande print(valeurs_aleatoires) provient d’un appel à la méthode print.default.

Pour modifier l’impression de l’objet valeurs_aleatoires, nous pourrions créer une méthode print pour la classe "numeric". Cette façon de faire fonctionnerait, mais est-ce une bonne idée ?

Non. Procéder de cette façon aurait un désavantage majeur : l’impression de tous les objets de classe "numeric" serait modifiée. Nous ne souhaitons pas changer le comportement général de R avec les objets de classe "numeric". Nous souhaitons changer l’impression d’un seul objet : valeurs_aleatoires.

Il est donc préférable d’assigner une toute nouvelle classe à l’objet valeurs_aleatoires, puis d’écrire une méthode print pour cette classe.

class(valeurs_aleatoires) <- "mon_vecteur"
print(valeurs_aleatoires)

## [1]  0.4319268  0.4780331 -0.6331304 -0.0511430 -0.1312676 -1.1149903  0.1742424
## attr(,"class")
## [1] "mon_vecteur"

aggregate

## function (x, ...) 
## UseMethod("aggregate")
## <bytecode: 0x000000000e0c6670>
## <environment: namespace:stats>

methods(aggregate)

## [1] aggregate.data.frame aggregate.default*   aggregate.formula*   aggregate.ts        
## see '?methods' for accessing help and source code

args(aggregate.data.frame)

## function (x, by, FUN, ..., simplify = TRUE, drop = TRUE) 
## NULL

args(getS3method(f = "aggregate", class = "default"))

## function (x, ...) 
## NULL

args(getS3method(f = "aggregate", class = "formula"))

## function (formula, data, FUN, ..., subset, na.action = na.omit) 
## NULL

args(aggregate.ts)

## function (x, nfrequency = 1, FUN = sum, ndeltat = 1, ts.eps = getOption("ts.eps"), 
##     ...) 
## NULL

print.mon_vecteur <- function(x, ..., intro = TRUE) {
  if (intro) {
    cat("Voici le vecteur :\n")
  }
  print(unclass(x), ...)
  invisible(x)
}

print(valeurs_aleatoires)

## Voici le vecteur :
## [1]  0.4319268  0.4780331 -0.6331304 -0.0511430 -0.1312676 -1.1149903  0.1742424

print(valeurs_aleatoires, intro = FALSE)

## [1]  0.4319268  0.4780331 -0.6331304 -0.0511430 -0.1312676 -1.1149903  0.1742424

print(valeurs_aleatoires, FALSE)

## Voici le vecteur :
## [1]  0  0 -1 -0 -0 -1  0

print(valeurs_aleatoires)

## Voici le vecteur :
## [1]  0.4319268  0.4780331 -0.6331304 -0.0511430 -0.1312676 -1.1149903  0.1742424

print.mon_vecteur <- function(x, ..., intro = TRUE) {
  if (intro) {
    cat("Voici le vecteur :\n")
  }
  print(unclass(x), ...)
  return(x)
}

print(valeurs_aleatoires)

## Voici le vecteur :
## [1]  0.4319268  0.4780331 -0.6331304 -0.0511430 -0.1312676 -1.1149903  0.1742424

## Voici le vecteur :
## [1]  0.4319268  0.4780331 -0.6331304 -0.0511430 -0.1312676 -1.1149903  0.1742424

plot.mon_vecteur <- function(x, main = "Distribution de x", ylab = "fréquence", ...) {
  par.default <- par(mar = c(5, 5, 4, 1) + 0.1)
  on.exit(par(par.default), add = TRUE)
  out <- hist(x = x, main = main, ylab = ylab, ...)
  invisible(out)
}

methods(class = "mon_vecteur")

## [1] plot  print
## see '?methods' for accessing help and source code

plot(valeurs_aleatoires)

plot(unclass(valeurs_aleatoires))

stats_desc <- function(x, format_sortie = c("vecteur", "matrice", "liste"), ...) {
  # Calcul
  if (is.numeric(x)) {
    stats <- c(min = min(x, ...), moy = mean(x, ...), max = max(x, ...))
  } else if (is.character(x) || is.factor(x)) {
    stats <- table(x)
  } else {
    stats <- NA
  }
  # Production de la sortie
  format_sortie <- match.arg(format_sortie)
  if (format_sortie == "matrice") {
    stats <- as.matrix(stats)
    colnames(stats) <- if (is.character(x) || is.factor(x)) "frequence" else "stat"
  } else if (format_sortie == "liste") {
    stats <- as.list(stats)
  }
  out <- list(stats = stats)
  class(out) <- "stats_desc"
  return(out)
}

  out <- list(stats = stats)
  class(out) <- "stats_desc"
  return(out)

  return(structure(list(stats = stats),  class = "stats_desc"))

print.stats_desc <- function(x, ...) {
  cat("Statistiques descriptives :\n")
  cat("***************************\n")
  print(x$stats, ...)
  cat("***************************\n")
  invisible(x)
}

stats_desc(x = iris$Species, format_sortie = "matrice")

## Statistiques descriptives :
## ***************************
##            frequence
## setosa            50
## versicolor        50
## virginica         50
## ***************************

2.1 Manipulation d’objets dont la classe est de type S4

Même si nous n’illustrons pas ici comment créer des méthodes de type S4, il est bon de savoir comment manipuler des objets dont la classe est de type S4. L’utilisation du système S4 est assez courante, particulièrement dans les packages distribués sur Bioconductor.

Pour illustrer le système de programmation orientée objet S4, nous utiliserons le package sp. Voici un exemple d’utilisation d’une fonction de ce package, tiré d’une fiche d’aide du package.

library(sp)
x = c(1, 2, 3, 4, 5)
y = c(3, 2, 5, 1, 4)
S <- SpatialPoints(cbind(x, y))
S

## SpatialPoints:
##      x y
## [1,] 1 3
## [2,] 2 2
## [3,] 3 5
## [4,] 4 1
## [5,] 5 4
## Coordinate Reference System (CRS) arguments: NA

str(S)

## Formal class 'SpatialPoints' [package "sp"] with 3 slots
##   ..@ coords     : num [1:5, 1:2] 1 2 3 4 5 3 2 5 1 4
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ : NULL
##   .. .. ..$ : chr [1:2] "x" "y"
##   ..@ bbox       : num [1:2, 1:2] 1 1 5 5
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ : chr [1:2] "x" "y"
##   .. .. ..$ : chr [1:2] "min" "max"
##   ..@ proj4string:Formal class 'CRS' [package "sp"] with 1 slot
##   .. .. ..@ projargs: chr NA

L’objet retourné par la fonction SpatialPoints n’est pas une liste. C’est un objet appartenant à une classe de type S4, définie dans le package sp.

isS4(S)

## [1] TRUE

class(S)

## [1] "SpatialPoints"
## attr(,"package")
## [1] "sp"

Pour atteindre les éléments dans l’objet, il est possible d’utiliser une méthode conçue à cet effet. Par exemple, la fiche d’aide ouverte par la commande help("SpatialPoints-class") nous informe qu’une méthode coordinates est définie pour les objets de la classe "SpatialPoints". Nous pouvons aussi énumérer toutes les fonctions génériques possédant une méthode définie pour une certaine classe de type S4 avec la fonction methods comme suit.

methods(class = "SpatialPoints")

##  [1] $             $<-           [             [[            [[<-          [<-          
##  [7] addAttrToGeom as.data.frame bbox          coerce        coordinates   coordinates<-
## [13] coordnames    coordnames<-  dimensions    fullgrid      geometry      geometry<-   
## [19] gridded       gridded<-     is.projected  length        merge         over         
## [25] plot          points        polygons      print         proj4string   proj4string<-
## [31] rbind         rebuild_CRS   row.names     row.names<-   show          spChFIDs<-   
## [37] split         sppanel       spsample      spTransform   summary       wkt          
## see '?methods' for accessing help and source code

En fait, des méthodes de types S3 et S4 peuvent être définies pour des objets dont la classe est de type S4. La fonction methods retourne les méthodes des deux types. Pour se limiter à un seul type, il faut utiliser les fonctions .S3methods et .S4methods.

.S3methods(class = "SpatialPoints")

## [1] as.data.frame length        points        print         rbind         row.names    
## [7] row.names<-   split        
## see '?methods' for accessing help and source code

.S4methods(class = "SpatialPoints")

##  [1] $             $<-           [             [[            [[<-          [<-          
##  [7] addAttrToGeom bbox          coerce        coordinates   coordinates<- coordnames   
## [13] coordnames<-  dimensions    fullgrid      geometry      geometry<-    gridded      
## [19] gridded<-     is.projected  merge         over          plot          polygons     
## [25] proj4string   proj4string<- rebuild_CRS   show          spChFIDs<-    sppanel      
## [31] spsample      spTransform   summary       wkt          
## see '?methods' for accessing help and source code

Une fonction générique dans le système S4 n’a pas la même allure que dans le système S3.

coordinates

## standardGeneric for "coordinates" defined from package "sp"
## 
## function (obj, ...) 
## standardGeneric("coordinates")
## <bytecode: 0x00000000188daab8>
## <environment: 0x00000000188a7f18>
## Methods may be defined for arguments: obj
## Use  showMethods("coordinates")  for currently available ones.

La méthode coordinates pour un objet de classe "SpatialPoints" extrait l’élément de l’objet S nommé coords.

coordinates(S)

##      x y
## [1,] 1 3
## [2,] 2 2
## [3,] 3 5
## [4,] 4 1
## [5,] 5 4

Nous pouvons accéder à la définition de cette méthode grâce à la fonction getMethod comme suit.

getMethod(coordinates, signature = "SpatialPoints")

## Method Definition:
## 
## function (obj, ...) 
## {
##     .local <- function (obj) 
##     obj@coords
##     .local(obj, ...)
## }
## <bytecode: 0x00000000188e8bd0>
## <environment: namespace:sp>
## 
## Signatures:
##         obj            
## target  "SpatialPoints"
## defined "SpatialPoints"

Cette définition n’est pas aussi simple que celle d’une méthode de type S3. Je ne vais pas l’approfondir ici.

Pour extraire des éléments d’un objet dont la classe est de type S4, il est aussi possible d’utiliser l’opérateur @ (et non $ puisqu’il ne s’agit pas d’une liste).

S@coords

##      x y
## [1,] 1 3
## [2,] 2 2
## [3,] 3 5
## [4,] 4 1
## [5,] 5 4

ou encore la fonction slot.

slot(S, "coords")

##      x y
## [1,] 1 3
## [2,] 2 2
## [3,] 3 5
## [4,] 4 1
## [5,] 5 4

Ainsi, utiliser des classes de type S4 est simple. Il suffit de d’abord bien identifier que nous manipulons un objet dont la classe est de type S4. La mention Formal class dans la sortie de str nous l’indique. La fonction isS4 peut aussi nous le confirmer. Ensuite, nous pouvons manipuler l’objet avec les fonctions génériques possédant des méthodes pour sa classe et nous pouvons extraire des éléments de l’objet avec l’opérateur @ ou la fonction slot.

Notons qu’un des intérêts du package sp est la production facilitée de graphiques représentant des données spatiales, par exemple des coordonnées géographiques.

plot(S, main = "Axes sur la même échelle", axes = TRUE)

plot(x, y, main = "Axes non contrôlés")