Programmation orientée objet

Question 1 :

Création de méthodes et de classes S3

Reprenons la fonction compte_impair_vectoriel créée au dernier cours :

compte_impair_vectoriel <- function(x, na.rm = FALSE) {
  sum(x %% 2 == 1, na.rm = na.rm)
}

Créez une méthode pour la fonction générique print qui affiche comme suit la sortie de la fonction compte_impair_vectoriel (les caractères ## ne font pas partie de la sortie, ils indiquent qu’il s’agit d’une sortie) :

compte_impair_vectoriel(c(6, 3, 5.5, NA, 0), na.rm = TRUE)

## Ce vecteur contient 1 nombre entier impair.

Il vous faudra modifier le corps de la fonction compte_impair_vectoriel en plus de définir la méthode.

Assurez-vous de pouvoir passer des arguments à la fonction cat, que vous devriez appeler dans le corps de votre méthode, de façon à pouvoir reproduire ceci :

resultat <- compte_impair_vectoriel(c(6, 3, 5.5, NA, 0, -5), na.rm = TRUE)
print(resultat, sep = " * ")

## Ce vecteur contient * 2 * nombres entiers impairs.

Solution

compte_impair_vectoriel <- function(x, na.rm = FALSE) {
  out <- sum(x %% 2 == 1, na.rm = na.rm)
  class(out) <- "compte_impair"
  return(out)
}
# ou
compte_impair_vectoriel <- function(x, na.rm = FALSE) {
  structure(
    sum(x %% 2 == 1, na.rm = na.rm), 
    class = "compte_impair"
  )
}

print.compte_impair <- function(x, ...){
  if (is.na(x)) {
    cat("Le nombre d'entiers impairs dans ce vecteur n'a pas été compté, car il contient des valeurs manquantes.\n", ...)
  } else if (x == 0) {
    cat("Ce vecteur ne contient aucun nombre entier impair.\n", ...)
  } else if (x == 1) {
    cat("Ce vecteur contient 1 nombre entier impair.\n", ...)
  } else {
    cat("Ce vecteur contient", x, "nombres entiers impairs.\n", ...)
  }
  invisible(x)
}

# Exemples de résultats obtenus
compte_impair_vectoriel(c(6, 5.5, NA, 0), na.rm = FALSE)
## Le nombre d'entiers impairs dans ce vecteur n'a pas été compté, car il contient des valeurs manquantes.
compte_impair_vectoriel(c(6, 5.5, NA, 0), na.rm = TRUE)
## Ce vecteur ne contient aucun nombre entier impair.
compte_impair_vectoriel(c(6, 3, 5.5, NA, 0), na.rm = TRUE)
## Ce vecteur contient 1 nombre entier impair.
compte_impair_vectoriel(c(6, 3, 5.5, NA, 0, -5), na.rm = TRUE)
## Ce vecteur contient 2 nombres entiers impairs.
compte_impair_vectoriel(c(6, 3, 5.5, NA, 0, -5, 1), na.rm = TRUE)
## Ce vecteur contient 3 nombres entiers impairs.

resultat <- compte_impair_vectoriel(c(6, 3, 5.5, NA, 0, -5), na.rm = TRUE)
resultat
## Ce vecteur contient 2 nombres entiers impairs.
print(resultat)
## Ce vecteur contient 2 nombres entiers impairs.
print(resultat, sep = " * ")
## Ce vecteur contient * 2 * nombres entiers impairs.

Question 2 :

Création de méthodes et de classes S3

Créez une méthode de la fonction générique summary, pour un objet produit par la fonction compte_impair_vectoriel, afin d’obtenir une sortie comme la suivante :

resultat <- compte_impair_vectoriel(c(6, 3, 5.5, NA, 0, -5), na.rm = TRUE)
summary(resultat)

## Fréquence de nombres impairs
##                            2

Solution

resultat <- compte_impair_vectoriel(c(6, 3, 5.5, NA, 0, -5), na.rm = TRUE)

# Résultat obtenu avant de créer la méthode
summary(resultat)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       2       2       2       2       2       2 
      
# Méthode pour la fonction générique summary
summary.compte_impair <- function(object, ...) {
  names(object) <- "Fréquence de nombres impairs"
  return(unclass(object))
}

# Résultat obtenu après avoir créé la méthode
sortie <- summary(resultat)
sortie
## Fréquence de nombres impairs 
##                            2

Question 3 :

Utilisation de classes S4

Créez une matrice « sparse » en soumettant les instructions suivantes :

library(Matrix)
matrice_sparse <- Matrix(
  c(0, 0, 1, 0, 3, 0, 2, 0, 4), 
  nrow = 3, ncol = 3, sparse = TRUE
)

L’objet matrice_sparse possède une classe de type S4. Quels sont les noms de tous les éléments (slots) qu’il contient ?

Solution

library(Matrix)
matrice_sparse <- Matrix(
  c(0, 0, 1, 0, 3, 0, 2, 0, 4), 
  nrow = 3, ncol = 3, sparse = TRUE
)
matrice_sparse
## 3 x 3 sparse Matrix of class "dgCMatrix"
##           
## [1,] . . 2
## [2,] . 3 .
## [3,] 1 . 4

str(matrice_sparse)
## Formal class 'dgCMatrix' [package "Matrix"] with 6 slots
##   ..@ i       : int [1:4] 2 1 0 2
##   ..@ p       : int [1:4] 0 1 2 4
##   ..@ Dim     : int [1:2] 3 3
##   ..@ Dimnames:List of 2
##   .. ..$ : NULL
##   .. ..$ : NULL
##   ..@ x       : num [1:4] 1 3 2 4
##   ..@ factors : list()
  
slotNames(matrice_sparse)
## [1] "i"        "p"        "Dim"      "Dimnames" "x"        "factors"

Tests et exceptions

Programme à sourcer pour questions suivantes

Dans les questions suivantes, nous allons tester une fonction, la déboguer et la modifier de façon à ce qu’elle se comporte tel que nous le désirons. La fonction en question se trouve dans le fichier coef_asym_version_1.R, téléchargeable sur le site web du cours (dans le fichier compressé tests_exceptions_r_fichiers_exercices.zip).

Téléchargez ce script R et sourcez-le en R.

Le script comprend la définition de fonction suivante :

# Fonction pour le calcul du coefficient d'asymétrie (skewness)
# Référence : http://en.wikipedia.org/wiki/Skewness, formule G1

# Arguments en entrée :
#   x       un vecteur de valeurs numériques.
#   na.rm   une valeur logique (par défaut FALSE) indiquant si les valeurs
#           NA devraient être enlevée avant de procéder aux calculs.

# Sortie : le coefficient d'asymétrie pour les valeurs dans x

coef_asym <- function(x, na.rm = FALSE){
  m3 <- mean((x - mean(x, na.rm = na.rm))^3, na.rm = na.rm)
  s3 <- sd(x, na.rm = na.rm)^3
  n <- length(x)
  G1 <- (n^2) * m3 / ((n - 1) * (n - 2) * s3)
  G1
}

Solution

setwd("C:/coursR/FichiersPourExercicesS11/")
# Ajustez selon l'emplacement des fichiers sur votre ordinateur

source("coef_asym_version_1.R", encoding = 'UTF-8')

Question 4 :

Tests - Objectif 1 : obtenir le résultat escompté

Comparaison à un calcul fait à la main

4.1

Nous allons maintenant effectuer des tests pour vérifier si la fonction coef_asym retourne le résultat escompté.

Commençons avec des données très simples :

x <- c(1, 1, 4)

Faites le calcul « à la main », en utilisant R comme une calculatrice, pour évaluer le résultat que la fonction coef_asym devrait retourner (il faut utiliser la formule G1 présentée ici https://en.wikipedia.org/wiki/Skewness#Sample_skewness).
Est-ce que la fonction devrait retourner la même chose avec les arguments na.rm = TRUE et avec na.rm = FALSE?
Appelez maintenant la fonction coef_asym pour effectuer le calcul, une fois avec na.rm = TRUE et une autre fois avec na.rm = FALSE.
Obtenez-vous les résultats escomptés?

Solution

# Données test
x <- c(1, 1, 4)

# ---- a ----

# Calcul à la main :
n <- 3
moy <- (1 + 1 + 4) / n
moy
## [1] 2
m3 <- ((1 - moy)^3 + (1 - moy)^3 + (4 - moy)^3) / n
m3
## [1] 2
s3 <- (((1 - moy)^2 + (1 - moy)^2 + (4 - moy)^2) / (n - 1))^(3 / 2)
s3
## [1] 5.196152

# Résultat escompté
(n^2) * m3 / ((n - 1) * (n - 2) * s3)
## [1] 1.732051

# ---- b ----

# Étant donné que x ne contient pas de NA,
# coef_asym devrait retourner le même nombre,
# peu importe la valeur de l'argument na.rm

# ---- c ----

# Calcul effectué par coef_asym
coef_asym(c(1, 1, 4)) # na.rm = FALSE
## [1] 1.732051
coef_asym(c(1, 1, 4), na.rm = TRUE)
## [1] 1.732051

# ---- d ----

# J'obtiens bien les résultats escomptés.

4.2

Modifions un tout petit peu les données test en ajoutant une valeur manquante au vecteur.

x <- c(1, 1, 4, NA)

Qu’est-ce que la commande coef_asym(c(1, 1, 4, NA)) devrait retourner?
Qu’est-ce que la commande coef_asym(c(1, 1, 4, NA), na.rm = TRUE) devrait retourner?
Obtenez-vous les résultats escomptés?

Solution

coef_asym(c(1, 1, 4, NA))
## [1] NA
# devrait retourner NA -> fonctionne

coef_asym(c(1, 1, 4, NA), na.rm = TRUE)
## [1] 1.0264
# devrait retourner la même chose que :
coef_asym(c(1, 1, 4))
## [1] 1.732051
# -> ne fonctionne pas

Question 5 :

Tests - Objectif 1 : obtenir le résultat escompté

Comparaison à un calcul fait par une fonction alternative

5.1

Est-ce qu’une autre fonction effectuant le même calcul que coef_asym existe :

dans le R de base ?
dans un package disponible sur le CRAN ?

Solution

# rien dans le R de base

# La fonction skewness, du package moments, 
# mais elle n'implémente pas la même formule G1

# La fonction skewness du package e1071, 
# avec l'argument type = 2
library(e1071)
help(skewness)

5.2

Les deux commandes suivantes devraient retourner la même valeur. Est-ce bien le cas ?

skewness(cars$speed, type = 2)
coef_asym(cars$speed)

Solution

skewness(cars$speed, type = 2)
## [1] -0.1175099
coef_asym(cars$speed)
## [1] -0.1175099

# même résultat -> ça fonctionne

5.3

Est-ce que la commande suivante retourne le résultat escompté (contrairement à notre fonction coef_asym) ?

skewness(c(1, 1, 4, NA), type = 2, na.rm = TRUE)

Solution

skewness(c(1, 1, 4, NA), na.rm = TRUE, type = 2)
## [1] 1.732051
# bonne réponse

Question 6 :

Tests - Objectif 1 : obtenir le résultat escompté

Comparaison à un résultat théorique

La distribution normale est par définition symétrique (coefficient d’asymétrie théorique = 0). Un échantillon provenant d’une loi normale devrait donc avoir un coefficient d’asymétrie échantillonnal valant autour de 0. La loi des grands nombres nous dit que plus la taille de cet échantillon est grand, plus la valeur du coefficient d’asymétrie échantillonnal se rapprochera de zéro.

Que devrait retourner la commande suivante ?

coef_asym(rnorm(1000000))

Est-ce qu’elle retourne bien le résultat escompté ?

Solution

# devrait retourner environ 0

set.seed(151)  # afin de pouvoir comparer nos résultats
coef_asym(rnorm(1000000))
## [1] -0.001315733
# retourne environ 0 -> ça fonctionne

Question 7 :

Tests - Objectif 2 : correctement gérer les exceptions

7.1

Testons le comportement de la fonction si nous lui donnons en entrée une valeur inadéquate pour l’argument x. Pour les cas suivants, est-ce que la fonction a un comportement correct?

matrice de nombres : x = matrix(rnorm(16), nrow = 4, ncol = 4)
data frame de nombres : x = as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4))
vecteur de chaînes de caractères : x = letters

