Programmation fonctionnelle objet en R (S3)

Introduction : S3 et la Programmation Orientée Objet

Comme on l’a vu dans la page d’introduction, S3 est un système de programmation orientée objet dans R, adapté par rapport aux autres langages pour être soluble au paradigme prédominant dans R, à savoir la programmation fonctionnelle.

Dans R, le système de Programmation Orientée Objet S3 est structuré par :

  • des fonction génériques qui sont simplement des noms de fonctions munis d’une description abstraite en langage naturel. Par exemple summary() est une fonction générique. Sa description abstraite est décrite par l’aide accessible via ?summary. On y trouve summary is a generic function used to produce result summaries of the results of various model fitting functions. The function invokes particular methods which depend on the class of the first argument.”. À charge des différents concepteurs d’objets de lui donner un sens particulier conforme à cette description abstraite.
  • des classes d’objets qui sont simplement des étiquettes portées par l’objet et montrées à la fonction générique. Par exemple, si objet est un objet de classe twoStepsBenchmark du package disaggR, il montrera une étiquette "twoStepsBenchmark" à la fonction summary(). Un objet tibble montrera une étiquette "tbl_df" à la fonction summary() ("tbl_df" est le vrai nom de la classe des tibbles).
  • des méthodes qui écrivent explicitement le code utilisé pour une fonction dans le cas d’une classe d’objet (on peut dire qu’on implémente summary() quand on en écrit explicitement son code pour une classe précise). Par exemple summary() renverra vers summary.twoStepsBenchmark() pour un objet de classe twoStepsBenchmark, tandis qu’elle essayera en premier de renvoyer vers summary.tbl_df() pour un tibble.
  • Un héritage entre classes d’objets qui dit simplement que si une méthode n’existe pas pour une fonction générique, alors on en cherche une autre, puis une autre, et ainsi de suite. Par exemple un tibble a en fait 3 étiquettes, c("tbl_df", "tbl", "data.frame"). On cherchera d’abord truc.tbl_df, puis truc.tbl, puis truc.data.frame. En ce qui concerne la fonction summary(), on cherche d’abord une fonction summary.tbl_df() (qui n’existe pas), puis une fonction summary.tbl() (qui n’existe pas non plus), et enfin une fonction summary.data.frame() (qui existe ! Bingo ! C’est la méthode utilisée.).

Usuellement, un système de Programmation Orientée Objet structure le code en faisant appel à des instances d’objets sur lesquelles on appelle des méthodes. Plus spécifiquement, on a :

  • Une instance d’objet, par exemple la baguette magique que j’ai en main en écrivant ces lignes.
  • Une classe d’objet, par exemple celle des baguettes magiques. Toutes les instances de baguettes magiques se comportent exactement de la même manière, mais peuvent avoir différents attibuts (longueur, bois utilisé…).
  • Des méthodes, à savoir les choses que l’on peut faire avec une classe d’objets. Par exemple en ce qui concerne les baguettes magiques, considérons jeter_boule_de_feu(), et faire_pleuvoir().
  • Un héritage, à savoir que chaque classe a une classe parente dont elle étend les possibilités. Une baguette magique est un type particulier de bâton de bois. La classe des “baguettes magiques” hérite de l’ensemble des méthodes des “bâtons de bois”. On peut toujours taper_sur_un_ennemi(), faire_un_feu_de_camp(), casser_en_deux() avec une baguette magique.

On remarque que S3 préserve un peu cette structuration générale, mais l’adapte. Les éléments de POO sont tordus pour correspondre au paradigme prédominant qui est le paradigme fonctionnel. Voici les changements notables :

  • On centre sur les fonctions plutôt que les classes d’objets. Au lieu de s’attarder sur une classe puis de décrire les méthodes/fonctions que l’on peut appliquer dessus, dans S3 on fait exactement l’inverse ; on énonce un nom de fonction puis on écrit comment cette fonction s’applique sur différents objets. On a d’abord la fonction générique faire_pleuvoir(objet). On l’implémente en faire_pleuvoir.baguette_magique(objet) qui est la méthode faire_pleuvoir() adaptée aux baguettes magiques. On peut ensuite implémenter également faire_pleuvoir.robot_chanteur(objet) si on veut prévoir une méthode faire_pleuvoir() adaptée aux robots chanteurs.
  • Il n’y a pas de notion d’instance d’objet. La notion d’instance d’objet induit une notion d’unicité et d’état interne, comme on l’a vu au chapitre précédent. Si on copiait compteur_1 dans compteur_1bis, c’était le même compteur. Il n’y a pas de système d’instance natif à S3 car le paradigme fonctionnel décourage l’existence d’états internes. Si l’on veut tout de même des instances, il faut les créer manu-militari de la même manière qu’on l’a déjà fait (c’est l’objet de l’exercice 2 de ce classeur).

