podziału wektor oddzielone przez N zer na różne grupy

Question

muszę to wektor x

x = c(1, 1, 2.00005, 1, 1, 0, 0, 0, 0, 1, 2, 0, 3, 4, 0, 0, 0, 0, 1, 2, 3, 1, 3) 

muszę rozdzielania wartości oddzielone n (w tym przypadku, załóżmy n jest 3) lub więcej zer na różne grupy.

Pożądany wynik byłby

list(x1 = c(1, 1, 2.00005, 1, 1), 
    x2 = c(1, 2, 0, 3, 4), 
    x3 = c(1, 2, 3, 1, 3)) 
#$x1 
#[1] 1.00000 1.00000 2.00005 1.00000 1.00000 

#$x2 
#[1] 1 2 0 3 4 

#$x3 
#[1] 1 2 3 1 3 

Następujące nie działa, ponieważ dzieli x nawet gdy istnieją mniej niż n zera w grupie.

temp = cumsum(x == 0) 
split(x[x!=0], temp[x!=0]) 
#$`0` 
#[1] 1.00000 1.00000 2.00005 1.00000 1.00000 

#$`4` 
#[1] 1 2 

#$`5` 
#[1] 3 4 

#$`9` 
#[1] 1 2 3 1 3 

Answer 1

Oto moja próba. Ta metoda zastępuje przebiegi zerowe, których długość jest mniejsza lub równa 3 za pomocą NA. Ponieważ NA jest usuwany podczas korzystania z split(), pozostaje nam pożądane wyjście.

x <- c(1, 1, 2.00005, 1, 1, 0, 0, 0, 0, 1, 2, 0, 3, 4, 0, 0, 0, 0, 1, 2, 3, 1, 3) 

ll <- with(rle(x == 0), { 
    ifelse(x == 0 & (seq_along(x) != cumsum(lengths)[lengths <= 3 & values]), NA, x) 
}) 

split(x, with(rle(is.na(ll)), rep(1:length(lengths), lengths) + ll * 0)) 
# $`1` 
# [1] 1.00000 1.00000 2.00005 1.00000 1.00000 
# 
# $`3` 
# [1] 1 2 0 3 4 
# 
# $`5` 
# [1] 1 2 3 1 3 

Answer 2

Oto metoda, split z rle i lapply

# get RLE 
temp <- rle(x) 
# replace values with grouping variables 
temp$values <- cumsum(temp$values == 0 & temp$lengths > 2) 

# split on group and lapply through, dropping 0s at beginning which are start of each group 
lapply(split(x, inverse.rle(temp)), function(y) y[cummax(y) > 0]) 
$`0` 
[1] 1.00000 1.00000 2.00005 1.00000 1.00000 

$`1` 
[1] 1 2 0 3 4 

$`2` 
[1] 1 2 3 1 3 

---

Druga metoda bez lapply się następująco

# get RLE 
temp <- rle(x) 
# get positions of 0s that force grouping 
changes <- which(temp$values == 0 & temp$lengths > 2) 
# get group indicators 
temp$values <- cumsum(temp$values == 0 & temp$lengths > 2) 
# make 0s a new group 
temp$values[changes] <- max(temp$values) + 1L 

# create list 
split(x, inverse.rle(temp)) 
$`0` 
[1] 1.00000 1.00000 2.00005 1.00000 1.00000 

$`1` 
[1] 1 2 0 3 4 

$`2` 
[1] 1 2 3 1 3 

$`3` 
[1] 0 0 0 0 0 0 0 0 

Wreszcie, można po prostu spaść ostatnia pozycja na liście, na przykład head(split(x, inverse.rle(temp)), -1).

Answer 3

Oto pomysł kilkukrotnego użycia rle i inverse.rle w celu utworzenia podzbioru x (x_sub) i numeru grupy (group_sub). Na koniec użyj split, aby uzyskać ostateczne wyniki.

x <- c(1, 1, 2.00005, 1, 1, 0, 0, 0, 0, 1, 2, 0, 3, 4, 0, 0, 0, 0, 1, 2, 3, 1, 3) 

### Step 1: Filtet the index with values == 0 and length > 3 
x2 <- as.integer(x != 0) 
run <- rle(x2) 
index <- which(run$values == 0 & run$lengths > 3) 

### Step 2: Replace the values in index to -1 
### Create an intermediate index (x3) 
run2 <- run 
run2$values[index] <- -1 
run2$values[run2$values == 0] <- 1 
x3 <- inverse.rle(run2) 

### Step 3: Create grouping variable (x4) 
run3 <- rle(x3) 
run3$values <- 1:length(run3$values) 
x4 <- inverse.rle(run3) 

### Step 4: Subset x by x3 and x4 (x_sub) and create group number (group_sub) 
x_sub <- x[x3 != -1] 
group_sub <- x4[x3 != -1] %/% 2 + 1 

### Step 5: Split x_sub to get the final output (final_list) 
final_list <- split(x_sub, f = group_sub) 

final_list 
$`1` 
[1] 1.00000 1.00000 2.00005 1.00000 1.00000 

$`2` 
[1] 1 2 0 3 4 

$`3` 
[1] 1 2 3 1 3 

Answer 4

Metoda ta jest tylko nieznacznie różni się od tego, co już zaproponował, i obejmuje pierwszy etap zastępując wszystkie odcinki N lub większą liczbą zer o wartości nie odnaleziono w X, na przykład max + 1:

r = rle(x) 
val = max(x,na.rm=T)+1 
r$values[r$values==0 & r$lengths>2] = val 
x2 = inverse.rle(r) 
temp = cumsum(x2 == val) 
split(x2[x2!=val], temp[x2!=val]) 

$`0` 
[1] 1.00000 1.00000 2.00005 1.00000 1.00000 

$`4` 
[1] 1 2 0 3 4 

$`8` 
[1] 1 2 3 1 3 

Answer 5

Jeszcze inne rozwiązanie z wykorzystaniem rle (dwa razy) i inverse.rle.

n <- 3 
r <- rle(as.integer(x == 0)) 
r$values[r$values == 1 & r$lengths < n] <- 0 
r <- rle(inverse.rle(r)) 

group <- integer(length(x)) 
start <- 1 
for(i in seq_along(r$values)){ 
    group[start:(start + r$lengths[i] - 1)] <- c(1L, rep(0L, r$lengths[i] - 1)) 
    start <- start + r$lengths[i] 
} 

W międzyczasie zdałem sobie sprawę, że kod, który przygotowuje pętlę powyżej i sama pętla może być znacznie uproszczona. Aby go ukończyć, powtórzę początkowe wiersze kodu.

r <- rle(as.integer(x == 0)) 
r$values[r$values == 1 & r$lengths < n] <- 0 

# This is the simplification 
group <- c(1L, diff(inverse.rle(r)) != 0) 

res <- split(x, cumsum(group)) 
res <- res[-which(sapply(res, function(y) all(y == 0)))] 
res 
#$`1` 
#[1] 1.00000 1.00000 2.00005 1.00000 1.00000 
# 
#$`3` 
#[1] 1 2 0 3 4 
# 
#$`5` 
#[1] 1 2 3 1 3