Solution

# ---- a ----
# matrice de nombres

set.seed(1644)  # afin de pouvoir comparer nos résultats
matrice <- matrix(rnorm(16), nrow = 4, ncol = 4)

coef_asym(x = matrice)
## [1] -0.308445

# matrice traitée comme un vecteur
# nous pourrions choisir d'émettre un avertissement

# ---- b ----
# data frame de nombres

coef_asym(x = as.data.frame(matrice))
## Error in is.data.frame(x) : 
##   'list' object cannot be coerced to type 'double'
## In addition: Warning messages:
## 1: In mean.default(x, na.rm = na.rm) :
##   argument is not numeric or logical: returning NA
## 2: In mean.default((x - mean(x, na.rm = na.rm))^3, na.rm = na.rm) :
##   argument is not numeric or logical: returning NA

# erreur plus ou moins claire + avertissements

# ---- c ----
# vecteur de chaînes de caractères

coef_asym(x = letters)
## Error in x - mean(x, na.rm = na.rm) : 
##   non-numeric argument to binary operator
## In addition: Warning message:
## In mean.default(x, na.rm = na.rm) :
##   argument is not numeric or logical: returning NA

# Ok, erreur suffisamment informative
# mais il serait préférable qu'il n'y ait pas en plus un avertissement