S3 en pratique

Pour voir les classes d’un objet, on utilise la fonction class().

On remarque que :

  • Un objet créé par twoStepsBenchmark() hérite de la classe "twoStepsBenchmark".
  • Un tibble herite de la classe "tbl_df", puis "tbl", puis "data.frame".

Une classe S3 est une étiquette apposée sur des données dont le type peut être consulté à l’aide de typeof() :

On vérifie ainsi qu’aussi bien la classe twoStepsBenchmark que celle des tibbles sont basées sur des données stockées sous forme de liste.

On peut vérifier si un objet hérite d’une classe avec la fonction inherits() :

On identifie une fonction générique S3 par le fait que son corps se limite à un UseMethod("nom_de_la_fonction").

Dans l’exemple ci-dessus, on voit que la fonction summary n’est définie par rien d’autre que :

summary <- function(object, ...) UseMethod("summary")

C’est assez succinct ! Cela déclare summary comme une fonction générique, et dit d’aller chercher la bonne méthode selon la classe du premier argument (ici object).

Pour voir les méthodes proposées par une fonction générique, on utilise methods() :

Il y a un paquet de méthodes implémentées pour summary() dites-donc ! Certaines méthodes ont une étoile derrière leur nom, certaines n’ont pas d’étoile. Pour consulter le code d’une méthode sans étoile, il suffit de taper son nom.

Ces méthodes correspondent à des fonctions exportées par les packages (ou par r-base). C’est-à-dire que leur concepteur a tenu à les rendre disponibles aux utilisateurs. Elles peuvent très bien être utilisées avec leur propre nom si on ne souhaite pas passer par la générique.

Les méthodes ans étoiles derrière leur nom correspondent à des méthodes non-exportées par un package, c’est-à-dire que l’auteur du package n’a pas jugé utile de les rendre directement accessibles à l’utilisateur et privilégie l’emploi de la générique.

On peut quand même lire ces méthodes et savoir d’où elles viennent en utilisant getAnywhere().

Ici, on lit que la méthode summary.twoStepsBenchmark existe de manière interne au package disaggR et que son code est :

summary.twoStepsBenchmark <- function (object, ...) {
  summary.praislm(prais(object), ...)
}

Autrement dit, elle renvoie encore à une autre méthode de summary.

Note

On peut accéder à toutes les fonctions d’un package, y compris les fonctions non-exportées, à l’aide des triples doubles-points (:::). Par exemple, on peut accéder à summary.twoStepsBenchmark en écrivant :

Bien sûr, inutile de vous prévenir que ce n’est pas une bonne pratique dans du code de production. R est très permissif, mais c’est à l’utilisateur de se discipliner. Si l’auteur d’un package a choisi de ne pas dire à l’utilisateur “tu peux utiliser cette fonction directement”, c’est à nos risques et périls si on le fait quand même !

On peut également utiliser methods() pour chercher toutes les méthodes associées à une classe :

Attributs

N’importe quel objet peut se voir affecter un nombre quelquonque d’autres objets nommés appelés attributs. Ceux-ci peuvent être accedés à l’aide de la fonction attributes() qui renvoie une liste nommée.

Le tibble starwars a trois attributs :

  • names qui stocke les noms de colonne
  • row.names qui stocke les noms de ligne, et qui correspond ici simplement à des numéros car un tibble n’a pas de noms de lignes (l’attribut row.names est hérité des objets data.frame)
  • class qui contient les classes de dplyr::starwars.

On voit donc qu’un objet classé selon le système S3 n’est rien d’autre qu’un objet avec un attribut “class”.

Les attributs peuvent être accedés et affectés de différentes manières.

Ci-dessus, avec la fonction structure(), on a créé en un coup l’objet avec ses deux attributs class et mon_attribut.

On aurait pu également les affecter un par un comme on le voit ci-dessous.

Ma première classe S3

Définir une fonction vecteur_titre() qui :

  • Prend deux arguments, à savoir un vecteur x et un argument titre (qui est un character de taille 1).
  • Retourne le vecteur x, à qui on a affecté la classe vecteur_avec_titre ainsi qu’un attribut titre égal à l’argument titre.
