Comment renvoyer la dernière valeur d'un vecteur ayant satisfait une certaine condition

Question

J'ai un vecteur (dans un data frame) rempli de nombres croissants. J'aimerais trouver tous les nombres consécutifs et les remplacer par le premier nombre de la série. Est-il possible de le faire sans boucle ?

Mes données d'entrée sont :

V1
1
4
5
7
10
15
16
17
20

Le résultat que j'aimerais obtenir est :

V1    Out
1     1
4     4
5     4
7     7
10    10
15    15
16    15
17    15
20    20

Jusqu'à présent, j'ai réussi à calculer la différence entre deux lignes en utilisant diff() et à parcourir le vecteur pour remplacer les bonnes valeurs.

V1 <- c(1, 4, 5, 7, 10, 15, 16, 17, 20)
df <- data.frame(V1)
df$diff <- c(0, diff(df$V1) == 1)
df$Out <- NA
for (j in 1:(nrow(df))){
    if (df$diff[j] == 0){
        df$Out[j] <- df$V1[j]
    } else {
        df$Out[j] <- df$V1[max(which(df$diff[1:j] == 0))]
    }
}

Cela fonctionne, mais c'est très inefficace. Y a-t-il un moyen de se débarrasser de la boucle et d'accélérer ce code ?

Merci beaucoup !

Answer 1

En utilisant base R vous pouvez faire,

with(d1, ave(V1, cumsum(c(1, diff(V1) != 1)), FUN = function(i) i[1]))
#[1]  1  4  4  7 10 15 15 15 20

dplyr

library(dplyr)

d1 %>% 
 group_by(grp = cumsum(c(1, diff(V1) != 1))) %>% 
 mutate(out = first(V1))

data.table

library(data.table)

setDT(d1)[, out := first(V1), by = cumsum(c(1, diff(V1) != 1))]

Answer 2

Une autre option, en 3 étapes, en utilisant le package zoo:

Définissez V2 comme V1:

df$V2 <- df$V1

Remplacez la valeur consécutive (où diff est 1) par NA:

df$V2[c(FALSE, diff(df$V1)==1)] <- NA

Enfin, utilisez zoo::na.locf pour remplacer les NA par la dernière valeur:

library(zoo)
df$V2 <- na.locf(df$V2)

Sortie:

df
#   V1 V2
# 1  1  1
# 2  4  4
# 3  5  4
# 4  7  7
# 5 10 10
# 6 15 15
# 7 16 15
# 8 17 15
# 9 20 20

Une autre écriture, en une seule ligne, en utilisant magrittr:

library(magrittr)
df$V2 <- df$V1 %>% replace(c(FALSE, diff(df$V1)==1), NA) %>% na.locf

Answer 3

Utilisation de shift() o lag() au lieu de diff()

Toutes les solutions présentées jusqu'à présent utilisent diff(V1) afin de déterminer les nombres consécutifs. D'autre part, data.table et dplyr comprennent le shift() et lag() resp. des fonctions qui peuvent également être utilisées (comme le suggère également @Frank).

Donc, au lieu de Sotos data.table approche

library(data.table)
setDT(d1)[, out := first(V1), by = cumsum(c(1, diff(V1) != 1))]

nous pouvons écrire

setDT(d1)[, out := V1[1], by = cumsum(V1 - shift(V1, fill = V1[1]) != 1)]

En dplyr La solution devient

library(dplyr)
d1 %>% 
  group_by(grp = cumsum(V1 - lag(V1, default = V1[1]) != 1)) %>% 
  mutate(out = first(V1)) 

De même, la solution de base R devient

library(data.table)
with(d1, ave(V1, cumsum(V1 - shift(V1, fill = V1[1]) != 1), FUN = function(i) i[1]))

et L'approche de Cath's zoo::na.locf()

library(zoo)
library(magrittr)
library(data.table)
df$V2 <- df$V1 %>% replace(DF$V1 == shift(DF$V1, fill = DF$V1[1]) + 1, NA) %>% na.locf()

Point de repère

Avec toutes ces approches disponibles, je me demande laquelle est la plus rapide. De plus, j'ai remarqué que toutes les solutions utilisent la constante 1 qui est de type double au lieu de la entier constant 1L bien que la question porte sur des nombres consécutifs, ce qui implique le type entier . De même, NA est utilisé à la place de NA_integer_ .

La conversion de type peut ajouter une pénalité de performance, ce qui est la raison pour laquelle certains paquets, par exemple, data.table émettre des avertissements ou des erreurs. J'ai donc trouvé intéressant d'étudier l'impact de la conversion de type sur les résultats du benchmark.

