2015-10-15 14 views
18

Tôi có một vectơ với các mẫu lặp lại bên trong nó. Tôi muốn phá vỡ bất kỳ nơi mà các mô hình lặp đi lặp lại của chiều dài n thay đổi. Dưới đây là các dữ liệu:Tìm và ngắt các lần chạy lặp lại

x <- c(rep(1:4, 5), rep(5:6, 3), rep(c(1, 4, 7), 5), rep(c(1, 5, 7), 1), rep(2:4, 3)) 

## [1] 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4 1 2 3 4 5 6 5 6 5 6 1 4 7 1 4 7 1 4 7 1 4 7 1 4 7 1 5 7 2 3 4 2 3 4 2 3 4 

Tôi muốn để có thể tìm những nơi mô hình thay đổi nên nó phá vỡ như thế này:

enter image description here

Tôi nghĩ rle có thể được sử dụng nhưng không xem như thế nào.

+1

upvoting nhưng không chắc chắn nguyên tắc phân vùng này là được xác định rõ. Có thể '1 1 2' là một mẫu lặp lại hay là chữ số luôn luôn duy nhất trong một lần chạy? – Frank

+0

Có độ dài tối đa mà một mẫu có thể có không? – RHA

+0

@RHA không có độ dài tối đa –

Trả lời

13

Đây là chức năng để thực hiện. Nhân tiện, đây là một vấn đề trong di truyền học - tìm lặp lại song song. Here's a link to an algorithm paper đó là một điều trị tốt hơn nhiều so với điều này, nhưng phức tạp hơn nhiều để thực hiện.

Đầu ra là một vectơ của các nhóm để chia x thành.

Đầu tiên một hàm helper:

factorise <- function(x) { 
    x <- length(x) 
    if(x == 1){return(1)} 
    todivide <- seq(from = 2, to = x) 
    out <- todivide[x %% todivide == 0L] 
    return(out) 
} 

Bây giờ chức năng chính:

findreps <- function(x, counter = NULL){ 
    if(is.null(counter)){ 
    counter <- c() 
    maxcounter <- 0 
    } else { 
    maxcounter <- max(counter) 
    } 
    holding <- lapply(1:length(x), function(y){x[1:y]}) 
    factors <- lapply(holding, factorise) 
    repeats <- sapply(1:length(factors), function(index) {any(sapply(1:length(factors[[index]]), function(zz) {all((rep(holding[[index]][1:(length(holding[[index]])/factors[[index]][zz])], factors[[index]][zz]))==holding[[index]])}))}) 
    holding <- holding[max(which(repeats))][[1]] 
    if(length(holding) == length(x)){ 
    return(c(counter, rep(maxcounter + 1, length(x)))) 
    } else { 
    counter <- c(counter, rep(maxcounter + 1, length(holding))) 
    return(findreps(x[(length(holding) + 1):length(x)], counter)) 
    } 
} 

Cách hoạt động: Đó là một hàm đệ quy mà chạy, cắt nhóm lặp lớn nhất nó có thể tìm thấy từ sự bắt đầu của vectơ, và sau đó chạy cho đến khi tất cả chúng biến mất.

Trước tiên, chúng tôi tạo một counter để có kết quả cuối cùng.

Tiếp theo, chúng tôi chia x thành mỗi tập hợp con bắt đầu từ 1 thành danh sách, holding.

Sau đó, chúng tôi tìm thấy tất cả các yếu tố về kích thước của một nhóm, ngoại trừ 1.

Sau đó, phần tồi tệ nhất. Chúng tôi lấy từng tập hợp con của tập hợp con lớn nhất và kiểm tra xem tập hợp con có bằng tập hợp con lớn nhất trong nhóm của nó sau khi được lặp lại số lần hợp lý hay không.