vecteur_titre <- function(x, titre) {
  structure(x,
            class = "vecteur_avec_titre",
            titre = titre)
}

Essayer ce constructeur sur vecteur_titre(1:10, "Les 10 premiers entiers") dont les attributs retournés par attributes doivent logiquement correspondre à :

$class
[1] "vecteur_avec_titre"

$titre
[1] "Les 10 premiers entiers"
vecteur_titre <- function(x, titre) {
  structure(x,
            class = "vecteur_avec_titre",
            titre = titre)
}
mon_vecteur <- vecteur_titre(1:10, "Les 10 premiers entiers")
attributes(mon_vecteur)
$class
[1] "vecteur_avec_titre"

$titre
[1] "Les 10 premiers entiers"

Après avoir saisi mon_vecteur <- vecteur_titre(1:10, "Les 10 premiers entiers")… Si je tape mon_vecteur dans R (ou dans la console si je suis sous RStudio), c’est très moche ! Je lis en effet :

 [1]  1  2  3  4  5  6  7  8  9 10
attr(,"class")
[1] "vecteur_avec_titre"
attr(,"titre")
[1] "Les 10 premiers entiers"

La fonction qui est utilisée pour afficher un objet S3 lors de la saisie de celui-ci est la fonction print(). Vérifier que print() correspond à une fonction générique et afficher les méthodes associées.

Il suffit de taper :

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

pour vérifier que la fonction print est bien générique (elle utilise UseMethod("print")).

On peut en afficher les méthodes en tapant :

methods(print)
  [1] print.acf*                                          
  [2] print.activeConcordance*                            
  [3] print.AES*                                          
  [4] print.anova*                                        
  [5] print.aov*                                          
  [6] print.aovlist*                                      
  [7] print.ar*                                           
  [8] print.Arima*                                        
  [9] print.arima0*                                       
 [10] print.AsIs                                          
 [11] print.aspell*                                       
 [12] print.aspell_inspect_context*                       
 [13] print.bibentry*                                     
 [14] print.Bibtex*                                       
 [15] print.browseVignettes*                              
 [16] print.by                                            
 [17] print.changedFiles*                                 
 [18] print.check_bogus_return*                           
 [19] print.check_code_usage_in_package*                  
 [20] print.check_compiled_code*                          
 [21] print.check_demo_index*                             
 [22] print.check_depdef*                                 
 [23] print.check_details*                                
 [24] print.check_details_changes*                        
 [25] print.check_doi_db*                                 
 [26] print.check_dotInternal*                            
 [27] print.check_make_vars*                              
 [28] print.check_nonAPI_calls*                           
 [29] print.check_package_code_assign_to_globalenv*       
 [30] print.check_package_code_attach*                    
 [31] print.check_package_code_data_into_globalenv*       
 [32] print.check_package_code_startup_functions*         
 [33] print.check_package_code_syntax*                    
 [34] print.check_package_code_unload_functions*          
 [35] print.check_package_compact_datasets*               
 [36] print.check_package_CRAN_incoming*                  
 [37] print.check_package_datalist*                       
 [38] print.check_package_datasets*                       
 [39] print.check_package_depends*                        
 [40] print.check_package_description*                    
 [41] print.check_package_description_encoding*           
 [42] print.check_package_license*                        
 [43] print.check_packages_in_dir*                        
 [44] print.check_packages_used*                          
 [45] print.check_po_files*                               
 [46] print.check_pragmas*                                
 [47] print.check_Rd_line_widths*                         
 [48] print.check_Rd_metadata*                            
 [49] print.check_Rd_xrefs*                               
 [50] print.check_RegSym_calls*                           
 [51] print.check_S3_methods_needing_delayed_registration*
 [52] print.check_so_symbols*                             
 [53] print.check_T_and_F*                                
 [54] print.check_url_db*                                 
 [55] print.check_vignette_index*                         
 [56] print.checkDocFiles*                                
 [57] print.checkDocStyle*                                
 [58] print.checkFF*                                      
 [59] print.checkRd*                                      
 [60] print.checkRdContents*                              
 [61] print.checkReplaceFuns*                             
 [62] print.checkS3methods*                               
 [63] print.checkTnF*                                     
 [64] print.checkVignettes*                               
 [65] print.citation*                                     
 [66] print.cli_ansi_html_style*                          
 [67] print.cli_ansi_string*                              
 [68] print.cli_ansi_style*                               
 [69] print.cli_boxx*                                     
 [70] print.cli_diff_chr*                                 
 [71] print.cli_doc*                                      
 [72] print.cli_progress_demo*                            
 [73] print.cli_rule*                                     
 [74] print.cli_sitrep*                                   
 [75] print.cli_spark*                                    
 [76] print.cli_spinner*                                  
 [77] print.cli_tree*                                     
 [78] print.codoc*                                        
 [79] print.codocClasses*                                 
 [80] print.codocData*                                    
 [81] print.colorConverter*                               
 [82] print.compactPDF*                                   
 [83] print.condition                                     
 [84] print.connection                                    
 [85] print.CRAN_package_reverse_dependencies_and_views*  
 [86] print.data.frame                                    
 [87] print.Date                                          
 [88] print.default                                       
 [89] print.dendrogram*                                   
 [90] print.density*                                      
 [91] print.difftime                                      
 [92] print.dist*                                         
 [93] print.Dlist                                         
 [94] print.DLLInfo                                       
 [95] print.DLLInfoList                                   
 [96] print.DLLRegisteredRoutines                         
 [97] print.dummy_coef*                                   
 [98] print.dummy_coef_list*                              
 [99] print.ecdf*                                         
