Finding subvector der maximalen Länge des einen geringen Anteil von 0 enthält

Question

Ich habe einen Vektor, der eine Folge von 1 und 0 davon Länge von 166 Angenommen enthält, und es ist

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) 

Jetzt will ich extrahieren eine möglichst lange Teilvektor von oben Vektor derart, dass sie zwei Eigenschaften erfüllt

(1) Untervektor aus 1 starten soll und enden mit 1.

(2) es kann bis zu 5% der Gesamt Nullen enthalten Länge des Untervektors.

Ich begann mit rle Funktion. Es zählt die 1 und 0 bei jedem Schritt. So wird es sein wie

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

Es mir

> 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 diesem Fall 74 + 2 + 17 + 1 + 2 + 3 ergibt = 99 ist die erforderliche Untersequenz, wie es enthält 2+ 1 + 1 = 4 Nullen, was weniger als 5% von 99 ist. Wenn wir vorwärts gehen, wird die Sequenz 99 + 5 + 4 = 108 und Nullen werden 4 + 5 = 9, was mehr als 5% von 108 ist.

Answer 1

Ich denke, Sie sind sehr nahe bei der Berechnung der Lauflängencodierung dieses Vektors. Alles, was übrig bleibt, ist, alle Paare von Läufen von 1 zu berücksichtigen und das Paar auszuwählen, das die längste Länge hat und mit der Regel "nicht mehr als 5% Nullen" übereinstimmt. Dies kann in einer vollständig vektorisiert Weise erfolgen combn unter Verwendung aller Paare von Läufen von 1-en zu berechnen und cumsum zu bekommen Längen von Läufen aus der rle Ausgabe:

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 

Wir fanden tatsächlich einen subvector, der etwas länger ist, dass einer gefunden von der OP: es hat 102 Elemente und fünf 0 (4,90%).