Modérateur : Groupe des modérateurs
Code : Tout sélectionner
library(data.table)
dta <- fread("date_fichier delai Cond1 NUM CODE
18/02/19 na FL 1 ABC-xxxxxxxx
09/04/19 48 FL 2 ABC-xxxxxxxx
05/06/19 56 FL 3 ABC-xxxxxxxx
27/07/19 30 FL 3 ABC-xxxxxxxx
13/09/19 49 FL 4 ABC-xxxxxxxx
19/11/19 64 FL 5 ABC-xxxxxxxx
06/05/19 na FL 1 ABC-yyyyyyyy
02/09/19 106 non 2 ABC-yyyyyyyy
10/12/19 107 non 2 ABC-yyyyyyyy
06/05/19 na FL 1 ABC-zzzzzzzzzz
02/09/19 109 non 2 ABC-zzzzzzzzzz
10/12/19 107 non 2 ABC-zzzzzzzzzz")
Code : Tout sélectionner
dta[, logical_cond := Cond1 == "non" | delai < 35, by = CODE]
dta[order(CODE, date_fichier), NUM_update := ifelse(shift(logical_cond, fill = FALSE), shift(NUM), NUM + 1), by = CODE]
dta
#> date_fichier delai Cond1 NUM CODE logical_cond NUM_update
#> 1: 18/02/19 na FL 1 ABC-xxxxxxxx FALSE 2
#> 2: 09/04/19 48 FL 2 ABC-xxxxxxxx FALSE 3
#> 3: 05/06/19 56 FL 3 ABC-xxxxxxxx FALSE 4
#> 4: 27/07/19 30 FL 3 ABC-xxxxxxxx TRUE 4
#> 5: 13/09/19 49 FL 4 ABC-xxxxxxxx FALSE 5
#> 6: 19/11/19 64 FL 5 ABC-xxxxxxxx FALSE 6
#> 7: 06/05/19 na FL 1 ABC-yyyyyyyy FALSE 2
#> 8: 02/09/19 106 non 2 ABC-yyyyyyyy TRUE 3
#> 9: 10/12/19 107 non 2 ABC-yyyyyyyy TRUE 3
#> 10: 06/05/19 na FL 1 ABC-zzzzzzzzzz FALSE 2
#> 11: 02/09/19 109 non 2 ABC-zzzzzzzzzz TRUE 3
#> 12: 10/12/19 107 non 2 ABC-zzzzzzzzzz TRUE 3
Code : Tout sélectionner
# trop long
extr_all_res$NUM[1]=1 # initialise premiere ligne
for(i in 2:nrow(extr_all_res)){
############## cas particulier CODE NA
if(is.na(extr_all_res$CODE[i])){
next
}else if(is.na(extr_all_res$CODE[i-1])){
extr_all_res$NUM[i]=1
next
}
###############
if(extr_all_res$CODE[i]!=extr_all_res$CODE[i-1]){
extr_all_res$NUM[i]=1 # si nouveau code alors on part de 1
}else if(extr_all_res$cond1[i-1]=="non" | extr_all_res$delai[i]<35){
extr_all_res$NUM[i]=extr_all_res$NUM[i-1]
}else{
extr_all_res$NUM[i]=extr_all_res$NUM[i-1]+1
}
}
Code : Tout sélectionner
# mon tableau s'appelle test
nas <- is.na(test$CODE)
gr <- cumsum(!c(FALSE, (test$CODE[-1]==test$CODE[-nrow(test)] & !nas[-1] & !nas[-nrow(test)])))
cond1 <- test$Cond1[-nrow(test)] == "non" | test$delai[-1] <35
cond2 <- c(FALSE, !cond1)
res <- ave(cond2*1, gr, FUN = function(x) {
x[1] <- 0
1+cumsum(x)})
# ou
res <- unlist(tapply(cond2*1, gr, function(x) {
x[1] <- 0
1+cumsum(x)}))
# a tester le plus rapide des deux (ça dépendra de la taille du tableau)
res[nas] <- NA
Code : Tout sélectionner
test <- fread("date_fichier delai cond1 CODE
18/02/19 NA FL ABC-xxxxxxxx
09/04/19 48 FL ABC-xxxxxxxx
05/06/19 56 FL ABC-xxxxxxxx
27/07/19 30 FL ABC-xxxxxxxx
13/09/19 49 FL ABC-xxxxxxxx
19/11/19 64 FL ABC-xxxxxxxx
06/05/19 NA FL ABC-yyyyyyyy
02/09/19 106 non ABC-yyyyyyyy
10/12/19 107 non ABC-yyyyyyyy
06/05/19 NA FL ABC-zzzzzzzzzz
02/09/19 109 non ABC-zzzzzzzzzz
10/12/19 107 non ABC-zzzzzzzzzz")
Code : Tout sélectionner
test$NUM[1]=1 # initialise première ligne
for(i in 2:nrow(test)){
############## cas particulier CODE NA
if(is.na(test$CODE[i])){
next
}else if(is.na(test$CODE[i-1])){
test$NUM[i]=1
next
}
###############
if(test$CODE[i]!=test$CODE[i-1]){
test$NUM[i]=1 # si nouveau code alors on part de 1
}else if(test$cond1[i-1]=="non" | test$delai[i]<35){
test$NUM[i]=test$NUM[i-1]
}else{
test$NUM[i]=test$NUM[i-1]+1
}
}
Code : Tout sélectionner
test <- fread("date_fichier delai cond1 CODE
18/02/19 NA FL ABC-xxxxxxxx
09/04/19 48 FL ABC-xxxxxxxx
05/06/19 56 FL ABC-xxxxxxxx
27/07/19 30 FL ABC-xxxxxxxx
13/09/19 49 FL ABC-xxxxxxxx
19/11/19 64 FL ABC-xxxxxxxx
06/05/19 NA FL ABC-yyyyyyyy
02/09/19 106 non ABC-yyyyyyyy
10/12/19 107 non ABC-yyyyyyyy
06/05/19 NA FL ABC-zzzzzzzzzz
02/09/19 109 non ABC-zzzzzzzzzz
10/12/19 107 non ABC-zzzzzzzzzz")
# mon tableau s'appelle test
nas <- is.na(test$CODE)
gr <- cumsum(!c(FALSE, (test$CODE[-1]==test$CODE[-nrow(test)] & !nas[-1] & !nas[-nrow(test)])))
gr
cond1 <- test$cond1[-nrow(test)] == "non" | is.na(test$delai[-1]) | test$delai[-1]<35
cond1
cond2 <- c(FALSE, !cond1)
cond2
res <- ave(cond2*1, gr, FUN = function(x) {
x[1] <- 0
1+cumsum(x)})
res
Code : Tout sélectionner
gr <- cumsum(!c(FALSE, (test$CODE[-1]==test$CODE[-nrow(test)] & !nas[-1] & !nas[-nrow(test)])))
gr
[1] 1 1 1 1 1 1 2 2 2 3 3 3
Code : Tout sélectionner
x<- rbinom(10, 1, 0.7)
x
0 1 1 0 1 0 0 1 1 0
# est-ce que x-1 est égale à x ?
y <- x[-length(x)]==x[-1]
# est-ce que x-1 est différent de x ?
y <- !y
# si oui alors on aura TRUE et TRUE en numérique ça vaut 1
# si on fait la somme cummulée, à chaque différence on rajoute 1
# si c'est équivelent alors on rajoute 0
# ca permet de repérer les séries
cumsum(c(FALSE, y))
[1] 0 1 1 2 3 4 4 5 5 6
# pour comparaison
rbind(x, cumsum(c(FALSE, y)))
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
x 0 1 1 0 1 0 0 1 1 0
0 1 1 2 3 4 4 5 5 6
Code : Tout sélectionner
cond1 <- test$cond1[-nrow(test)] == "non" | is.na(test$delai[-1]) | test$delai[-1]<35
Retourner vers « Questions en cours »
Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 1 invité