7.2

Testons le comportement de la fonction si nous lui donnons en entrée une valeur inadéquate pour l’argument na.rm. Pour les cas suivants, est-ce que la fonction a un comportement correct ?

une valeur numérique : na.rm = 4 ou na.rm = -4 ou na.rm = 0
une chaîne de caractères : na.rm = "Vrai"
un vecteur logique de longueur > 1 : na.rm = c(TRUE, FALSE)

Solution

# ---- a ----
# une valeur numérique

coef_asym(c(1, 1, 4, NA), na.rm = 4)
## [1] 1.0264
coef_asym(c(1, 1, 4, NA), na.rm = -4)
## [1] 1.0264
coef_asym(c(1, 1, 4, NA), na.rm = 0)
## [1] NA

# conversion automatique de la valeur numérique en valeur logique
# nous pourrions choisir d'émettre un avertissement

# ---- b ----
# une chaîne de caractères 

coef_asym(c(1, 1, 4, NA), na.rm = "Vrai")
## Error in if (na.rm) x <- x[!is.na(x)] : 
##   argument is not interpretable as logical 

# Ok, erreur suffisamment informative

# ---- c ----
# un vecteur logique de longueur > 1

coef_asym(c(1, 1, 4, NA), na.rm = c(TRUE, FALSE))
## Warning messages:
## 1: In if (na.rm) x <- x[!is.na(x)] :
##   the condition has length > 1 and only the first element will be used
## 2: In if (na.rm) x <- x[!is.na(x)] :
##   the condition has length > 1 and only the first element will be used
## 3: In if (na.rm) "na.or.complete" else "everything" :
##   the condition has length > 1 and only the first element will be used

# OK, avertissements émis

Question 8 :

Tests - Formaliser des tests avec le package testthat

J’ai formalisé tous les tests que nous avons effectués avec le package testthat. Ces tests se trouvent dans le fichier tests_coef_asym.R, sur le site web du cours (dans le fichier compressé tests_exceptions_r_fichiers_exercices.zip).

Téléchargez ce fichier et soumettez tous les tests qu’il contient avec les commandes suivantes :

library(testthat)
test_file("chemin_approprie/tests_coef_asym.R")

Solution

# Contenu du fichier tests_coef_asym.R

library(e1071)  # afin de pouvoir utiliser la fonction skewness

test_that("coef_asym reproduit un calcul a la main sur un petit jeu de donnees", {
  n <- 3
  moy <- (1 + 1 + 4) / n
  m3 <- ((1 - moy)^3 + (1 - moy)^3 + (4 - moy)^3) / n
  s3 <- (((1 - moy)^2 + (1 - moy)^2 + (4 - moy)^2) / (n - 1))^(3 / 2)
  expect_equal(coef_asym(c(1, 1, 4)), (n^2) * m3 / ((n - 1) * (n - 2) * s3))
  expect_equal(coef_asym(c(1, 1, 4), na.rm = TRUE), (n^2) * m3 / ((n - 1) * (n - 2) * s3))
})

test_that("coef_asym traite correctement les valeurs manquantes", {
  n <- 3
  moy <- (1 + 1 + 4)/n
  m3 <- ((1 - moy)^3 + (1 - moy)^3 + (4 - moy)^3) / n
  s3 <- (((1 - moy)^2 + (1 - moy)^2 + (4 - moy)^2) / (n - 1))^(3 / 2)
  expect_true(is.na(coef_asym(c(1, 1, 4, NA))))
  expect_equal(coef_asym(c(1, 1, 4, NA), na.rm = TRUE), (n^2) * m3 / ((n - 1) * (n - 2) * s3))
})

test_that("coef_asym reproduit des resultats obtenus de la fonction skewness du package e1071", {
  expect_equal(coef_asym(cars$speed), skewness(cars$speed, type = 2))
})

test_that("coef_asym retourne approximativement 0 pour un gros échantillon tire d'une loi normale", {
  expect_equal(coef_asym(rnorm(1000000)), 0, tolerance = 0.01)
})

#**************************************************************************

test_that("coef_asym reagit correctement a un argument x incorrect", {
  expect_warning(coef_asym(matrix(rnorm(16), nrow = 4, ncol = 4)))
  expect_error(coef_asym(as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4))), "x doit etre un vecteur")
  expect_error(coef_asym(letters))
})

test_that("coef_asym reagit correctement a un argument na.rm incorrect", {
  expect_warning(coef_asym(c(1, 1, 4, NA), na.rm = 4))
  expect_error(coef_asym(c(1, 1, 4, NA), na.rm = "Vrai"))
  expect_warning(coef_asym(c(1, 1, 4, NA), na.rm = c(TRUE, FALSE)))
})

