Zeilen aus einem dat.frame basierend auf gemeinsamen Werten mit einer Liste extrahieren

Question

Ich suche nach einer einfachen Möglichkeit zum Filtern von Zeilen aus einem dat.frame, basierend auf einer Liste numerischer Sequenzen.

Hier ist ein exemple:

Mein erster Datenrahmen:

data <- data.frame(x=c(0,1,2,0,1,2,3,4,5,12,2,0,10,11,12,13),y="other_data") 

Meine Liste:

list1 <- list(1:5,10:13) 

Mein Ziel ist nur die Zeilen von "Daten" zu halten, die genau enthalten die gleiche Zahlenfolgen von "list1" wie in der "x" Spalte von "data". So sollte die Ausgabe data.frame sein:

finaldata <- data.frame(x=c(1:5,10:13),y="other_data") 

Irgendwelche Ideen, dies zu tun?

Answer 1

ich mit einer benutzerdefinierten Funktion gestartet, es ist die Teilmenge erhalten für eine Sequenz, dann einfach mit lapply zu verlängern.

#function that takes sequence and a vector 
#and returns indices of vector that have complete sequence 
get_row_indices<- function(sequence,v){ 
    #get run lengths of whether vector is in sequence 
    rle_d <- rle(v %in% sequence) 
    #test if it's complete, so both v in sequence and length of 
    #matches is length of sequence 
    select <- rep(length(sequence)==rle_d$lengths &rle_d$values,rle_d$lengths) 

    return(select) 

} 


#add row ID to data to show selection 
data$row_id <- 1:nrow(data) 
res <- do.call(rbind,lapply(list1,function(x){ 
    return(data[get_row_indices(sequence=x,v=data$x),]) 
})) 

res 

> res 
    x   y row_id 
5 1 other_data  5 
6 2 other_data  6 
7 3 other_data  7 
8 4 other_data  8 
9 5 other_data  9 
13 10 other_data  13 
14 11 other_data  14 
15 12 other_data  15 
16 13 other_data  16 

Answer 2

Warum nicht rollapply von zoo mit:

library(zoo) 

ind = lapply(list1, function(x) { 
    n = length(x) 
    which(rollapply(data$x, n, function(y) all(y==x))) + 0:(n-1) 
}) 

data[unlist(ind),] 
#x   y 
#5 1 other_data 
#6 2 other_data 
#7 3 other_data 
#8 4 other_data 
#9 5 other_data 
#13 10 other_data 
#14 11 other_data 
#15 12 other_data 
#16 13 other_data 

Answer 3

Die Funktion match2 geht durch jeden x Wert und überprüft sie und die nächsten n Werte gegen einen Vektor der Länge n. Dann verwendet Reduce, um eine Sequenz für die Indizierung zu erstellen.

match2 <- function(vec) { 
    start <- which(sapply(1:nrow(data), function(i) all(data$x[i:(i+length(vec)-1)] == vec))) 
    Reduce(':', c(start,start+length(vec)-1)) 
} 

Damit können wir eine Anwendung Funktion wiederholen Sie den Vorgang für jede list1 verwenden.

s <- sapply(list1, match2) 
data[unlist(s),] 
#  x   y 
# 5 1 other_data 
# 6 2 other_data 
# 7 3 other_data 
# 8 4 other_data 
# 9 5 other_data 
# 13 10 other_data 
# 14 11 other_data 
# 15 12 other_data 
# 16 13 other_data 

Answer 4

extract_fun <- function(x, dat){ 
    # Index where the sequences start 
    ind <- which(dat == x[1]) 
    # Indexes (within dat) where the sequence should be 
    ind_seq <- lapply(ind, seq, length.out = length(x)) 
    # Extract the values from dat at the position 
    dat_val <- mapply(`[`, list(dat), ind_seq) 
    # Check if values within dat == those in list1 
    i <- which(as.logical(apply(dat_val, 2, all.equal, x))) # which one is equal? 
    # Return the correct indices 
    ind_seq[[i]] 
} 

die Indizes pro Artikel in list1 erhalten und sie auf die benötigten Indizes

all_ind <- do.call(c, lapply(list1, extract_fun, data$x)) 
data[all_ind,] 

Ergebnis kombinieren:

x   y 
5 1 other_data 
6 2 other_data 
7 3 other_data 
8 4 other_data 
9 5 other_data 
13 10 other_data 
14 11 other_data 
15 12 other_data 
16 13 other_data