Je cherche un moyen d'identifier une saison de croissance qui consiste en un nombre de jours supérieur, disons, à 60 entre le dernier jour de gel du printemps et le premier jour de gel de l'automne. Une version générale de ce problème est la suivante. Si j'ai un vecteur de nombres comme testVec, je veux les numéros d'élément de la plage de valeurs de début et de fin où le nombre d'éléments est de 5 ou plus et tous sont supérieurs à 0.
testVec <- c(1,3,4,0, 1, -5, 6, 0, 1,3,4,6,7,5,9, 0)
Dans cet exemple, la plage pertinente est 1,3,4,6,7,5,9 qui est testVec[9] à testVec[15]
3 Réponses :
Une option pourrait être:
testVec[with(rle(testVec > 0), rep(lengths * values >= 5, lengths))] [1] 1 3 4 6 7 5 9
Ici, l'idée est d'abord de créer des séries de valeurs inférieures ou égales à zéro et supérieures à zéro. Deuxièmement, il vérifie si les séries de valeurs supérieures à zéro ont une longueur de 5 ou plus. Enfin, il sous-définit le vecteur d'origine pour les séries de valeurs supérieures à zéro avec une longueur de 5 ou plus.
c'est bon. Seriez-vous prêt à ajouter quelques explications?
@Ben Bolker bien sûr, a fourni quelques explications :)
Cela ne répond pas tout à fait à ma question. Je voudrais également l'id des valeurs de début et de fin. rleid de la réponse ci-dessous semble prometteur.
1) rleid Ceci gère également n'importe quel nombre de séquences, y compris zéro. rleid(ok) est un vecteur de la même longueur que ok tel que la première série d'éléments identiques est remplacée par 1, la deuxième série par 2 et ainsi de suite. Le résultat est une liste de vecteurs où chaque vecteur a ses positions dans l'entrée d'origine comme ses noms.
g <- gregexpr("1{5,}", paste(+(testVec > 0), collapse = ""))[[1]]
ix <- seq(g, length = attr(g, "match.length"))
setNames(testVec[ix], ix)
## 9 10 11 12 13 14 15
## 1 3 4 6 7 5 9
Si une trame de données était souhaitée, les valeurs suivantes sont fournies et la séquence d'où provient la ligne. Les noms de ligne indiquent les positions dans l'entrée d'origine.
getSeq2 <- function(x) {
g <- gregexpr("1{5,}", paste(+(x > 0), collapse = ""))[[1]]
vals <- function(i) {
ix <- seq(g[i], length = attr(g, "match.length")[i])
setNames(x[ix], ix)
}
if (length(g) == 1 && g == -1) list() else lapply(seq_along(g), vals)
}
getSeq2(testVec)
## [[1]]
## 9 10 11 12 13 14 15
## 1 3 4 6 7 5 9
2) gregexpr Remplacez chaque élément> 0 par 1 et chaque autre élément par 0 en collant les 0 et 1 dans une seule chaîne de caractères. Ensuite, utilisez gregexpr pour rechercher des séquences de 1 d'au moins 5 longues et pour la ième séquence non superposée, retournez les premières positions, g , et les longueurs, attr(g, "match.length") . Définissez une fonction vals qui extrait les valeurs aux positions requises de testVec de la ième séquence non chevauchante retournant une liste telle que le ième composant de la liste soit la ième de cette séquence. Les noms dans le vecteur de sortie sont ses positions dans l'entrée.
gs <- getSeq(c(testVec, 10 * testVec)) names(gs) <- seq_along(gs) if (length(gs)) stack(gs) else gs ## values ind ## 9 1 1 ## 10 3 1 ## 11 4 1 ## 12 6 1 ## 13 7 1 ## 14 5 1 ## 15 9 1 ## 25 10 2 ## 26 30 2 ## 27 40 2 ## 28 60 2 ## 29 70 2 ## 30 50 2 ## 31 90 2
Ce qui précède gère n'importe quel nombre de séquences, y compris 0, mais si nous savions qu'il y avait exactement une séquence (ce qui est le cas de l'exemple de la question), alors cela pourrait être simplifié comme suit où la valeur de retour est juste ce vecteur:
library(data.table)
getSeq <- function(x) {
names(x) <- seq_along(x)
ok <- x > 0
s <- split(x[ok], rleid(ok)[ok])
unname(s)[lengths(s) >= 5]
}
getSeq(testVec)
## [[1]]
## 9 10 11 12 13 14 15
## 1 3 4 6 7 5 9
getSeq(numeric(16))
## list()
getSeq(c(testVec, 10 * testVec))
## [[1]]
## 9 10 11 12 13 14 15
## 1 3 4 6 7 5 9
##
## [[2]]
## 25 26 27 28 29 30 31
## 10 30 40 60 70 50 90
Un petit ajout à quelques exemples extrêmement utiles d'approches alternatives. g contient les positions de début et de fin de la séquence.
Vous pouvez "corriger" la solution de @ tmfmnk comme ceci:
f4 <- function(x, threshold, n) {
y <- with(rle(x > threshold), rep(lengths * values >= n, lengths))
i <- which(y)[1]
j <- i + which(!y[-c(1:i)])[1] - 1
c(i, j)
}
Mais cela ne fonctionne pas bien lorsqu'il y a plusieurs exécutions
f3 <- function(x, threshold, n) {
y <- x > threshold
r <- rle(y)
m <- max(r$lengths)
if (m < n) return (c(NA, NA))
i <- sum(r$lengths[1:which.max(r$lengths)[1]])
c(i-max(r$lengths)+1, i)
}
f3(x, 0, 5)
#[1] 9 15
f3(xx, 0, 5)
#[1] 9 15
Voici une autre approche, pas si concise, qui renvoie le début et la fin de la course la plus longue (la première s'il y a des égalités).
f2 <- function(x, threshold, n) {
y <- x > threshold
y[is.na(y)] <- FALSE
a <- ave(y, cumsum(!y), FUN=cumsum)
m <- max(a)
if (m < n) return (c(NA, NA))
i <- which(a == m)[1]
c(i-m+1, i)
}
f2(x, 0, 5)
#[1] 9 15
f2(xx, 0, 5)
#[1] 9 15
ou avec rle
xx <- c(x, x) f1(xx, 0, 5) #[1] 9 31
Si vous vouliez que la première exécution soit au moins n, c'est-à-dire que vous ne voulez pas d'une prochaine exécution, même si elle est plus longue, vous pouvez faire
f1 <- function(x, threshold, n) {
range(which(with(rle(x > threshold), rep(lengths * values >= n, lengths))))
}
x <- c(1, 3, 4, 0, 1, -5, 6, 0, 1,3,4,6,7,5,9, 0)
f1(x, 0, 5)
#[1] 9 15