# Pour faire rouler les tests
library(testthat)
test_file("tests_coef_asym.R")
## 
## == Testing tests_coef_asym.R ================================================================================================================
## [ FAIL 4 | WARN 4 | SKIP 0 | PASS 8 ]
## 
## -- Warning (tests_coef_asym.R:10:1): (code run outside of `test_that()`) ---------------------
## package ‘e1071’ was built under R version 4.0.4
## Backtrace:
##  1. base::library(e1071) tests_coef_asym.R:10:0
##  2. base:::testRversion(pkgInfo, package, pkgpath)
## 
## -- Failure (tests_coef_asym.R:27:3): coef_asym traite correctement les valeurs manquantes ---------------------------
## coef_asym(c(1, 1, 4, NA), na.rm = TRUE) not equal to (n^2) * m3/((n - 1) * (n - 2) * s3).
## 1/1 mismatches
## [1] 1.03 - 1.73 == -0.706
## 
## -- Failure (tests_coef_asym.R:41:3): coef_asym reagit correctement a un argument x incorrect ---------------------------
## `coef_asym(matrix(rnorm(16), nrow = 4, ncol = 4))` did not produce any warnings.
## 
## -- Warning (tests_coef_asym.R:42:3): coef_asym reagit correctement a un argument x incorrect ---------------------
## argument is not numeric or logical: returning NA
## Backtrace:
##  1. testthat::expect_error(...) tests_coef_asym.R:42:2
##  6. global::coef_asym(as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))
##  9. base::mean.default(x, na.rm = na.rm)
## 
## -- Warning (tests_coef_asym.R:42:3): coef_asym reagit correctement a un argument x incorrect ---------------------
## argument is not numeric or logical: returning NA
## Backtrace:
##  1. testthat::expect_error(...) tests_coef_asym.R:42:2
##  6. global::coef_asym(as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))
##  8. base::mean.default((x - mean(x, na.rm = na.rm))^3, na.rm = na.rm)
## 
## -- Failure (tests_coef_asym.R:42:3): coef_asym reagit correctement a un argument x incorrect ---------------------------
## `coef_asym(as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))` threw an error with unexpected message.
## Expected match: "x doit etre un vecteur"
## Actual message: "'list' object cannot be coerced to type 'double'"
## Backtrace:
##  1. testthat::expect_error(...) tests_coef_asym.R:42:2
##  6. global::coef_asym(as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))
##  7. stats::sd(x, na.rm = na.rm) coef_asym_version_1.R:23:2
##  8. stats::var(...)
##  9. base::is.data.frame(x)
## 
## -- Warning (tests_coef_asym.R:43:3): coef_asym reagit correctement a un argument x incorrect ---------------------
## argument is not numeric or logical: returning NA
## Backtrace:
##  1. testthat::expect_error(coef_asym(letters)) tests_coef_asym.R:43:2
##  6. global::coef_asym(letters)
##  9. base::mean.default(x, na.rm = na.rm)
## 
## -- Failure (tests_coef_asym.R:47:3): coef_asym reagit correctement a un argument na.rm incorrect ---------------------------
## `coef_asym(c(1, 1, 4, NA), na.rm = 4)` did not produce any warnings.
## 
## [ FAIL 4 | WARN 4 | SKIP 0 | PASS 8 ]

Question 9 :

Débogage

La fonction coef_asym échoue 4 de ses tests. Nous allons effectuer du débogage pour trouver des solutions à ces tests échoués.

Premièrement, tentons de voir quelles instructions du code de la fonction sont responsables du mauvais résultat retourné par la commande :

coef_asym(c(1, 1, 4, NA), na.rm = TRUE)

Expérimentez les façons suivantes d’insérer un appel à la fonction browser dans le corps de la fonction coef_asym :

à la main, en éditant le code source;
en utilisant la fonction trace;
en utilisant la fonction debug.
en utilisant une fonctionnalité de RStudio.

Ensuite, faites votre enquête en ajoutant temporairement des appels aux fonctions print et/ou cat dans le corps de la fonction coef_asym.

Note : Vous pouvez me voir répondre à cette question dans une capsule narrée (vidéo) rendue disponible en-dessous des exercices sur le site web du cours.

Solution

# ---- a) ----
# À la main, en éditant le code source, puis en sourçant le code  

# Le code source édité est dans le fichier coef_asym_browser.R
# Le fichier coef_asym_browser.R est inclus dans les fichiers accompagnateurs.

## coef_asym <- function(x, na.rm = FALSE){
##   browser()
##   m3 <- mean((x - mean(x, na.rm = na.rm))^3, na.rm = na.rm)
##   s3 <- sd(x, na.rm = na.rm)^3
##   n <- length(x)
##   G1 <- (n^2) * m3 / ((n - 1) * (n - 2) * s3)
##   G1
## }

# Ajustez selon l'emplacement du fichier sur votre ordinateur
source("coef_asym_browser.R", encoding = 'UTF-8')
coef_asym(c(1, 1, 4, NA), na.rm = TRUE)
source("coef_asym_version_1.R", encoding = 'UTF-8') # pour revenir à la version sans browser

# ---- b) ----
# En utilisant la fonction `trace`

trace(coef_asym, browser)
edit(coef_asym)
# Nous pouvons voir l'ajout au code source (.doTrace(browser(), "on entry") +++)
# CliqueZ sur Cancel pour refermer la fenêtre (ignorez l'erreur générée).

# Aussi, dans la sous-fenêtre Environment, il y a un point rouge vis-à-vis la fonction.

coef_asym(c(1, 1, 4, NA), na.rm = TRUE)
untrace(coef_asym)
# Le point rouge vis-à-vis la fonction dans la sous-fenêtre Environment n'est plus là.

# ---- c) ----
# En utilisant la fonction `debug`

debug(coef_asym)
edit(coef_asym)
# Même s'il n'y a pas de modification au code source, ça va fonctionner.
coef_asym(c(1, 1, 4, NA), na.rm = TRUE)
undebug(coef_asym)

# ---- d) ----
# En utilisant une fonctionnalité de RStudio