[100] print.eigen                                         
[101] print.factanal*                                     
[102] print.factor                                        
[103] print.family*                                       
[104] print.fileSnapshot*                                 
[105] print.findLineNumResult*                            
[106] print.formula*                                      
[107] print.ftable*                                       
[108] print.function                                      
[109] print.getAnywhere*                                  
[110] print.glm*                                          
[111] print.hashtab*                                      
[112] print.hclust*                                       
[113] print.help_files_with_topic*                        
[114] print.hexmode                                       
[115] print.HoltWinters*                                  
[116] print.hsearch*                                      
[117] print.hsearch_db*                                   
[118] print.htest*                                        
[119] print.html*                                         
[120] print.html_dependency*                              
[121] print.htmltools.selector*                           
[122] print.htmltools.selector.list*                      
[123] print.infl*                                         
[124] print.integrate*                                    
[125] print.isoreg*                                       
[126] print.json*                                         
[127] print.key_missing*                                  
[128] print.kmeans*                                       
[129] print.knitr_kable*                                  
[130] print.Latex*                                        
[131] print.LaTeX*                                        
[132] print.libraryIQR                                    
[133] print.listof                                        
[134] print.lm*                                           
[135] print.loadings*                                     
[136] print.loess*                                        
[137] print.logLik*                                       
[138] print.ls_str*                                       
[139] print.medpolish*                                    
[140] print.MethodsFunction*                              
[141] print.mtable*                                       
[142] print.NativeRoutineList                             
[143] print.news_db*                                      
[144] print.nls*                                          
[145] print.noquote                                       
[146] print.numeric_version                               
[147] print.object_size*                                  
[148] print.octmode                                       
[149] print.packageDescription*                           
[150] print.packageInfo                                   
[151] print.packageIQR*                                   
[152] print.packageStatus*                                
[153] print.pairwise.htest*                               
[154] print.person*                                       
[155] print.POSIXct                                       
[156] print.POSIXlt                                       
[157] print.power.htest*                                  
[158] print.ppr*                                          
[159] print.prcomp*                                       
[160] print.princomp*                                     
[161] print.proc_time                                     
[162] print.quosure*                                      
[163] print.quosures*                                     
[164] print.raster*                                       
[165] print.Rconcordance*                                 
[166] print.Rd*                                           
[167] print.recordedplot*                                 
[168] print.restart                                       
[169] print.RGBcolorConverter*                            
[170] print.RGlyphFont*                                   
[171] print.rlang_box_done*                               
[172] print.rlang_box_splice*                             
[173] print.rlang_data_pronoun*                           
[174] print.rlang_dict*                                   
[175] print.rlang_dyn_array*                              
[176] print.rlang_envs*                                   
[177] print.rlang_error*                                  
[178] print.rlang_fake_data_pronoun*                      
[179] print.rlang_lambda_function*                        
[180] print.rlang_message*                                
[181] print.rlang_trace*                                  
[182] print.rlang_warning*                                
[183] print.rlang_zap*                                    
[184] print.rlang:::list_of_conditions*                   
[185] print.rle                                           
[186] print.rlib_bytes*                                   
[187] print.rlib_error_3_0*                               
[188] print.rlib_trace_3_0*                               
[189] print.roman*                                        
[190] print.scalar*                                       
[191] print.sessionInfo*                                  
[192] print.shiny.tag*                                    
[193] print.shiny.tag.env*                                
[194] print.shiny.tag.list*                               
[195] print.shiny.tag.query*                              
[196] print.simple.list                                   
[197] print.smooth.spline*                                
[198] print.socket*                                       
[199] print.srcfile                                       
[200] print.srcref                                        
[201] print.stepfun*                                      
[202] print.stl*                                          
[203] print.StructTS*                                     
[204] print.subdir_tests*                                 
[205] print.summarize_CRAN_check_status*                  
[206] print.summary.aov*                                  
[207] print.summary.aovlist*                              
[208] print.summary.ecdf*                                 
[209] print.summary.glm*                                  
[210] print.summary.lm*                                   
[211] print.summary.loess*                                
[212] print.summary.manova*                               
[213] print.summary.nls*                                  
[214] print.summary.packageStatus*                        
[215] print.summary.ppr*                                  
[216] print.summary.prcomp*                               
[217] print.summary.princomp*                             
[218] print.summary.table                                 
[219] print.summary.warnings                              
[220] print.summaryDefault                                
[221] print.table                                         
[222] print.tables_aov*                                   
[223] print.terms*                                        
[224] print.ts*                                           
[225] print.tskernel*                                     
[226] print.TukeyHSD*                                     
[227] print.tukeyline*                                    
[228] print.tukeysmooth*                                  
[229] print.undoc*                                        
[230] print.vignette*                                     
[231] print.warnings                                      
[232] print.xfun_raw_string*                              
[233] print.xfun_record_results*                          
[234] print.xfun_rename_seq*                              
[235] print.xfun_strict_list*                             
[236] print.xgettext*                                     
[237] print.xngettext*                                    
[238] print.xtabs*                                        
see '?methods' for accessing help and source code

