У меня есть вектор с повторяющимися узорами внутри него. Я хочу разбить любой, где меняется повторяющийся шаблон n длины. Здесь данные:
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
Я хочу, чтобы найти те места, которые изменяет шаблон, чтобы он разбился следующим образом:
Я думаю, что rle может быть полезным, но не видит, как.
Здесь функция для этого. Кстати, это проблема генетики - поиск тандемных повторов. Здесь ссылка на документ алгоритма, который намного лучше, чем этот, но гораздо сложнее реализовать.
Вывод представляет собой вектор групп для разбиения x на.
Сначала вспомогательная функция:
factorise <- function(x) {
x <- length(x)
if(x == 1){return(1)}
todivide <- seq(from = 2, to = x)
out <- todivide[x %% todivide == 0L]
return(out)
}
Теперь основная функция:
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))
}
}
Как это работает: Это рекурсивная функция, которая работает, отсекает самую большую группу повторов, которую она может найти с начала вектора, а затем запускается до тех пор, пока все не исчезнет.
Сначала мы делаем counter для окончательного вывода.
Затем разделим x на каждое подмножество, начиная с 1 в список, holding.
Затем мы найдем все факторы размера группы, кроме 1.
Тогда это худшая часть. Мы берем каждое подмножество самого большого подмножества и проверяем, равно ли оно наибольшему подмножеству в своей группе после повторения разумного количества раз.
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
Если вы хотите группировать не-повторы, мы можем использовать немного dplyr и tidyr:
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)
Что дает:
[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
Я почти там, но я не работаю на 100%, и уже поздно (zzz). Сначала код:
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
Что в этом плохого? Две вещи:
1 Шаблон, который не повторяется, принимает первое вхождение следующего шаблона с ним: "121212 56 787878" получает разделение как ( "121212 5678 7878" )
2 Повторяющиеся паттерны ( "1212 5656 12 134" ) беспорядочны, потому что stri_extract_all_coll выводит их все и, следовательно, длина длинна.
Это частичный ответ, но он подумал, что это лучше, чем публикация в комментарии. Это может заставить других найти способ сделать это.
Моя идея состояла в том, чтобы разбить вектор на равные части размера N. Затем проверить, является ли последовательный фрагмент дубликатом предыдущего фрагмента. Я сделал это, вероятно, слишком долго - я уверен, что должен быть более простой способ сделать это.
Кажется, что он работает нормально и может стать основой для другого способа обойти это. Недостатком является то, что он не может получить повторы, которые появляются только один раз, например. "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