# Ajouter un point d’arrêt dans le code source de coef_asym,
# dans le fichier coef_asym_version_1.R,
# en cliquant dans la marge de gauche (à gauche du numéro de ligne)
# sur la première ligne du corps de la fonction.
# Un point rouge va apparaître.

# Un point rouge devrait aussi apparaître dans la sous-fenêtre Environment, 
# à gauche de l'objet coef_asym.

coef_asym(c(1, 1, 4, NA), na.rm = TRUE)

# Une fois le débogage terminé, retourner dans le code source
# et cliquez sur le point rouge dans la marge de gauche.
# Il devrait disparaître, comme celui dans la fenêtre Environment.

# ---- print ou cat ----

# Utilisation de print ou cat

# Le code source édité est dans le fichier coef_asym_cat.R
# Le fichier coef_asym_cat.R est inclus dans les fichiers accompagnateurs.

## coef_asym <- function(x, na.rm = FALSE){
##   m3 <- mean((x - mean(x, na.rm = na.rm))^3, na.rm = na.rm)
##   cat("m3 = ", m3, "\n")
##   s3 <- sd(x, na.rm = na.rm)^3
##   cat("s3 = ", s3, "\n")
##   n <- length(x)
##   cat("n = ", n, "\n")
##   G1 <- (n^2) * m3 / ((n - 1) * (n - 2) * s3)
##   G1
## }

source("coef_asym_cat.R", encoding = 'UTF-8')
coef_asym(c(1, 1, 4, NA), na.rm = TRUE)
## m3 =  2 
## s3 =  5.196152 
## n =  4 
## [1] 1.0264
source("coef_asym_version_1.R", encoding = 'UTF-8') # pour revenir à la version originale

# Identification du problème :
# n doit contenir le nombre de valeurs numériques non manquantes, 
# pas le nombre total d'éléments dans x.

Question 10 :

Débogage

Modifiez coef_asym afin qu’elle retourne le résultat escompté (1.732051) pour la commande

coef_asym(c(1, 1, 4, NA), na.rm = TRUE)

Tester votre modification pour vous assurer que ça fonctionne maintenant correctement.

Solution

# Code source édité dans le fichier coef_asym_version_2.R
coef_asym <- function(x, na.rm = FALSE) {
  m3 <- mean((x - mean(x, na.rm = na.rm))^3, na.rm = na.rm)
  s3 <- sd(x, na.rm = na.rm)^3
  n <- length(x[!is.na(x)])  # ou sum(!is.na(x))
  G1 <- (n^2) * m3 / ((n - 1) * (n - 2) * s3)
  G1
}
# ou encore
coef_asym <- function(x, na.rm = FALSE) {
  if (na.rm) {
    x <- na.omit(x)
  }
  m3 <- mean((x - mean(x))^3)
  s3 <- sd(x)^3
  n <- length(x)
  G1 <- (n^2) * m3 / ((n - 1) * (n - 2) * s3)
  G1
}
# ou encore (ce que fait la méthode mean.default)
coef_asym <- function(x, na.rm = FALSE) {
  if (na.rm) {
    x <- x[!is.na(x)]
  }
  m3 <- mean((x - mean(x))^3)
  s3 <- sd(x)^3
  n <- length(x)
  G1 <- (n^2) * m3 / ((n - 1) * (n - 2) * s3)
  G1
}

# Remarque :

# Le R Core Team a choisi d'utiliser `x <- x[!is.na(x)]`
# au lieu de `x <- na.omit(x)` pour retirer les valeurs manquantes 
# lorsque na.rm = TRUE dans le corps de plusieurs fonctions de calcul
# de statistiques descriptives (p.ex. mean.default, median.default, 
# quantile.default, etc.). Ce choix est peut-être motivé par le fait
# que na.omit ajoute un attribut à l'objet x et qu'il ne serait pas
# souhaitable que cet attribut traîne dans la sortie retournée
# par la fonction de calcul statistique.

# Si on utilisait na.omit, on pourrait cependant retirer l'attribut
# ajouté à l'objet avec l'instruction suivante :

# attr(x, "na.action") <- NULL

# Détail technique : On a l'impression que na.omit a ajouté deux 
# attributs à x, un appelé "na.action" et l'autre nommé "class". 
# En réalité, "class" n'est pas un attribut de x, c'est un attribut 
# de l'attribut "na.action" (donc l'attribut "na.action" possède une classe).

source("coef_asym_version_2.R", encoding = 'UTF-8')
coef_asym(c(1, 1, 4, NA), na.rm = TRUE)
## [1] 1.732051

# Faire rouler tous les tests de nouveau
test_file("tests_coef_asym.R")
## == Testing tests_coef_asym.R ==================================================================================================================
## [ FAIL 3 | WARN 3 | SKIP 0 | PASS 9 ]
## 
## -- Failure (tests_coef_asym.R:46:3): coef_asym reagit correctement a un argument x incorrect ---------------------------
## `coef_asym(matrix(rnorm(16), nrow = 4, ncol = 4))` did not produce any warnings.
## 
## -- Warning (tests_coef_asym.R:47:3): coef_asym reagit correctement a un argument x incorrect ---------------------
## argument is not numeric or logical: returning NA
## Backtrace:
##   1. testthat::expect_error(...) tests_coef_asym.R:47:2
##   6. global::coef_asym(as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))
##  10. base::mean.default(x)
## 
## -- Warning (tests_coef_asym.R:47:3): coef_asym reagit correctement a un argument x incorrect ---------------------
## argument is not numeric or logical: returning NA
## Backtrace:
##  1. testthat::expect_error(...) tests_coef_asym.R:47:2
##  6. global::coef_asym(as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))
##  9. base::mean.default((x - mean(x))^3)
## 
## -- Failure (tests_coef_asym.R:47:3): coef_asym reagit correctement a un argument x incorrect ---------------------------
## `coef_asym(as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))` threw an error with unexpected message.
## Expected match: "x doit etre un vecteur"
## Actual message: "'list' object cannot be coerced to type 'double'"
## Backtrace:
##  1. testthat::expect_error(...) tests_coef_asym.R:47:2
##  6. global::coef_asym(as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))
##  7. stats::sd(x)
##  8. stats::var(...)
##  9. base::is.data.frame(x)
## 
## -- Warning (tests_coef_asym.R:48:3): coef_asym reagit correctement a un argument x incorrect ---------------------
## argument is not numeric or logical: returning NA
## Backtrace:
##   1. testthat::expect_error(coef_asym(letters)) tests_coef_asym.R:48:2
##   6. global::coef_asym(letters)
##  10. base::mean.default(x)
## 
## -- Failure (tests_coef_asym.R:53:3): coef_asym reagit correctement a un argument na.rm incorrect ---------------------------
## `coef_asym(c(1, 1, 4, NA), na.rm = 4)` did not produce any warnings.
## 
## [ FAIL 3 | WARN 3 | SKIP 0 | PASS 9 ]

