Modérateur : Groupe des modérateurs
Code : Tout sélectionner
f <- function(df, x, varname) {
df[, varname][!is.na(df$colA)) & !is.na(df$colB) & df$colA<=(x) & df$colB>=(x)] <- Ok
return (df)
}
data <- f(data, 10, "var1")
data <- f(data, 12, "var2")
Code : Tout sélectionner
l_seuil<-c(8,10,20,38) #la liste des seuils possibles
l_nom<-paste0("pres",1:4) #la liste des noms de colonne pour chaque seuil
don <- data.frame (debut=as.numeric(c(5, 6, 14, "", 34)), fin=as.numeric(c(12, 9, 30, 10,"")),
row.names=c("Nom1", "Nom2", "Nom3", "Nom4", "Nom5"))
FUN<-function(varname,x,dta){
dta[,varname]<-as.numeric(!is.na(don$debut) & !is.na(don$fin) & don$debut<=x & don$fin>=x)
return(dta)
}
Reduce(function(...) merge(..., all=T,sort=F),lapply(seq(l_seuil),function(x) FUN(l_nom[x],l_seuil[x],don)))
debut fin pres1 pres2 pres3 pres4
1 5 12 1 1 0 0
2 6 9 1 0 0 0
3 14 30 0 0 1 0
4 NA 10 0 0 0 0
5 34 NA 0 0 0 0
Code : Tout sélectionner
FUN(l_nom[1],l_seuil[1],don)
debut fin pres1
Nom1 5 12 1
Nom2 6 9 1
Nom3 14 30 0
Nom4 NA 10 0
Nom5 34 NA 0
lapply(1:4,function(x) FUN(l_nom[x],l_seuil[x],don))
[[1]]
debut fin pres1
Nom1 5 12 1
Nom2 6 9 1
Nom3 14 30 0
Nom4 NA 10 0
Nom5 34 NA 0
[[2]]
debut fin pres2
Nom1 5 12 1
Nom2 6 9 0
Nom3 14 30 0
Nom4 NA 10 0
Nom5 34 NA 0
[[3]]
debut fin pres3
Nom1 5 12 0
Nom2 6 9 0
Nom3 14 30 1
Nom4 NA 10 0
Nom5 34 NA 0
[[4]]
debut fin pres4
Nom1 5 12 0
Nom2 6 9 0
Nom3 14 30 0
Nom4 NA 10 0
Nom5 34 NA 0
#et enfin
Reduce(function(...) merge(..., all=T,sort=F),lapply(1:4,function(x) FUN(l_nom[x],l_seuil[x],don)))
Code : Tout sélectionner
don <- data.frame (debut=as.numeric(c(5, 6, 14, "", 34)), fin=as.numeric(c(12, 9, 30, 10,"")),row.names=c("Nom1", "Nom2", "Nom3", "Nom4", "Nom5"))
f <- function(df, x, varname) {
command <- paste0("df$",varname,"[!is.na(df$debut) & !is.na(df$fin) & df$debut<=",x," & df$fin>=",x,"] <- 1")
eval(parse(text=command))
df
}
f(don, 8, "pres1")
Code : Tout sélectionner
don <- data.frame (debut=as.numeric(c(5, 6, 14, "", 34)), fin=as.numeric(c(12, 9, 30, 10,"")),row.names=c("Nom1", "Nom2", "Nom3", "Nom4", "Nom5"))
f2 <- function(x, varname) {
command <- paste0("don$",varname,"[!is.na(don$debut) & !is.na(don$fin) & don$debut<=",x," & don$fin>=",x,"] <- 1")
eval(parse(text=command),envir=parent.frame())
}
f2(8,"pres1")
don
Code : Tout sélectionner
don <- data.frame (debut= as.numeric(c(5, 6, 14, "", 34)),
fin= as.numeric(c(12, 9, 30, 10,"")),
row.names=c("Nom1", "Nom2", "Nom3", "Nom4", "Nom5"))
seuil <- c(8, 10, 20, 28) # Vecteur des seuils possible
for(i in 1:length(seuil)) {
don[,paste0("pres", i)] <- ifelse(!is.na(don$debut) & !is.na(don$fin) & don$debut<=seuil[i] & don$fin>=seuil[i],
1, 0) # Si la condition est rempli =1, sinon =0
}
Code : Tout sélectionner
mat <- sapply(seuil, function(x) (!is.na(don$debut) & ! is.na(don$fin) & don$debut <= x & don$fin >= x))
rowSums(mat)
# pour être plus efficace si jamais don devenait important en taille :
auxi <- !is.na(don$debut) & ! is.na(don$fin)
mat <- sapply(seuil, function(x) (auxi & don$debut <= x & don$fin >= x))
rowSums(mat)
Bastien Gamboa a écrit :Code : Tout sélectionner
don[,paste0("pres", i)] <- ifelse(!is.na(don$debut) & !is.na(don$fin) & don$debut<=seuil[i] & don$fin>=seuil[i],
1, 0) # Si la condition est rempli =1, sinon =0
Code : Tout sélectionner
benchr::benchmark(
"Bastien" = {
don <- data.frame(
debut = as.numeric(c(5, 6, 14, "", 34)),
fin = as.numeric(c(12, 9, 30, 10, "")),
row.names = c("Nom1", "Nom2", "Nom3", "Nom4", "Nom5")
)
seuil <- c(8, 10, 20, 28) # Vecteur des seuils possible
for (i in 1:length(seuil)) {
don[, paste0("pres", i)] <- ifelse(!is.na(don$debut) & !is.na(don$fin) & don$debut <= seuil[i] & don$fin >= seuil[i],
1, 0
) # Si la condition est rempli =1, sinon =0
}
},
"Bastien_noif" = {
don <- data.frame(
debut = as.numeric(c(5, 6, 14, "", 34)),
fin = as.numeric(c(12, 9, 30, 10, "")),
row.names = c("Nom1", "Nom2", "Nom3", "Nom4", "Nom5")
)
seuil <- c(8, 10, 20, 28) # Vecteur des seuils possible
for (i in 1:length(seuil)) {
don[, paste0("pres", i)] <- !is.na(don$debut) & !is.na(don$fin) & don$debut <= seuil[i] & don$fin >= seuil[i]
}
},
"Mickael" = {
don <- data.frame(
debut = as.numeric(c(5, 6, 14, "", 34)),
fin = as.numeric(c(12, 9, 30, 10, "")),
row.names = c("Nom1", "Nom2", "Nom3", "Nom4", "Nom5")
)
seuil <- c(8, 10, 20, 28) # Vecteur des seuils possible
don[, paste0("seuil", seuil)] <- sapply(
X = seuil, .don = don,
FUN = function(iseuil, .don) {
!is.na(.don$debut) & !is.na(.don$fin) &
.don$debut <= iseuil & .don$fin >= iseuil
}
)
},
"Maxime" = {
don <- data.frame(
debut = as.numeric(c(5, 6, 14, "", 34)),
fin = as.numeric(c(12, 9, 30, 10, "")),
row.names = c("Nom1", "Nom2", "Nom3", "Nom4", "Nom5")
)
seuil <- c(8, 10, 20, 28) # Vecteur des seuils possible
auxi <- !is.na(don$debut) & ! is.na(don$fin)
don[, paste0("seuil", seuil)] <- sapply(
X = seuil, .don = don, .auxi = auxi,
FUN = function(iseuil, .don, .auxi) {
.auxi &
.don$debut <= iseuil & .don$fin >= iseuil
}
)
}
)
Code : Tout sélectionner
#> Benchmark summary:
#> Time units : microseconds
#> expr n.eval min lw.qu median mean up.qu max total relative
#> Bastien 100 7040 7210 7710 7820 8170 10600 782000 11.30
#> Bastien_noif 100 6400 6740 6920 7370 7740 12000 737000 10.20
#> Mickael 100 647 681 697 750 742 4720 75000 1.02
#> Maxime 100 627 653 681 716 703 2710 71600 1.00
Logez Maxime a écrit :Si tu veux réellement comparer les différentes méthodes alors il ne faut pas inclure dans ton code tout ce qui concerne la création des objets, sinon la différence que tu observes n'est pas représentative des différences.
Code : Tout sélectionner
Benchmark summary:
Time units : microseconds
expr n.eval min lw.qu median mean up.qu max total relative
Bastien 100 7390 7690 7890 8100 8030 11900 810000 20.1
Bastien_noif 100 7090 7320 7430 7790 7540 11900 779000 19.0
Mickael 100 396 420 433 482 451 4790 48200 1.1
Maxime 100 366 384 392 424 410 2870 42400 1.0
Retourner vers « Questions en cours »
Utilisateurs parcourant ce forum : Google [Bot] et 1 invité