Eviter les boucles et passer par apply

Postez ici vos questions, réponses, commentaires ou suggestions - Les sujets seront ultérieurement répartis dans les archives par les modérateurs

Modérateur : Groupe des modérateurs

Olivier Vinet
Messages : 6
Enregistré le : 26 Oct 2017, 14:45

Eviter les boucles et passer par apply

Messagepar Olivier Vinet » 08 Fév 2019, 10:54

Bonjour,

Nouvelle question du jour.
Autre problème récurrent pour moi sous R, à savoir essayer d'éviter l'utilisation des boucles et passer par l'une des fonctions apply.
Sauf que la gymnastique ne m'est tellement pas naturelle que je n'arrive pas à m'en sortir.

En l'occurrence, j'ai ce jeu de données ('quant.sm2'):

Code : Tout sélectionner

  Espece Q25site Q75site Q25haquart Q75haquart Q98haquart   Moysite
1 Barbar     3.0    11.5          2         12         69     7.869
2 Hypsav     7.5    27.0          2         11         96    18.434
3  Myosp     4.0    41.0          2         21        237    32.391


J'aimerais obtenir ça :
- Une nouvelle colonne nommée "Moy_site_haq" qui compare, pour chaque ligne, ma valeur de Moysite avec les 3 quantiles de haquart et renvoie une valeur discrète ("faible" si on est < à Q25haquart, "moyen" si on est entre Q25haquart et Q75haquart et "fort" si on est > à Q75haquart. Par exemple pour Hypsav on a 18.43, on est donc en "fort". Etc.
- Une autre colonne nommée "Q25_site_haq" qui fait la même chose mais avec Q25site (exemple pour Hypsav, on est à 7.5 et donc en "moyen")
- Une dernière colonne nommée "Q75_site_haq", pour Q75 site (toujours Hypsav, on est en "fort" avec 27)

Je peux le faire avec des if ou ifelse, mais ça ne semble pas propre.
Et je ne vois pas la logique des diverses fonctions apply pour cet exemple d'interrogation et de renvoi de valeurs discrètes.

Merci d'avance !

Mickael Canouil
Messages : 540
Enregistré le : 04 Avr 2011, 08:53
Contact :

Re: Eviter les boucles et passer par apply

Messagepar Mickael Canouil » 08 Fév 2019, 12:57

Bonjour,

la fonction apply (et ses dérivés) permet de fonctionner par ligne ou par colonne (conversion dans le même type, pour vous ce sera "caractère" si appliqué sur le data.frame entier) pour réaliser une opération et renvoie ensuite une matrice (type unique).
Ici votre jeu de donnée n'est pas dan un format très exploitable via les fonctions *apply, puisqu'il faut traiter plusieurs colonnes de façon indépendante et utiliser les autres de façon statique.

Un format plus facile à manipuler (si pas de ifelse) est le format 'long' (via reshape/metl du package reshape ou gather du package tidyr par exemple)

Code : Tout sélectionner

library(tidyverse)
dta <- read.table(text = "  Espece Q25site Q75site Q25haquart Q75haquart Q98haquart   Moysite
1 Barbar     3.0    11.5          2         12         69     7.869
2 Hypsav     7.5    27.0          2         11         96    18.434
3  Myosp     4.0    41.0          2         21        237    32.391", header = TRUE)

Code : Tout sélectionner

dta %>%
  tidyr::gather(key = "site", value = "value", dplyr::ends_with("site"))

Image
Maintenant, on peut manipuler une seule colonne en fonction des autres.
En restant dans le 'tidyverse':

Code : Tout sélectionner

dta %>%
  tidyr::gather(key = "site", value = "value", dplyr::ends_with("site")) %>%
  dplyr::group_by(Espece, site) %>%
  dplyr::mutate(
    haq_interval = findInterval(x = value, vec = c(Q25haquart, Q75haquart)),
    haq = c("faible", "moyen", "fort")[haq_interval+1]
  ) %>%
  dplyr::ungroup()

Image

Pour rester sur 'base', on aurait pu faire la même chose avec reshape::melt(), base::by(), base::apply() et l'opérateur '$' / '['.

Code : Tout sélectionner

dta <- reshape::melt(data = dta, measure.vars = grep("site", colnames(dta)),  variable_name = "site")
dta <- by(data = dta, INDICES = dta$site, FUN = function(.data) {
  find_haq <- apply(
    X = .data[, c("value", "Q25haquart", "Q75haquart")],
    MARGIN = 1,
    FUN = function(.row) {
      haq_interval <- findInterval(x = .row[1], vec = .row[c(2, 3)])
      haq <- c("faible", "moyen", "fort")[haq_interval+1]
      return(haq)
    }
  )
  .data[, "haq"] <- find_haq
  return(.data)
})
dta <- do.call("rbind", dta)


Cordialement,
Mickaël

Logez Maxime
Messages : 2873
Enregistré le : 26 Sep 2006, 11:35

Re: Eviter les boucles et passer par apply

Messagepar Logez Maxime » 08 Fév 2019, 13:02

Bonjour,

Pourquoi ça ne serait pas propre avec des ifelse ?
Ici tout peut se faire en vectorisant les calculs il n'y a pas besoin de faire des boucles ou des apply.

Code : Tout sélectionner

tab$Moy_site_haq <- "fort"
tab$Moy_site_haq[tab$Moysite < tab$Q75haquart] <- "moyen"
tab$Moy_site_haq[tab$Moysite < tab$Q25haquart] <- "faible"
Cordialement,
Maxime

Olivier Vinet
Messages : 6
Enregistré le : 26 Oct 2017, 14:45

Re: Eviter les boucles et passer par apply

Messagepar Olivier Vinet » 08 Fév 2019, 13:16

Merci pour vos 2 réponses.
La première est intéressante, mais j'avoue que celle de Maxime règle le problème de façon assez radicale :)
Au top !

Mickael Canouil
Messages : 540
Enregistré le : 04 Avr 2011, 08:53
Contact :

Re: Eviter les boucles et passer par apply

Messagepar Mickael Canouil » 08 Fév 2019, 13:17

Logez Maxime a écrit :Bonjour,

Pourquoi ça ne serait pas propre avec des ifelse ?
Ici tout peut se faire en vectorisant les calculs il n'y a pas besoin de faire des boucles ou des apply.

Code : Tout sélectionner

tab$Moy_site_haq <- "fort"
tab$Moy_site_haq[tab$Moysite < tab$Q75haquart] <- "moyen"
tab$Moy_site_haq[tab$Moysite < tab$Q25haquart] <- "faible"
Cordialement,
Maxime


Il faut nécessairement une "boucle" pour traiter les trois colonnes:

Code : Tout sélectionner

dta <- read.table(text = "  Espece Q25site Q75site Q25haquart Q75haquart Q98haquart   Moysite
1 Barbar     3.0    11.5          2         12         69     7.869
2 Hypsav     7.5    27.0          2         11         96    18.434
3  Myosp     4.0    41.0          2         21        237    32.391", header = TRUE)

select_columns <- c("Moysite", "Q25site", "Q75site")
dta[, select_columns] <- NA
for (icol in select_columns) {
  inew <- paste0(icol, "_haq")
  dta[[inew]] <- "fort"
  dta[[inew]][dta[[icol]] < dta[["Q75haquart"]]] <- "moyen"
  dta[[inew]][dta[[icol]] < dta[["Q25haquart"]]] <- "faible"
}
Mickaël

Mickael Canouil
Messages : 540
Enregistré le : 04 Avr 2011, 08:53
Contact :

Re: Eviter les boucles et passer par apply

Messagepar Mickael Canouil » 08 Fév 2019, 13:19

Pour la route un petit benchmark des trois propositions:

Code : Tout sélectionner

Benchmark summary:
Time units : milliseconds
      expr n.eval   min lw.qu median mean up.qu  max total relative
 tidyverse    100 17.10  23.3   23.7 24.4  24.0 62.9  2440     2.24
      base    100  8.19  10.4   10.6 10.7  10.7 31.5  1070     1.00
      loop    100 15.60  19.3   19.4 20.1  19.7 41.4  2010     1.83
Mickaël

Logez Maxime
Messages : 2873
Enregistré le : 26 Sep 2006, 11:35

Re: Eviter les boucles et passer par apply

Messagepar Logez Maxime » 08 Fév 2019, 14:05

re,

je suis surpris par le temps de calcul je suis arrivé à ça, avec une boucle (encapsulée), les différentes fonctions de *apply et ta solution tidyverse :

Code : Tout sélectionner

fun <- function (x)
{
    bob <- rep("fort", length(x))
    bob[x < tab$Q75haquart] <- "moyen"
    bob[x < tab$Q25haquart] <- "faible"
    bob
}

ted <- function() {
  res <- vector("list", 3L)
  u <- 1
  for (i in tab[c("Moysite", "Q25site", "Q25site")]) {
  res[[u]] <- fun(i)
    u <- u+1
  }
  res <- do.call(cbind, res)
  colnames(res) <- paste0(c("Moysite", "Q25site", "Q75site"), "_haq")
  res
}

microbenchmark(
  Lapply = {
    res <- lapply(tab[c("Moysite", "Q25site", "Q75site")], fun)
    res <- do.call(cbind, res)
    colnames(res) <- paste0(c("Moysite", "Q25site", "Q75site"), "_haq")
    cbind(tab, res)
    },
  Sapply  = {
    res <- sapply(tab[c("Moysite", "Q25site", "Q75site")], fun)
    colnames(res) <- paste0(c("Moysite", "Q25site", "Q75site"), "_haq")
    cbind(tab, res)
    },
  Vapply = {
    res <- vapply(tab[c("Moysite", "Q25site", "Q75site")], fun, character(nrow(tab)))
    colnames(res) <- paste0(c("Moysite", "Q25site", "Q75site"), "_haq")
    cbind(tab, res)
    },
  Loop = {
    res <- ted()
    cbind(tab, res)
    },
  Tidyverse = {
    tab %>%
      tidyr::gather(key = "site", value = "value", dplyr::ends_with("site")) %>%
      dplyr::group_by(Espece, site) %>%
      dplyr::mutate(
        haq_interval = findInterval(x = value, vec = c(Q25haquart, Q75haquart)),
        haq = c("faible", "moyen", "fort")[haq_interval+1]) %>%
     dplyr::ungroup()
  },
  Base = {
    res <- unlist(tab[c("Moysite", "Q25site", "Q75site")])
    res <- fun(res)
    dim(res) <- c(nrow(tab), 3)
    cbind(tab, res)   
    }
)
Unit: microseconds
      expr      min        lq      mean    median        uq      max neval cld
    Lapply  249.948  263.9170  309.4135  279.0195  323.7610 1095.689   100  a
    Sapply  267.315  281.8515  318.8866  295.6325  335.4655  824.221   100  a
    Vapply  250.702  266.1820  341.6461  302.4290  329.0465 2101.517   100  a
      Loop  249.192  262.9735  289.9614  273.7340  318.0975  379.829   100  a
 Tidyverse 3279.513 3496.9895 3695.0972 3597.7990 3724.4715 5496.186   100   b
      Base  223.895  236.7325  282.8670  249.5700  295.8215 2002.596   100  a
Moralité ici la bonne vieille boucle ou les lapply, sapply et vapply qui permettent de travailler directement sur les colonnes de ton tableau sont plus efficaces que le monde de tidyverse. Tout ça étant à nuancer parce que d'une part le résultat obtenu n'est pas encore intégrer au résultat final dans un même objet et surtout que le nombre de lignes est très faible. Il faudrait répéter l'affaire sur un nombre bcp plus conséquent.

Cordialement,
Maxime

Mickael Canouil
Messages : 540
Enregistré le : 04 Avr 2011, 08:53
Contact :

Re: Eviter les boucles et passer par apply

Messagepar Mickael Canouil » 08 Fév 2019, 14:10

Le tidyverse n'est pas plus performant que base, simplement plus lisible, cohérent (arguments surtout) et intuitif.
Pour la performance, c'est le package purrr (présent dans le tidyverse), en effet les fonctions map* sont en théorie plus performantes que les *apply.

Au passage le fait d'encapsuler le 'for' doit jouer dans la performance, puisque depuis la version 3 (il me semble) les fonctions sont toutes "byte-compiled" par défaut.

Pour information, le benchmark est réalisé sur l'ensemble du code création du data.frame et manipulation.
Mickaël

Logez Maxime
Messages : 2873
Enregistré le : 26 Sep 2006, 11:35

Re: Eviter les boucles et passer par apply

Messagepar Logez Maxime » 08 Fév 2019, 14:25

Mise à jour avec purr :

Code : Tout sélectionner

microbenchmark(
  Lapply = {
    res <- lapply(tab[c("Moysite", "Q25site", "Q75site")], fun)
    res <- do.call(cbind, res)
    colnames(res) <- paste0(c("Moysite", "Q25site", "Q75site"), "_haq")
    cbind(tab, res)
  },
  Sapply  = {
    res <- sapply(tab[c("Moysite", "Q25site", "Q75site")], fun)
    colnames(res) <- paste0(c("Moysite", "Q25site", "Q75site"), "_haq")
    cbind(tab, res)
  },
  Vapply = {
    res <- vapply(tab[c("Moysite", "Q25site", "Q75site")], fun, character(nrow(tab)))
    colnames(res) <- paste0(c("Moysite", "Q25site", "Q75site"), "_haq")
    cbind(tab, res)
  },
  Loop = {
    res <- ted()
    cbind(tab, res)
  },
  Tidyverse = {
    tab %>%
      tidyr::gather(key = "site", value = "value", dplyr::ends_with("site")) %>%
      dplyr::group_by(Espece, site) %>%
      dplyr::mutate(
        haq_interval = findInterval(x = value, vec = c(Q25haquart, Q75haquart)),
        haq = c("faible", "moyen", "fort")[haq_interval+1]) %>%
      dplyr::ungroup()
  },
  Base = {
    res <- unlist(tab[c("Moysite", "Q25site", "Q75site")])
    res <- fun(res)
    dim(res) <- c(nrow(tab), 3)
    cbind(tab, res)   
  },
  Map = {
    res <- map(tab[c("Moysite", "Q25site", "Q75site")], fun)
    res <- do.call(cbind, res)
    colnames(res) <- paste0(c("Moysite", "Q25site", "Q75site"), "_haq")
    cbind(tab, res)
  },
  Map_dfc = {
    res <- map_dfc(tab[c("Moysite", "Q25site", "Q75site")], fun)
    colnames(res) <- paste0(c("Moysite", "Q25site", "Q75site"), "_haq")
    cbind(tab, res)
  },
  Walk = {
    res <- walk(tab[c("Moysite", "Q25site", "Q75site")], fun)
    colnames(res) <- paste0(c("Moysite", "Q25site", "Q75site"), "_haq")
    cbind(tab, res)
  }
)
Unit: microseconds
      expr      min        lq      mean    median        uq      max neval  cld
    Lapply  249.947  267.6930  327.6158  290.5350  332.2555 2184.958   100  bc
    Sapply  266.560  286.5710  319.5700  301.4850  338.6750  950.327   100  bc
    Vapply  249.948  269.0145  288.8024  279.3970  307.9035  382.472   100 ab 
      Loop  247.304  268.8255  294.9529  277.1315  305.4490  715.482   100 ab 
 Tidyverse 3367.486 3522.8530 3791.5873 3619.6975 3783.7490 6477.473   100    d
      Base  226.161  242.5845  268.3497  253.5345  297.1430  381.717   100 ab 
       Map  289.592  310.7350  340.0868  326.0265  371.1450  447.413   100  bc
   Map_dfc  340.185  376.2425  409.8377  392.6660  432.8765  840.078   100   c
      Walk  163.863  177.0775  222.6910  184.8180  216.7215 2399.792   100 a
Walk est vraiment plus efficace (toujours sous réserve de ce tableau très court).

Si on augmente la taille (nbre de lignes * 1000) :

Code : Tout sélectionner

Unit: microseconds
      expr      min        lq      mean    median        uq      max neval   cld
    Lapply  715.860  767.0205  885.2123  794.7705  831.7715 3221.747   100  bc 
    Sapply  769.097  822.8995  997.2542  852.1605  892.5595 3453.193   100   c 
    Vapply  723.412  771.1730  872.7074  808.5520  853.2930 3135.662   100  bc 
      Loop  716.616  771.7395  858.8093  808.1745  850.4610 3115.274   100  bc 
 Tidyverse 4174.338 4439.7650 4718.7576 4569.2690 4721.9935 7540.313   100     e
      Base 3533.613 3692.9450 3944.1642 3824.9035 3983.6685 6026.285   100    d
       Map  755.126  817.9915  888.2782  839.8895  875.0035 3536.634   100  bc 
   Map_dfc  575.785  636.0055  706.7458  672.0630  713.9725 2781.130   100 ab   
      Walk  395.687  430.9890  535.4567  457.2295  490.4550 7084.594   100 a


Cordialement,
Maxime


Retourner vers « Questions en cours »

Qui est en ligne

Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 1 invité