Question 11 :

Débogage

Nous avons vu précédemment que la commande suivante générait une erreur :

coef_asym(data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))

Tentez d’identifier de quelle ligne de code, dans quelle fonction, provient l’erreur. Pour ce faire, expérimentez deux outils :

la fonction traceback,
le débogage post mortem avec l’option error = recover.

Note : Vous pouvez me voir répondre à cette question dans une capsule narrée (vidéo) rendue disponible en-dessous des exercices sur le site web du cours.

Solution

# a. fonction traceback

coef_asym(data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))
## Error in is.data.frame(x) : 
##   'list' object cannot be coerced to type 'double'
## In addition: Warning messages:
## 1: In mean.default(x) : argument is not numeric or logical: returning NA
## 2: In mean.default((x - mean(x))^3) :
##   argument is not numeric or logical: returning NA

traceback()
## 4: is.data.frame(x)
## 3: var(if (is.vector(x) || is.factor(x)) x else as.double(x), na.rm = na.rm)
## 2: sd(x) at coef_asym_version_2.R#34
## 1: coef_asym(data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))

# Essais pour mieux comprendre
x <- data.frame(matrix(rnorm(16), nrow = 4, ncol = 4))
sd(x)
## Error in is.data.frame(x) : 
##   (list) object cannot be coerced to type 'double'
na.rm <- FALSE
var(if (is.vector(x) || is.factor(x)) x else as.double(x), na.rm = na.rm)
## Error in is.data.frame(x) : 
##   (list) object cannot be coerced to type 'double'
if (is.vector(x) || is.factor(x)) x else as.double(x)
## Error: (list) object cannot be coerced to type 'double'
traceback()
## No traceback available 

# L'erreur provient en fait de l'appel à la fonction as.double,
# malgré ce que laisse entendre l'introduction du message d'erreur.
# Pourquoi?

# b. le débogage post mortem avec l'option error = recover

options(error = recover)
coef_asym(data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))
# Remarque : 
# Observez les chemins de recherche dans les environnements d'exécution
# des fonctions appelées. Nous pouvons constater la portée lexicale de R.

# Pourquoi l'erreur semble-t-elle produite par la fonction is.data.frame,
# alors qu'elle est produite par la fonction as.double?

# À cause de l'évaluation paresseuse des arguments en R.
# La fonction var est appelée comme suit :
# var(if (is.vector(x) || is.factor(x)) x else as.double(x), na.rm = na.rm)
# Donc la valeur fournie à l'argument x de var est if (is.vector(x) || is.factor(x)) x else as.double(x).
# Cependant, cette instruction est évaluée seulement au moment où R à besoin de la valeur de x.
# Il en a besoin pour la première fois à la ligne 11 de la définition de la fonction var,
# pour évaluer l'instruction is.data.frame(x).
# Et comme 
is.vector(x) || is.factor(x)
# retourne
## FALSE
# R doit évaluer
as.double(x)
# qui produit l'erreur
## Error: (list) object cannot be coerced to type 'double'

options(error = NULL)
# pour mettre fin au débogage post mortem

# Réponse :
# L'erreur provient de la ligne 2 de la fonction sd
# (première ligne du corps de la fonction en fait) :
# sqrt(var(if (is.vector(x) || is.factor(x)) x else as.double(x),

Question 12 :

Gestion d’exceptions - Produire des erreurs et des avertissements

12.1

Modifiez coef_asym afin qu’elle émette un avertissement pour la commande

coef_asym(matrix(rnorm(16), nrow = 4, ncol = 4))

Tester votre modification pour vous assurer que ça fonctionne maintenant correctement.

Solution

# Code source édité dans le fichier coef_asym_version_3.R

coef_asym <- function(x, na.rm = FALSE){

  ## Validation des arguments ##
  if (is.array(x)) {
    warning("x est un array, mais il est traite comme un vecteur")
  }

  ## Calculs ##
  if (na.rm) {
    x <- x[!is.na(x)]
  }
  m3 <- mean((x - mean(x))^3)
  s3 <- sd(x)^3
  n <- length(x)
  G1 <- (n^2) * m3 / ((n - 1) * (n - 2) * s3)
  
  ## Sortie ##
  return(G1)
}

source("coef_asym_version_3.R", encoding = 'UTF-8')

set.seed(756)  # afin de pouvoir comparer nos résultats
coef_asym(matrix(rnorm(16), nrow = 4, ncol = 4))
## [1] 0.6887715

