Modérateur : Groupe des modérateurs
Code : Tout sélectionner
.data <- data.frame(
values = c(2L, 2L, 2L, 1L, 2L, 2L, 1L, 2L, 1L, 2L, 2L, 1L, 1L, 1L),
segment_names = NA
)
values_rle <- rle(.data$values)
pos_segment <- which(values_rle$values==2 & values_rle$lengths>=2)
values_rle$values <- rep("NA", length(values_rle$values))
for (ipos in seq(pos_segment)) {
values_rle$values[pos_segment[ipos]] <- paste0("segment_", ipos)
}
.data$segment_names <- inverse.rle(values_rle)
.data
#> values segment_names
#> 1 2 segment_1
#> 2 2 segment_1
#> 3 2 segment_1
#> 4 1 NA
#> 5 2 segment_2
#> 6 2 segment_2
#> 7 1 NA
#> 8 2 NA
#> 9 1 NA
#> 10 2 segment_3
#> 11 2 segment_3
#> 12 1 NA
#> 13 1 NA
#> 14 1 NA
Code : Tout sélectionner
?rle
x <- rev(rep(6:10, 1:5))
rle(x)
Code : Tout sélectionner
.data <- utils::read.table(text = "Valeur segment_name
2 segment_1
2 segment_1
2 segment_1
1 segment_1
2 segment_1
1 segment_1
2 segment_1
2 segment_1
1 segment_1
2 segment_1
2 segment_1
2 segment_1
1 NA
1 NA
1 NA
2 segment_2
2 segment_2
2 segment_2
2 segment_2
1 segment_2
2 segment_2
1 segment_2
2 segment_2
2 segment_2
2 segment_2
1 NA
1 NA
2 NA
2 NA
1 NA
1 NA
2 NA
1 NA", header = TRUE)
Code : Tout sélectionner
values_rle <- rle(.data$Valeur)
# Get start position three times "2"
pos_segment_start <- which(values_rle$values==2 & values_rle$lengths>=3)
# Get end position two times "1"
pos_segment_end <- which(values_rle$values==1 & values_rle$lengths>=2)
# Locate where the segment should end in the vector of starting positions
pos_segment_end <- pos_segment_end[!duplicated(findInterval(pos_segment_end, pos_segment_start))]
# Get the smallest starting position for each end position
pos_segment_start <- tapply(
X = pos_segment_start,
INDEX = findInterval(pos_segment_start, pos_segment_end),
FUN = min
)
# change the values in the rle object with new names based on start/end position
values_rle$values <- rep("NA", length(values_rle$values))
for (ipos in seq(pos_segment_start)) {
values_rle$values[pos_segment_start[ipos]:(pos_segment_end[ipos]-1)] <- paste0("segment_", ipos)
}
# revert rle to get segment names
.data$segment_names <- inverse.rle(values_rle)
Code : Tout sélectionner
.data
#> Valeur segment_name segment_names
#> 1 2 segment_1 segment_1
#> 2 2 segment_1 segment_1
#> 3 2 segment_1 segment_1
#> 4 1 segment_1 segment_1
#> 5 2 segment_1 segment_1
#> 6 1 segment_1 segment_1
#> 7 2 segment_1 segment_1
#> 8 2 segment_1 segment_1
#> 9 1 segment_1 segment_1
#> 10 2 segment_1 segment_1
#> 11 2 segment_1 segment_1
#> 12 2 segment_1 segment_1
#> 13 1 <NA> NA
#> 14 1 <NA> NA
#> 15 1 <NA> NA
#> 16 2 segment_2 segment_2
#> 17 2 segment_2 segment_2
#> 18 2 segment_2 segment_2
#> 19 2 segment_2 segment_2
#> 20 1 segment_2 segment_2
#> 21 2 segment_2 segment_2
#> 22 1 segment_2 segment_2
#> 23 2 segment_2 segment_2
#> 24 2 segment_2 segment_2
#> 25 2 segment_2 segment_2
#> 26 1 <NA> NA
#> 27 1 <NA> NA
#> 28 2 <NA> NA
#> 29 2 <NA> NA
#> 30 1 <NA> NA
#> 31 1 <NA> NA
#> 32 2 <NA> NA
#> 33 1 <NA> NA
Cela est t il possible de vous envoyer un jeu de données plus gros?
Code : Tout sélectionner
get.segment <- function(v) {
v0 <- paste0(v,collapse='')
start <- gregexpr("2{3,}",v0)[[1]]
stop <- gregexpr("1{2,}",v0)[[1]]
i <- rep(0,length(v))
i[start] <- 2
i[stop] <- 1
i0 <- paste0(i,collapse='')
g <- gregexpr("2(.*?)1",i0)[[1]]
m <- matrix(c(g,attr(g,"match.length")+g-2),nrow=2)
segment <- rep(NA,length(v))
for (j in 1:nrow(m)) segment[m[j,1]:m[j,2]] <- j
segment
}
Code : Tout sélectionner
cbind(.data,segment=get.segment(.data$Valeur))
Code : Tout sélectionner
test <- paste(tab$Valeur, collapse="")
library(stringi)
auxi <- stri_locate_all(test, regex= "2{3,}(1{1}[^1]+|[^1]+)+(?=1{2})")[[1]]
res <- rep(NA, nrow(tab))
for (i in 1:nrow(auxi)) res[auxi[i,1]:auxi[i,2]] <- sprintf("segment_%s", i)
all.equal(as.character(tab$segment_name), res)
[1] TRUE
Laure Trudel a écrit :Autre chose peut-on le faire avec une valeur continue, par exemple, comprise entre 1 et 2 où j'ai au minimum 3 valeurs >= 1.65 alors j'associe un segment sinon NA et le segment s'arrête qd j'ai au moins 2 valeurs < 1.65 ?
Retourner vers « Questions en cours »
Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 1 invité