[Resolu] Repérer la plus longue série de valeurs croissantes ou de positions contiguës dans un vecteur

[Franck Theeten]

Bonjour,

Je souhaiterais extraire la plus longue série croissante des valeurs figurant dans une colonne d’un dataframe.
En première approche, j’ai extrait les incréments via

Code : Tout sélectionner

dev<-diff(p_frame$valeur)

dev<-c(dev,0)

J’ai ensuite extrait les écarts positifs ou nuls avec "which", puis une fonction parcourt ce tableau des indices pour trouver la plus longue série contigüe. Elle contient une grande boucle et deux accumulateurs : un pour l’indice de départ de la série testée, l’autre pour sa longueur.
Cela semble fonctionner, mais cela n'est pas très élégant en terme de complexité, et verbeux. Est-ce qu'il n'existe pas une solution plus élégante et plus proche de la philosophie de R, via le frame originel ou bien les indices du vecteur des positions ?

Code : Tout sélectionner

count_contiguous_positives<-function(param)
{
  pos<-which(param>=0)
  print(pos)
 
  serie_length<-0
  current_serie = 1
  length_biggest_serie = 0
  biggest_serie = 1
  #on part de l'indice dans la deuxième cellule et on boucle
  for(i in 2:length(pos))
  {
      current=pos[i]
      previous=pos[i-1]
      #on lui soustrait l'indice son prédecesseur
      # si la différence est un => série positive en cours
      if(current-previous==1)
      {
        serie_length<-serie_length+1
      }
      #sinon série interrompue ou courant jusqu'à la fin
      else
      {
        #si la série est la plus longue comparée , on la garde
        if(serie_length>length_biggest_serie)
        {
          biggest_serie=current_serie
          length_biggest_serie=serie_length
        }
        #on réinitialise toujours le compteur de la série courante sur la position actuelle
        current_serie=i
        serie_length=0
      }
      #on teste la longueur en sortie de boucle si coupure sur série croissante
      if(serie_length>length_biggest_serie)
      {
        biggest_serie=current_serie
        length_biggest_serie=serie_length
      }
     
  }
  print("biggest serie")
  print(biggest_serie)
  print("length biggest serie")
  print(length_biggest_serie)
  biggest_serie
 
}

cut <- count_contiguous_positives(dev)