# Faire rouler tous les tests de nouveau
test_file("tests_coef_asym.R")
## == Testing tests_coef_asym.R ==================================================================================================================
## [ FAIL 2 | WARN 3 | SKIP 0 | PASS 10 ]
## 
## -- Warning (tests_coef_asym.R:47:3): coef_asym reagit correctement a un argument x incorrect ---------------------
## argument is not numeric or logical: returning NA
## Backtrace:
##   1. testthat::expect_error(...) tests_coef_asym.R:47:2
##   6. global::coef_asym(as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))
##  10. base::mean.default(x)
## 
## -- Warning (tests_coef_asym.R:47:3): coef_asym reagit correctement a un argument x incorrect ---------------------
## argument is not numeric or logical: returning NA
## Backtrace:
##  1. testthat::expect_error(...) tests_coef_asym.R:47:2
##  6. global::coef_asym(as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))
##  9. base::mean.default((x - mean(x))^3)
## 
## -- Failure (tests_coef_asym.R:47:3): coef_asym reagit correctement a un argument x incorrect ---------------------------
## `coef_asym(as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))` threw an error with unexpected message.
## Expected match: "x doit etre un vecteur"
## Actual message: "'list' object cannot be coerced to type 'double'"
## Backtrace:
##  1. testthat::expect_error(...) tests_coef_asym.R:47:2
##  6. global::coef_asym(as.data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))
##  7. stats::sd(x)
##  8. stats::var(...)
##  9. base::is.data.frame(x)
## 
## -- Warning (tests_coef_asym.R:48:3): coef_asym reagit correctement a un argument x incorrect ---------------------
## argument is not numeric or logical: returning NA
## Backtrace:
##   1. testthat::expect_error(coef_asym(letters)) tests_coef_asym.R:48:2
##   6. global::coef_asym(letters)
##  10. base::mean.default(x)
## 
## -- Failure (tests_coef_asym.R:53:3): coef_asym reagit correctement a un argument na.rm incorrect ---------------------------
## `coef_asym(c(1, 1, 4, NA), na.rm = 4)` did not produce any warnings.
## 
## [ FAIL 2 | WARN 3 | SKIP 0 | PASS 10 ]

12.2

Modifiez coef_asym afin qu’elle émette l’erreur "x doit etre un vecteur" pour la commande

coef_asym(data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))

Tester votre modification pour vous assurer que ça fonctionne maintenant correctement.

Solution

# Code source édité dans le fichier coef_asym_version_4.R

coef_asym <- function(x, na.rm = FALSE){
  
  ## Validation des arguments ##
  if (is.array(x)) {
    warning("x est un array, mais il est traite comme un vecteur")
  }
  if (is.list(x)) {
    stop("x doit etre un vecteur")
  }
  
  ## Calculs ##
  if (na.rm) {
    x <- x[!is.na(x)]
  }
  m3 <- mean((x - mean(x))^3)
  s3 <- sd(x)^3
  n <- length(x)
  G1 <- (n^2) * m3 / ((n - 1) * (n - 2) * s3)
  
  ## Sortie ##
  return(G1)
}

source("coef_asym_version_4.R", encoding = 'UTF-8')

coef_asym(data.frame(matrix(rnorm(16), nrow = 4, ncol = 4)))
## Error in coef_asym(data.frame(matrix(rnorm(16), nrow = 4, ncol = 4))) : 
##   x doit etre un vecteur

# Faire rouler tous les tests de nouveau
test_file("tests_coef_asym.R")
## == Testing tests_coef_asym.R ==================================================================================================================
## [ FAIL 1 | WARN 1 | SKIP 0 | PASS 11 ]
## 
## -- Warning (tests_coef_asym.R:48:3): coef_asym reagit correctement a un argument x incorrect ---------------------
## argument is not numeric or logical: returning NA
## Backtrace:
##   1. testthat::expect_error(coef_asym(letters)) tests_coef_asym.R:48:2
##   6. global::coef_asym(letters)
##  10. base::mean.default(x)
## 
## -- Failure (tests_coef_asym.R:53:3): coef_asym reagit correctement a un argument na.rm incorrect ---------------------------
## `coef_asym(c(1, 1, 4, NA), na.rm = 4)` did not produce any warnings.
## 
## [ FAIL 1 | WARN 1 | SKIP 0 | PASS 11 ]

12.3

Modifiez coef_asym afin qu’elle émette un avertissement pour la commande

coef_asym(c(1, 1, 4, NA), na.rm = 4)

Tester votre modification pour vous assurer que ça fonctionne maintenant correctement.

Solution

# Code source édité dans le fichier coef_asym_version_5.R

coef_asym <- function(x, na.rm = FALSE){
  
  ## Validation des arguments ##
  if (is.array(x)) {
    warning("x est un array, mais il est traite comme un vecteur")
  }
  if (is.list(x)) {
    stop("x doit etre un vecteur")
  }
  if (is.numeric(na.rm)) {
    warning("na.rm est numerique, il a ete converti en logique")
  }
  
  ## Calculs ##
  if (na.rm) {
    x <- x[!is.na(x)]
  }
  m3 <- mean((x - mean(x))^3)
  s3 <- sd(x)^3
  n <- length(x)
  G1 <- (n^2) * m3 / ((n - 1) * (n - 2) * s3)
  
  ## Sortie ##
  return(G1)
}

source("coef_asym_version_5.R", encoding = 'UTF-8')

coef_asym(c(1, 1, 4, NA), na.rm = 4)
## [1] 1.732051
## Warning message:
## In coef_asym(c(1, 1, 4, NA), na.rm = 4) :
##   na.rm est numerique, il a ete converti en logique

# Faire rouler tous les tests de nouveau
test_file("tests_coef_asym.R")
## == Testing tests_coef_asym.R ==================================================================================================================
## [ FAIL 0 | WARN 1 | SKIP 0 | PASS 12 ]
## 
## -- Warning (tests_coef_asym.R:48:3): coef_asym reagit correctement a un argument x incorrect ---------------------
## argument is not numeric or logical: returning NA
## Backtrace:
##   1. testthat::expect_error(coef_asym(letters)) tests_coef_asym.R:48:2
##   6. global::coef_asym(letters)
##  10. base::mean.default(x)
## 
## [ FAIL 0 | WARN 1 | SKIP 0 | PASS 12 ]

Question 13 :

13.1

Tests - Formaliser des tests avec le package testthat

La fonction coef_asym passe maintenant tous les tests avec succès! Par contre, il y a un avertissement généré par un des tests. Est-ce que cet avertissement est problématique ?

Trouvez quel test génère cet avertissement.

Solution

# Le test suivant génère l'avertissement :
expect_error(coef_asym(letters))
## Warning message:
## In mean.default(x) : argument is not numeric or logical: returning NA

# C'est parce que la commande suivante génère à la fois une erreur et un avertissement.
coef_asym(letters)
## Error in h(simpleError(msg, call)) : 
##  error in evaluating the argument 'x' in selecting a method for function 'mean': non-numeric argument to binary operator
## In addition: Warning message:
## In mean.default(x) : argument is not numeric or logical: returning NA

