Sélection variable data frame boucle selon plusieurs conditions

[Bastien Gratia]

Bonjour,

Je dispose de plusieurs data frames comprenant 20709 lignes et 25 colonnes. La première colonne correspond à la date et les 24 autres sont des données horaires de température. De ces data frames j'ai remplacé les valeurs supérieures à 2°C et inférieures à - 2 °C par des NA. Mon problème est que je veux sélectionner des évènements qui commencent par une température négative et qui se finissent par une température positive comme dans l'exemple ci-dessous. (Les évènements sont considérés indépendants s'ils sont séparés d'au moins 3 heures, donc 3 NA)

09/03 : NA NA -1.8 -1.5 -1.2 -0.0 0.5 NA NA NA 1.8 0.8 0.4 -0.7

Je veux garder dans un autre df que :

09/03 : NA NA -1.8 -1.5 -1.2 -0.0 0.5 NA NA NA NA NA NA NA

J'ai tenté avec ifelse dans une double boucle pour grouper par évènement après mais ça ne fonctionne pas:
for (i in 1:nrow(SCHEFFERVILLE_A_gr_hour)){
for (j in 2:length(SCHEFFERVILLE_A_gr_hour)){
ifelse (SCHEFFERVILLE_A_gr_hour[i,j] == NA & SCHEFFERVILLE_A_gr_hour[i,j+1] == NA & SCHEFFERVILLE_A_gr_hour[i,j+2]==NA
& SCHEFFERVILLE_A_gr_hour[i,j+3]>=0 , SCHEFFERVILLE_A_gr_hour[i,j+3]<-"start"," ")
ifelse (SCHEFFERVILLE_A_gr_hour[i,j] <=0 & SCHEFFERVILLE_A_gr_hour[i,j+1] ==NA &
SCHEFFERVILLE_A_gr_hour[i,j+2] == NA & SCHEFFERVILLE_A_gr_hour[i,j+3] == NA, SCHEFFERVILLE_A_gr_hour[i,j]<-"end"," ")

Si quelqu'un a une piste à me fournir, ça serait avec plaisir :)
Merci beaucoup

[Logez Maxime]

Bonjour,

Il vaut mieux essayer de travailler sur chaque séquence en entier, que de travailler sur chaque élément de la séquence.
Ca permet d'enlever une des 2 boucles et de vectoriser un peu.
Il y a surement plus optimal que ça et il y a surement dans des packages des fonctions pour repérer ce genre de séquences.
L'idée ici c'est de repérer pour chaque ligne, les séquences définies par des valeurs qui se suivent et qui ne sont pas des na, de découper le vecteur selon ces séquences et d'identifier les sous séquences qui commencent par une valeur négative et qui finissent par une valeur positive.
Il est préférable de faire ces opérations en colonne plutôt qu'en ligne, c'est pour ça que j'ai transposé tes valeurs au début.

Code : Tout sélectionner

f <- function (x)
if (!is.na(x[1]) & x[1] < 0 & x[length(x)] > 0) {
    x
} else {
    rep(NA, length(x))
}

f1 <- function(x) {
  rle1 <- rle(is.na(x))
  rle1$values <- seq_along(rle1$values)
  res <- unlist(lapply(split(x, inverse.rle(rle1)), f))
  res
  }

dta <- SCHEFFERVILLE_A_gr_hour
dta <- t(dta[, -1])

dta2 <- apply(dta, 2, f1)
dta2 <- t(dta2)
dta2 <- as.data.frame(dta2)
SCHEFFERVILLE_A_gr_hour[-1] <- dta2


Cordialement,
Maxime

[Bastien Gratia]

Bonjour,
Merci beaucoup c'est exactement ce que je voulais!
J'étais arrivé à rédiger le code suivant, mais cela m'a indiqué l'erreur suivante :
Error in SCHEFFERVILLE_A_gr_hour[i, 2:25] < 0 & is.na(SCHEFFERVILLE_A_gr_hour[i - :
non-conformable arrays
Je ne sais pas pourquoi!

Code : Tout sélectionner

debut<-NA
fin<-NA
temp_series_df=data.frame()

for (i in 1:nrow(SCHEFFERVILLE_A_gr_hour)){
  if (SCHEFFERVILLE_A_gr_hour[i,2:25]<0 & is.na(SCHEFFERVILLE_A_gr_hour[i-1,2:25])& is.na(SCHEFFERVILLE_A_gr_hour[i-2,2:25])& is.na(SCHEFFERVILLE_A_gr_hour[i-3,2:25])){
    debut<-i
  }
  if (SCHEFFERVILLE_A_gr_hour[i,2:25]>0 & is.na(SCHEFFERVILLE_A_gr_hour[i+1,2:25]) & is.na(SCHEFFERVILLE_A_gr_hour[i+2,2:25]) & is.na(SCHEFFERVILLE_A_gr_hour[i+3,2:25])){
    fin<-i
  }
  if(!is.na(debut) && !is.na(fin) && fin>debut){
    temp_series_df<-rbind(temp_series_df, data.frame(temp_series=as.numeric(SCHEFFERVILLE_A_gr_hour[debut:fin, 2:25]),date=as.Date(SCHEFFERVILLE_A_gr_hour[debut:fin,1])))
  debut<-NA
  fin<-NA}
 
}


Mais enfin bref je vais essayer de comprendre votre code, encore merci. :)
Bastien

[Bastien Gratia]

Bonjour,

Savez vous comment je peux modifier le code, proposé par Logez Maxime, pour lui dire que dans la longueur de x il peut y avoir 3 NA ou moins qui se suivent et qu'il peut me les prendre en compte dans l'extraction des séquences. Par exemple :

x<-c(NA,5,-1.7,NA,NA,NA,NA,5,-5,NA,NA,NA,NA,5,5,7,NA,NA,NA,NA,9,9,9,4,NA,NA,1,-2,-2,-2)

le résultat devrait être :

x<-c(NA,-5,1.7,NA,NA,NA,NA,-5,5,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,-9,-9,-9,-4,NA,NA,-1,2,2,2)
En appliquant le code ça m'affiche ce résultat:
x<-c(NA,-5,1.7,NA,NA,NA,NA,-5,5,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,-1,2,2,2)
Merci!

[Logez Maxime]

Bonjour,

Essaye en remplaçant la fonction f1 par celle-ci :

Code : Tout sélectionner

f1 <- function(x) {
  rle1 <- rle(!is.na(x))
  rle2 <- rle1
  rle2$values[(rle1$lengths <= 3 & !rle1$values)] <- TRUE
  if(!rle1$values[1])
    rle2$values[1] <- FALSE
  if(!rle1$values[length(rle1$values)])
    rle2$values[1] <- FALSE
  x2 <- x
  x2[is.na(x)] <- 0
  x2 <- ifelse(inverse.rle(rle2), x2, x)
  rle3 <- rle(!is.na(x2))
  rle3$values <- seq_along(rle3$values)
  z <- factor(inverse.rle(rle3))
  res <- unlist(lapply(split(x, z), f))
  res
}


Cordialement,
Maxime

[Bastien Gratia]

Bonjour,

Merci!
J'ai réussi à trouver ce que je voulais avec le code suivant, en remplaçant 2 NA ou moins consécutifs par 99 et les NA de longueur >2 par 999.

Code : Tout sélectionner

f <- function (x){#definit les scenarios
  if (!is.na(x[1]) & x[1]!= 99 & x[1] > 0 & x[length(x)] < 0)  {
    x
  } else if (!is.na(x[1]) & x[1]==99 & x[2]==99 & x[3]!=99 & x[3]>0 & x[length(x)]<0){
    x
  }
    else if (!is.na(x[1]) & x[1]==99 & x[2]!=99 & x[2]>0 & x[length(x)]<0){
      x
    }
   else {
    rep(NA, length(x))
  }
}
f1 <- function(x) {
  rle1 <- rle(x)
  rle1$values[is.na(rle1$values)] <- 999
  x_new <- inverse.rle(rle1)
  rle2 <- rle(x_new)
  rle2$values[rle2$values == 999 & rle2$lengths <= 2] <- 99
  x_new2 <- inverse.rle(rle2)
  x <- x_new2
  rle3<-rle(x == 999)
  rle3$values <- seq_along(rle3$values)
  x_splt<-split(x, inverse.rle(rle3))
  res<-unlist(lapply(x_splt, f))
  res[res==99]<-NA
  res
}