Données de référence

Un data.frame est créé avec 1 M lignes par échantillonnage à partir de 2 M nombres. Pour être cohérent, le résultat est toujours stocké dans la colonne Out du data.frame. Pour le data.table une copie de la version DF est utilisé.

library(data.table)
n <- 1e6L
f <- 2L
set.seed(1234L)
DF <- data.frame(V1 = sort(sample.int(f*n, n)),
                 Out = 1:n)
DT <- data.table(DF)
DT

Code de référence

12 approches différentes sont testées, chacune avec double et entier constantes, ce qui donne 24 variantes au total.

library(magrittr)
library(microbenchmark)
bm <- microbenchmark(
  ave_diff = DF$Out <- with(DF, ave(V1, cumsum(c(1, diff(V1) != 1)), FUN = function(i) i[1])),
  ave_shift = DF$Out <- with(DF, ave(V1, cumsum(V1 - shift(V1, fill = V1[1]) != 1), FUN = function(i) i[1])),
  zoo_diff = {DF$Out <- DF$V1; DF$Out[c(FALSE, diff(DF$V1) == 1)] <- NA; DF$Out <- zoo::na.locf(DF$Out)},
  zoo_pipe = DF$Out <- DF$V1 %>% replace(c(FALSE, diff(DF$V1) == 1), NA) %>% zoo::na.locf(),
  zoo_shift = DF$Out <- DF$V1 %>% replace(DF$V1 == shift(DF$V1, fill = DF$V1[1]) + 1, NA) %>% zoo::na.locf(),
  dp_diff = r2 <- DF %>% 
    dplyr::group_by(grp = cumsum(c(1, diff(V1) != 1))) %>% 
    dplyr::mutate(Out = first(V1)),
  dp_lag = r3 <- DF %>% 
    dplyr::group_by(grp = cumsum(V1 - dplyr::lag(V1, default = V1[1]) != 1)) %>% 
    dplyr::mutate(Out = first(V1)),
  dt_diff = DT[, Out := V1[1], by = cumsum(c(1, diff(V1) != 1))],
  dt_shift1 = DT[, Out := V1[1], by = cumsum(V1 - shift(V1, fill = V1[1]) != 1)],
  dt_shift2 = DT[, Out := V1[1], by = cumsum(V1 != shift(V1, fill = V1[1]) + 1)],
  dt_zoo_diff = DT[, Out := V1][c(FALSE, diff(DF$V1) == 1), Out := NA][, Out := zoo::na.locf(Out)],
  dt_zoo_shift = DT[, Out := V1][V1 == shift(V1, fill = V1[1]) + 1, Out := NA][, Out := zoo::na.locf(Out)],
  ave_diff_L = DF$Out <- with(DF, ave(V1, cumsum(c(1L, diff(V1) != 1L)), FUN = function(i) i[1L])),
  ave_shift_L = DF$Out <- with(DF, ave(V1, cumsum(V1 - shift(V1, fill = V1[1L]) != 1L), FUN = function(i) i[1L])),
  zoo_diff_L = {DF$Out <- DF$V1; DF$Out[c(FALSE, diff(DF$V1) == 1L)] <- NA_integer_; DF$Out <- zoo::na.locf(DF$Out)},
  zoo_pipe_L = DF$Out <- DF$V1 %>% replace(c(FALSE, diff(DF$V1) == 1L), NA_integer_) %>% zoo::na.locf(),
  zoo_shift_L = DF$Out <- DF$V1 %>% replace(DF$V1 == shift(DF$V1, fill = DF$V1[1L]) + 1L, NA_integer_) %>% zoo::na.locf(),
  dp_diff_L = r2 <- DF %>% 
    dplyr::group_by(grp = cumsum(c(1L, diff(V1) != 1L))) %>% 
    dplyr::mutate(Out = first(V1)),
  dp_lag_L = r3 <- DF %>% 
    dplyr::group_by(grp = cumsum(V1 - dplyr::lag(V1, default = V1[1L]) != 1L)) %>% 
    dplyr::mutate(Out = first(V1)),
  dt_diff_L = DT[, Out := V1[1L], by = cumsum(c(1L, diff(V1) != 1L))],
  dt_shift1_L = DT[, Out := V1[1L], by = cumsum(V1 - shift(V1, fill = V1[1L]) != 1L)],
  dt_shift2_L = DT[, Out := V1[1L], by = cumsum(V1 != shift(V1, fill = V1[1L]) + 1L)],
  dt_zoo_diff_L = DT[, Out := V1][c(FALSE, diff(DF$V1) == 1L), Out := NA_integer_][, Out := zoo::na.locf(Out)],
  dt_zoo_shift_L = DT[, Out := V1][V1 == shift(V1, fill = V1[1L]) + 1L, Out := NA_integer_][, Out := zoo::na.locf(Out)],
  times = 20L
)