EDIT 18 02 : le code ci-dessus ne marche pas. Version corrigée (ne passant pas par le tableau d'indices) :

Code : Tout sélectionner

count_contiguous_positives<-function(param)
{
 

 
  serie_length<-1
  current_serie = 1
  length_biggest_serie = 0
  biggest_serie = 1
  for(i in 2:length(param))
  {
      current=param[i]
      previous=param[i-1]
      if(current-previous>=0)
      {
        serie_length<-serie_length+1
      }
      else
      {
        print(paste("break at ", i))
        if(serie_length>length_biggest_serie)
        {
          biggest_serie=current_serie
          length_biggest_serie=serie_length
        }
        if(i<length(param))
        {
          current_serie=i
          serie_length=1
        }
      }
     
     
  }
  print("biggest serie")
  print(biggest_serie)
  print("length biggest serie")
  print(length_biggest_serie)
  biggest_serie
 
}

[François Bonnot]

Bonjour,
Il faudrait un exemple numérique court (le vecteur de départ et le résultat souhaité).

[jean lobry]

Bonjour,

je regarderais du coté de rle(), voici une piste :

Code : Tout sélectionner

set.seed(1) # pour repro
x <- rnorm(100)
xd <- diff(x) # incréments
xc <- ifelse(xd >= 0, "+", "-") # croissant ou décroissant ?
rlexc <- rle(xc) # Run Length Encoding (voir documentation)
rlexc$values  # croissant ou décroissant
rlexc$lengths # nombre de répétitions
#
# Quel est le plus grand nombre de "+" consécutifs ?
#
plusmax <- max(rlexc$lengths[rlexc$values == "+"])
#
# Quel est le premier rang correspondant ?
#
iplusmax <- which(rlexc$values == "+" & rlexc$lengths == plusmax)[1]
#
# Je recode avec des • celui qui m'intéresse
#
rlexc$values[iplusmax] <- "•"
inverse.rle(rlexc)
#
# J'ai localisé ainsi la première plus longue suite
# croissante.

Amicalement,

jean

[Pierre-Yves Berrard]

Un peu d'auto-publicité :

Code : Tout sélectionner

croiss <- funprog::group_if(x, `<`)

longueurs <- lengths(croiss)
croiss[longueurs == max(longueurs)] # ajouter [[1]] pour avoir la première des plus longues séquences    

[François Bonnot]

Bonjour,
Une autre piste :

Code : Tout sélectionner

z <- split(x,c(0,cumsum(diff(x)<0))) ## liste de toutes les séries croissantes de x
z[i <- which.max(len <- sapply(z,length))] ## la (première) plus longue série

##On peut aussi localiser la série dans x :
debut <- if (i==1) 1 else sum(len[1:(i-1)])+1
fin <- debut+len[i]-1
x[debut:fin]

[Franck Theeten]

Bonjour à tous,

Merci à vous trois pour vos réponses ! Les trois approches sont très intéressantes et fonctionnent. J'ai en effet besoin de localiser la série dans la séquence d'origine.
Je ne suis pas arrivé à la localiser avec la méthode proposée par François, sans doute parce qu'elle recherche dans "split" qui filtre les parties décroissantes, mais ai ce "localisateur" qui recherche la série positive complète dans la série initiale via "all" et un offset.

Code : Tout sélectionner

 
 
  z <- split(x,c(0,cumsum(diff(x)<0))) ## liste de toutes les séries croissantes de x
  tmp<-z[which.max(len <- sapply(z,length))] ## la (première) plus longue série
 longuest<-tmp[[1]]

#localiser
  idx <- which(x== longuest[1])
  pos<-idx[sapply(idx, function(i) all(x[i:(i+(length(longuest)-1))] == longuest))]


A titre d'information sur un petit vecteur de 353 points, un petit benchmark avec "Sys.time()" donne les résultats suivants :

Code : Tout sélectionner

Ma fonction : Time difference of  0.01898789 secs
Funproc :  Time difference of 0.007507086 secs
Sapply :  Time difference of 0.0009992123 secs
+ Durée localisateur : Time difference of 0 secs
rle : Time difference of 0  secs



La fonction la plus rapide semble (pour mes données et ma machine) ...être "rle" proposée par Jean, qui inclut la localisation, ce qui est étonnant car il s'agît d'un algorithme de compression, avec une opération de recodage des données. Mais il donne en tout cas de bons résultats.

J'ai aussi corrigé ma fonction dans le premier message , car celle publiée hier ne marchait pas.

[François Bonnot]

Je ne suis pas arrivé à la localiser avec la méthode proposée par François

Bonjour,
Comme indiqué dans le commentaire du code, la série est localisée dans la variable "debut" (comme son nom l'indique) qui contient la même valeur que "pos" (qui est donc inutile et dont le calcul est beaucoup plus long).

[Logez Maxime]

Bonjour,

une solution toujours basée sur rle (qui ne recherche que la première série la plus longue ):

Code : Tout sélectionner

  xd <- diff(x)
  xc <- c(0, (xd >0)*1)
  r1 <- rle(xc)
  iplusmax <- which.max(r1$le*r1$val)
  plusmax <- r1$le[iplusmax]
  deb <- sum(r1$le[seq_len(iplusmax-1)])
  fin <- deb+plusmax
  serie <- x[deb:fin]


Pour comparer ou évaluer des temps d'éxecution j'utilise la librairie microbenchmark et la fonction éponyme :

Code : Tout sélectionner

library(microbenchmark)
microbenchmark({xd <- diff(x)
  xc <- c(0, (xd >0)*1)
  r1 <- rle(xc)
  iplusmax <- which.max(r1$le*r1$val)
  plusmax <- r1$le[iplusmax]
  deb <- sum(r1$le[seq_len(iplusmax-1)])
  fin <- deb+plusmax
  serie <- x[deb:fin]})
 

Pour plus de lisibilité tu peux encapsuler les scripts dans des fonctions :

Code : Tout sélectionner

Max <- function(x) {
xd <- diff(x)
  xc <- c(0, (xd >0)*1)
  r1 <- rle(xc)
  iplusmax <- which.max(r1$le*r1$val)
  plusmax <- r1$le[iplusmax]
  deb <- sum(r1$le[seq_len(iplusmax-1)])
  fin <- deb+plusmax
  serie <- x[deb:fin]
  }
  microbenchmark(Max(x))
 

Cordialement,
Maxime

[François Bonnot]

Verdict: la solution de Maxime avec rle() est environ 6 fois plus rapide qu'avec split().