# Nous pourrions choisir de contrôler la génération de l'erreur, 
# de façon à ce que la commande mean(x) ne soit pas soumise, 
# donc que l'avertissement ne soit pas généré.
mean(letters)
## [1] NA
## Warning message:
## In mean.default(letters) : argument is not numeric or logical: returning NA

# Nous pourrions aussi supprimer tout avertissement émis par la commande mean(x).

13.2

Gestion d’exceptions - Manipuler des erreurs et des avertissements

Dans le corps de la fonction coef_asym, empêchez l’instruction mean(x) d’émettre un avertissement.

Solution

# Code source édité dans le fichier coef_asym_version_finale.R

coef_asym <- function(x, na.rm = FALSE){
  
  ## Validation des arguments ##
  if (is.array(x)) {
    warning("x est un array, mais il est traite comme un vecteur")
  }
  if (is.list(x)) {
    stop("x doit etre un vecteur")
  }
  if (is.numeric(na.rm)) {
    warning("na.rm est numerique, il a ete converti en logique")
  }
  
  ## Calculs ##
  if (na.rm) {
    x <- x[!is.na(x)]
  }
  m3 <- mean((x - suppressWarnings(mean(x)))^3)  # modification ici
  s3 <- sd(x)^3
  n <- length(x)
  G1 <- (n^2) * m3 / ((n - 1) * (n - 2) * s3)
  
  ## Sortie ##
  return(G1)
}

source("coef_asym_version_finale.R", encoding = 'UTF-8')

coef_asym(letters)
## Error in h(simpleError(msg, call)) : 
##   error in evaluating the argument 'x' in selecting a method for function 'mean': non-numeric argument to binary operator

test_file("tests_coef_asym.R")
## == Testing tests_coef_asym.R ==================================================================================================================
## [ FAIL 0 | WARN 0 | SKIP 0 | PASS 12 ] Done!

Question 14 :

Gestion d’exceptions - Manipuler des erreurs et des avertissements

Voici une liste R :

elements <- list(1:10, c(-1, 10), c(TRUE, FALSE), letters)

Si nous tentons d’appliquer la fonction log aux éléments de cette liste avec la commande suivante

results <- lapply(elements, log)

une erreur est retournée et l’objet results n’est pas créé. L’erreur est due au fait qu’appliquer la fonction log sur le dernier élément de elements retourne une erreur. Comment modifier la commande précédente de façon à ce que results puisse être créé malgré l’erreur, et qu’il ait l’allure suivante :

results

## [[1]]
##  [1] 0.0000000 0.6931472 1.0986123 1.3862944 1.6094379 1.7917595 1.9459101 2.0794415 2.1972246 2.3025851
## 
## [[2]]
## [1]      NaN 2.302585
## 
## [[3]]
## [1]    0 -Inf
## 
## [[4]]
## [1] "Error in log(x) : non-numeric argument to mathematical function\n"
## attr(,"class")
## [1] "try-error"
## attr(,"condition")
## <simpleError in log(x): non-numeric argument to mathematical function>

Cet exemple est tiré de http://adv-r.had.co.nz/Exceptions-Debugging.html#condition-handling

Solution

elements <- list(1:10, c(-1, 10), c(TRUE, FALSE), letters)
results <- lapply(elements, log)
## Error in FUN(X[[i]], ...) : non-numeric argument to mathematical function
## In addition: Warning message:
## In FUN(X[[i]], ...) : NaNs produced

# Modification de l'appel à lapply
results <- lapply(elements, function(x) try(log(x)))
## Error in FUN(X[[i]], ...) : non-numeric argument to mathematical function
## In addition: Warning message:
## In log(x) : NaNs produced

# ou (différence : argument silent = TRUE => erreur non affichée)
results <- lapply(elements, function(x) try(log(x), silent = TRUE))
## Warning message:
## In log(x) : NaNs produced

results
## [[1]]
##  [1] 0.0000000 0.6931472 1.0986123 1.3862944 1.6094379 1.7917595 1.9459101 2.0794415 2.1972246 2.3025851
## 
## [[2]]
## [1]      NaN 2.302585
## 
## [[3]]
## [1]    0 -Inf
## 
## [[4]]
## [1] "Error in log(x) : non-numeric argument to mathematical function\n"
## attr(,"class")
## [1] "try-error"
## attr(,"condition")
## <simpleError in log(x): non-numeric argument to mathematical function>

Programmation orientée objet, tests et exceptions en R

Exercices réalisés en classe et leurs solutions

STT-4230/STT-6230 R pour scientifique

Université Laval

Aurélien Nicosia, Sophie Baillargeon et Audrey-Anne Vallée

Programmation orientée objet

Question 1 :

Création de méthodes et de classes S3

Solution

Question 2 :

Création de méthodes et de classes S3

Solution

Question 3 :

Utilisation de classes S4

Solution

Tests et exceptions

Programme à sourcer pour questions suivantes

Solution

Question 4 :

Tests - Objectif 1 : obtenir le résultat escompté

Comparaison à un calcul fait à la main

4.1

Solution

4.2

Solution

Question 5 :

Tests - Objectif 1 : obtenir le résultat escompté

Comparaison à un calcul fait par une fonction alternative

5.1

Solution

5.2

Solution

5.3

Solution

Question 6 :

Tests - Objectif 1 : obtenir le résultat escompté

Comparaison à un résultat théorique

Solution

Question 7 :

Tests - Objectif 2 : correctement gérer les exceptions

7.1

Solution

7.2

Solution

Question 8 :

Tests - Formaliser des tests avec le package testthat

Solution

Question 9 :

Débogage

Solution

Question 10 :

Débogage

Solution

Question 11 :

Débogage

Solution

Question 12 :

Gestion d’exceptions - Produire des erreurs et des avertissements

12.1

Solution

12.2

Solution

12.3

Solution

Question 13 :

13.1

Tests - Formaliser des tests avec le package testthat

Solution

13.2

Gestion d’exceptions - Manipuler des erreurs et des avertissements

Solution

Question 14 :

Gestion d’exceptions - Manipuler des erreurs et des avertissements

Solution