Et il y en a beaucoup ! C’est normal, tous les objets veulent définir une manière de s’afficher.

Définir une fonction print.vecteur_avec_titre qui vaut :

print.vecteur_avec_titre <- function(x, ...) { # Les paramètres doivent être compatibles avec ceux de la fonction générique, d'où les ...
  cat(attr(x, "titre"), ":\n") # \n correspond à un saut de ligne
  cat(as.vector(x))
  # cat est une fonction qui permet d'écrire dans la console
}

Puis taper mon_vecteur pour vérifier ce qu’il se passe.

print.vecteur_avec_titre <- function(x, ...) { # Les paramètres doivent être compatibles avec ceux de la fonction générique, d'où les ...
  cat(attr(x, "titre"), ":\n") # \n correspond à un saut de ligne
  cat(as.vector(x))
  # cat est une fonction qui permet d'écrire dans la console
}
mon_vecteur
Les 10 premiers entiers :
1 2 3 4 5 6 7 8 9 10

On a implémenté la fonction générique print() par une *méthode* adaptée à la *classe*“vecteur_avec_titre”`. Dorénavant, l’affichage est plus propre.

On a donc créé notre propre méthode S3 à une fonction générique pré-existante. On veut aller plus loin et créer notre propre fonction générique. On veut :

  • une fonction générique get_titre qui n’ait que pour argument x.
  • Elle doit avoir une méthode get_titre.vecteur_avec_titre qui retourne le titre.
  • Elle doit avoir une méthode get_titre.tbl_df qui lance stop("Un tibble n'a pas de titre !").

Tester ensuite cette fonction par get_titre(mon_vecteur) et get_titre(dplyr::starwars).

get_titre <- function(x) UseMethod("get_titre")
get_titre.vecteur_avec_titre <- function(x) attr(x, "titre")
get_titre.tbl_df <- function(x) stop("Un tibble n'a pas de titre !")
get_titre(mon_vecteur)
[1] "Les 10 premiers entiers"
get_titre(dplyr::starwars)
Error in get_titre.tbl_df(dplyr::starwars): Un tibble n'a pas de titre !

On a donc ici créé une fonction générique, et on l’a implémenté par deux méthodes. Une pour vecteur_avec_titre, et une autre plus succinte pour les tibble, qui dirige vers une erreur.

Exercices

Exercice 1

Utiliser la fonction attributes() pour retourner les attributs d’un vecteur c(arnaud=1, bonjour=2). Comment sont stockés les noms dans un vecteur nommé ?

attributes(c(arnaud=1, bonjour=2))
$names
[1] "arnaud"  "bonjour"

On voit qu’un vecteur nommé n’est rien de plus qu’un vecteur avec un attribut names.

Soit la matrice définie par :

matrice <- matrix(1L:12L, nrow = 3L, ncol = 4L)
colnames(matrice) <- c("les", "noms", "de", "colonnes")
rownames(matrice) <- c("voilà", "des", "lignes")

Utiliser la fonction typeof() pour voir le type des données d’une matrice. Utiliser la fonction attributes() pour retourner les attributs de cette matrice. Comment sont stockées les dimensions dans une matrice ? Comment sont stockés les noms de colonnes et de dans une matrice ? Y a-t-il un attribut class dans une matrice ? Est-ce que pour autant inherits(matrice, "matrix") renvoie FALSE ?

matrice <- matrix(1L:12L, nrow = 3L, ncol = 4L)
typeof(matrice)
[1] "integer"
colnames(matrice) <- c("les", "noms", "de", "colonnes")
rownames(matrice) <- c("voilà", "des", "lignes")
attributes(matrice)
$dim
[1] 3 4

$dimnames
$dimnames[[1]]
[1] "voilà"  "des"    "lignes"

$dimnames[[2]]
[1] "les"      "noms"     "de"       "colonnes"

On voit que :

  • Une matrice n’est rien d’autre qu’un vecteur (ici un vecteur de type "integer")
  • Les dimensions sont stockées sous la forme d’un attribut dim qui vaut c(nrow, ncol)
  • Les noms sont stockés sous la forme d’un attribut dimnames. Une liste de longueur 2 qui vaut list(noms_lignes, noms_colonnes).
  • De manière malheureusmement irrégulière et pour des raisons historiques, les matrices n’ont pas d’attribut class renseigné. La classe est implicite par la présence d’un attribut dim. On pourra par cependant vérifier que inherits(matrice, "matrix") vaut TRUE, de même que is.matrix(matrice). Si les matrices étaient reconstruites aujourd’hui, sans doute qu’elles auraient un attribut class comme tout le monde.

On voit qu’il suffit de renseigner un attribut dim à un vecteur pour définir une matrice. À l’aide de la fonction structure(), définir un vecteur m de valeur 1:12 muni d’un attribut dim qui signale une dimension de 3*4. Vérifier avec inherits(m, "matrix") et is.matrix(m) que le vecteur est bien pleinement reconnu comme une matrice.

m <- structure(1:12, dim = c(3, 4))
inherits(m, "matrix")
[1] TRUE
is.matrix(m)
[1] TRUE

On a vérifié qu’il suffit de définir un attribut de dimension pour dire qu’un vecteur est une matrice. Une matrice n’est rien de plus qu’un vecteur auquel on a rajouté une dimension.

Exercice 2 : Simuler des instances

Dans le chapitre sur l’évaluation, on était parvenu à ce compteur :

nouveau_compteur <-
  function() {
    n <- 0L
    this <-
      list(
        suivant = function() {
          n <<- n + 1L
          this
        },
        get = function() {
          n
        }
      )
    this
  }

compteur_1 <- nouveau_compteur()
compteur_2 <- nouveau_compteur()
compteur_1$
  suivant()$
  suivant()$
  suivant()
compteur_1$get()
compteur_2$get()
compteur_1$suivant()
compteur_2$suivant()
compteur_1$get()
compteur_2$get()

On demande dans cette exercice de :

  • Modifier le code de la fonction nouveau_compteur() pour que la liste qu’elle renvoie soit de classe “super_compteur”.
  • Implémenter une méthode de la fonction générique print() qui affiche Super Compteur : [i]\n si le compteur en est à [i] (on rappelle que \n est une manière d’indiquer un saut de ligne).
nouveau_compteur <-
  function() {
    n <- 0L
    this <-
      list(
        suivant = function() {
          n <<- n + 1L
          this
        },
        get = function() {
          n
        }
      )
    class(this) <- "super_compteur"
    this
  }

print.super_compteur <- function(x, ...) {
  cat("Super Compteur : ", x$get(), "\n", sep = "")
}

compteur_1 <- nouveau_compteur()
compteur_2 <- nouveau_compteur()
compteur_1$
  suivant()$
  suivant()$
  suivant()
Super Compteur : 3
compteur_1$get()
[1] 3
compteur_2$get()
[1] 0
compteur_1$suivant()
Super Compteur : 4
compteur_2$suivant()
Super Compteur : 1
compteur_1$get()
[1] 4
compteur_2$get()
[1] 1

On a maintenant un objet S3 qui se comporte avec des instances, comme en Programmation Orientée Objet classique.