查找并重复运行

Tyl*_*ker 18 r

我有一个带有重复模式的向量.我想打破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
Run Code Online (Sandbox Code Playgroud)

我希望能够找到模式更改的那些地方,所以它会像这样断开:

在此输入图像描述

我认为rle可能有用,但不知道如何.

jer*_*ycg 14

这是一个功能.顺便说一下,这是遗传学中的一个问题 - 找到串联重复序列.这是一个算法论文的链接,这是一个比这更好的处理,但实现起来要复杂得多.

输出是用于将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)
}
Run Code Online (Sandbox Code Playgroud)

现在主要功能:

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))
  }
}
Run Code Online (Sandbox Code Playgroud)

它是如何工作的:它是一个运行的递归函数,切断了它可以从向量的开始找到的最大重复组,然后运行直到它们全部消失.

首先,我们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
Run Code Online (Sandbox Code Playgroud)

如果你想不重复进行分组,我们可以用一个小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)
Run Code Online (Sandbox Code Playgroud)

这使:

 [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
Run Code Online (Sandbox Code Playgroud)

  • 这确实有效,很好.我可以推迟检查,让其他人有机会回应. (2认同)
  • @TylerRinker这可以追溯到弗兰克上面提到的松散定义的规则,但用`x < - c(rep(1:4,5),rep(5:6,3),rep(1:4,5)测试),代表(5:6,3))`.我希望你在寻找结果中的所有'1',但这不是我们得到的结果.@jeremycg这对于测试用例看起来很棒,但是我认为这有很多边缘情况 (2认同)