Finding subvector di lunghezza massima che contiene una piccola percentuale di 0 di

Question

Ho un vettore che contiene una sequenza di 1 e 0. Si supponga di esso è di lunghezza 166 ed è

y <- c(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1, 1,1,1,1,1,0,1,1,0,1,0,1,0,0,0,0,0,1,0,0,0,1,1,0,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 
1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1,1,1,1,1,1,1, 
1,1,1,1,1,1,1,1,0,1,1,0,1,1,1,0,0,0,0,0,1,1,1,1) 

Ora voglio estrarre una LUNGA sub vettore pOSSIBILE dall'alto vettoriale, che soddisfa due proprietà

(1) sub-vettore dovrebbe iniziare da 1 e termina con 1.

(2) si può contenere fino a 5% del totale zeri lunghezza del sub-vettore.

Ho iniziato con la funzione rle. Conta 1 e 0 ad ogni passo. Così sarà come

z <- rle(y) 
d <- data.frame(z$values, z$lengths) 
colnames(d) <- c("value", "length") 

Mi dà

> d 
    value length 
1  1  22 
2  0  1 
3  1  13 
4  0  1 
5  1  2 
6  0  1 
7  1  1 
8  0  1 
9  1  1 
10  0  5 
11  1  1 
12  0  3 
13  1  2 
14  0  1 
15  1  1 
16  0  1 
17  1  74 
18  0  2 
19  1  17 
20  0  1 
21  1  2 
22  0  1 
23  1  3 
24  0  5 
25  1  4 

In questo caso 2+ + 17 74 + 1 + 2 + 3 = 99 è il sub-sequenza richiesta in quanto contiene 2+ 1 + 1 = 4 zeri che è inferiore al 5% di 99. Se andiamo avanti e la sequenza diventerà 99 + 5 + 4 = 108 e gli zeri saranno 4 + 5 = 9 che saranno più del 5% di 108.

Answer 1

Penso che tu sia molto vicino calcolando la codifica run-length di questo vettore. Non resta che considerare tutte le coppie di esecuzioni di 1 e selezionare la coppia che è della lunghezza più lunga e corrisponde alla regola "non più del 5% di zeri". Questo può essere fatto in un modo completamente vettorializzare utilizzando combn per calcolare tutte le coppie di piste di 1 e cumsum per ottenere lunghezze di piste dal rle uscita:

ones <- which(d$value == 1) 
# pairs holds pairs of rows in d that correspond to runs of 1's 
if (length(ones) >= 2) { 
    pairs <- rbind(t(combn(ones, 2)), cbind(ones, ones)) 
} else if (length(ones) == 1) { 
    pairs <- cbind(ones, ones) 
} 

# Taking cumulative sums of the run lengths enables vectorized computation of the lengths 
# of each run in the "pairs" matrix 
cs <- cumsum(d$length) 
pair.length <- cs[pairs[,2]] - cs[pairs[,1]] + d$length[pairs[,1]] 
cs0 <- cumsum(d$length * (d$value == 0)) 
pair.num0 <- cs0[pairs[,2]] - cs0[pairs[,1]] 

# Multiple the length of a pair by an indicator for whether it's valid and take the max 
selected <- which.max(pair.length * ((pair.num0/pair.length) <= 0.05)) 
d[pairs[selected,1]:pairs[selected,2],] 
# value length 
# 15  1  1 
# 16  0  1 
# 17  1  74 
# 18  0  2 
# 19  1  17 
# 20  0  1 
# 21  1  2 
# 22  0  1 
# 23  1  3 

In realtà abbiamo trovato un subvector che è leggermente più lungo che quello trovato dall'OP: ha 102 elementi e cinque 0 (4,90%).