Résultats de l'évaluation comparative

library(ggplot2)
autoplot(bm)

Notez l'échelle logarithmique de l'axe du temps.

Unit: milliseconds
           expr        min         lq      mean    median        uq       max neval   cld
       ave_diff 2594.89941 2643.32224 2752.9753 2723.7035 2868.6586 3006.0420    20     e
      ave_shift  947.13267 1001.70742 1107.7351 1047.6835 1218.5809 1395.5059    20   c  
       zoo_diff  100.13967  130.23284  197.7273  142.8525  262.1980  428.2976    20 a    
       zoo_pipe  104.98025  112.04101  181.3073  119.5275  185.3215  434.2936    20 a    
      zoo_shift   88.86549   98.49058  177.2143  110.5392  260.1160  416.9985    20 a    
        dp_diff 1148.18227 1219.68396 1303.6350 1290.5575 1344.1400 1628.1786    20    d 
         dp_lag  712.58827  746.77952  804.8908  776.3303  809.8323 1157.2102    20  b   
        dt_diff  226.67524  233.81038  292.0675  241.9369  275.8491  517.1760    20 a    
      dt_shift1  199.64651  207.39276  255.1607  215.7960  223.7947  882.9923    20 a    
      dt_shift2  203.87617  210.06736  260.8550  218.9917  244.7247  499.8797    20 a    
    dt_zoo_diff  109.45194  121.41501  216.3579  159.0960  278.5257  483.1110    20 a    
   dt_zoo_shift   94.59905  109.32432  204.0329  127.0619  373.8622  430.0885    20 a    
     ave_diff_L  992.12820 1041.12873 1127.8128 1071.8525 1217.1493 1457.3166    20   c  
    ave_shift_L  905.41152  973.81932 1063.2237 1015.6805 1170.2522 1323.9317    20   c  
     zoo_diff_L  103.30228  114.63442  227.4359  140.5280  300.3003  822.3366    20 a    
     zoo_pipe_L  103.89433  112.16467  231.3165  133.3362  398.7240  545.7856    20 a    
    zoo_shift_L   91.88764  104.21339  157.6434  138.7488  165.0197  401.3890    20 a    
      dp_diff_L  749.65952  766.00479  851.0737  806.1116  886.6429 1155.3144    20  b   
       dp_lag_L  731.08180  757.95232  823.0169  794.4421  827.7100 1079.2576    20  b   
      dt_diff_L  214.97477  226.80928  241.3575  232.7037  244.8673  323.6259    20 a    
    dt_shift1_L  199.80509  211.20539  277.5616  218.3371  259.9801  513.2925    20 a    
    dt_shift2_L  200.37902  204.23732  224.7275  210.7217  216.6133  470.6335    20 a    
  dt_zoo_diff_L  111.64757  122.62327  162.4947  140.4175  174.0932  409.0788    20 a    
 dt_zoo_shift_L   95.91114  109.24219  164.7059  126.5924  170.2320  388.6558    20 a

Observations

Pour la taille et la structure données du problème :

• En zoo::na.locf() est plus rapide que les diverses implémentations utilisant le regroupement avec un léger avantage de la combinaison de na.locf() con shift() .
• En deuxième position mais proche, on trouve data.table avec regroupement.
• Le troisième, mais trois fois plus lent, est dplyr .
• Le dernier est ave() ce qui est plus de 20 fois plus lent que le plus rapide et prend jusqu'à 3 secondes par exécution.
• En shift() / lag() sont toujours plus rapides que les versions diff() .
• Conversion de type importe . Les versions utilisant diff() sont particulièrement touchées, par exemple, Différence moyenne avec des constantes entières est environ 2,5 fois plus rapide que la version avec des constantes doubles.

Answer 4

Avec dplyr et tidyr :

library(tidyr)
library(dplyr)

> df %>% mutate(
+   diff=c(0,diff(V1))==1,
+   V2=ifelse(diff,NA,V1)
+   ) %>% 
+   fill(V2) %>% 
+   select(-diff)
  V1 V2
1  1  1
2  4  4
3  5  4
4  7  7
5 10 10
6 15 15
7 16 15
8 17 15
9 20 20