findreps(x) 
[1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 
[37] 3 3 3 3 3 4 5 6 7 7 7 7 7 7 7 7 7 

Nếu bạn muốn không lặp lại được nhóm, chúng ta có thể sử dụng một chút dplyrtidyr:

library(dplyr) 
library(tidyr) 

z <- data.frame(x = x, y = findreps(x)) 

z %>% mutate(y = ifelse(duplicated(y) | rev(duplicated(rev(y))), y, NA), 
      holding = c(0, y[2:n()])) %>% 
     fill(holding) %>% 
     mutate(y = ifelse(is.na(y), holding +1, y)) %>% 
     select(-holding) 

Mà cho:

[1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 4 4 4 7 7 7 7 7 7 7 7 
[53] 7 
+2

Điều này thực sự hoạt động, tốt đẹp. Tôi có thể giữ trên tờ séc để cung cấp cho người khác một cơ hội để trả lời. –

+0

Chắc chắn, vui vì nó hoạt động. – jeremycg

+2

@TylerRinker điều này quay trở lại các quy tắc được định nghĩa lỏng lẻo Frank nói ở trên, nhưng kiểm tra điều này với 'x <- c (rep (1: 4, 5), rep (5: 6, 3), rep (1: 4, 5), đại diện (5: 6, 3)) '. Tôi hy vọng bạn đang tìm kiếm tất cả '1' trong kết quả, nhưng đó không phải là kết quả chúng tôi nhận được. @jeremycg này sẽ rất tốt cho các trường hợp thử nghiệm, nhưng có một số trường hợp cạnh tôi nghĩ rằng điều này bỏ lỡ – Chris

3

Tôi gần như ở đó, nhưng tôi không làm việc cho toàn bộ 100% và đến muộn (zzz). Đầu tiên mã:

x <-c(rep(1:4, 5), rep(5:6, 3), rep(c(1, 4, 7), 5), rep(c(1, 5, 7), 1), rep(2:4, 3)) 

#The first break must be position 1 
Xbreaklist <- 1 

#We need a counter, a duplicate dataset 
counter <- 0 
xx <- x 

while (length(xx) > 0) { 
#first we extract a pattern by looking for the first repeated number 
Xpattern <- xx[1:(min(which(stri_duplicated(xx) == TRUE))-1)] 

#then we convert the vector and the pattern into a string 
XpatternS <- paste0(Xpattern, collapse="") 
xxS <- paste0(xx, collapse="") 

#then we extract all patterns and count them, multiply by length and add 1 
Xbreak <- 1 + (length(unlist(stri_extract_all_coll(xxS, XpatternS))) * length(Xpattern)) 

#break here if we reached the end 
if (Xbreak >= length(xx)) break 

# We add that to the list of breaks 
counter <- counter + Xbreak 
Xbreaklist <- c(Xbreaklist, counter) 

# then we remove the part of the list we're done with 
xx <- xx[(Xbreak):length(xx)] 
} 

Xbreaklist 
[1] 1 21 28 44 51 

Điều gì sai với nó? Hai điều:
1 Mẫu không lặp lại sẽ xuất hiện lần đầu tiên với mẫu sau: "121212 56 787878" được chia thành ("121212 5678 7878")
2 Mẫu lặp lại ("1212 5656 12 134") mess điều lên vì stri_extract_all_coll đưa họ tất cả ra ngoài và do đó chiều dài là dài.

+0

Vì vậy, đóng :-) hy vọng ai đó có thể tiến lên phía trước. –

2

Đây là câu trả lời một phần nhưng nghĩ rằng nó tốt hơn so với đăng trong nhận xét. Nó có thể khiến người khác tìm cách để làm điều này.

Ý tưởng của tôi là chia véc-tơ thành các phần bằng nhau của kích thước N. Sau đó, để kiểm tra xem đoạn kế tiếp có phải là bản sao của đoạn trước đó không. Tôi đã làm điều này một cách quá dài - tôi chắc chắn phải có một cách dễ dàng hơn để làm điều đó.

Dường như hoạt động ổn định và có thể tạo cơ sở cho một cách khác để thực hiện việc này. Nhược điểm là nó không thể nhận các lặp lại chỉ xảy ra một lần, ví dụ: "157".

xx <- split(x, ceiling(seq_along(x)/N)) #split vector into equal chunks of size N 
xx <- xx[-(length(xx))] #get rid of uneven splitting of last vector 

df <- do.call('rbind', xx) #bind together in a dataframe 

results<-NULL #loop to test if row is same as previous row (must be better way to do this) 
for(i in 2:nrow(df)-1) {results[[i]] <- df[i,]==df[i+1,] } 

results1 <- unlist(lapply(results, sum)) #count TRUEs in each result 
results1[results1<N]<-0 #make all not equal to size of chunk (N) equal to zero 

indices <- which(diff(results1)==-N)+1 #this is the first non-repeating group of N 
indicesall <- (indices*N)+1 #to find location of next non-repeating id 
Các vấn đề liên quan