找到包含在两个 `n2` FALSE 之间的 `n1` TRUE,整个东西都包含在 `n3` TRUE 之间,等等

Finding `n1` TRUEs wrapped in between two `n2` FALSEs, the whole thing wrapped in between `n3` TRUEs, etc

从一系列 TRUEs 和 falses 中,我想创建一个 returns TRUE 序列中某处至少有一系列 n1 TRUEs 的函数。这是该函数:

fun_1 = function(TFvec, n1){
    nbT = 0
    solution = -1
    for (i in 1:length(x)){
            if (x[i]){
            nbT = nbT + 1
               if (nbT == n1){
                return(T)
                break
               }
            } else {
                nbT = 0
            }
        }
        return (F) 
}

测试:

x = c(T,F,T,T,F,F,T,T,T,F,F,T,F,F)
fun_1(x,3) # TRUE
fun_1(x,4) # FALSE

然后,我需要一个函数 returns TRUE 如果在给定的列表布尔向量中,有一系列至少 n1 TRUE 被至少两个系列包裹(每边一个) ) n2 个错误。这里的函数:

fun_2 = function(TFvec, n1, n2){
    if (n2 == 0){
        fun_1(TFvec, n2)        
    }
    nbFB = 0
    nbFA = 0
    nbT = 0
    solution = -1
    last = F
    for (i in 1:length(TFvec)){
        if(TFvec[i]){           
            nbT = nbT + 1
            if (nbT == n1 & nbFB >= n2){
                solution = i-n1+1
            }
            last = T
        } else {
            if (last){
                nbFB = 0
                nbFA = 0        
            }
            nbFB = nbFB + 1
            nbFA = nbFA + 1
            nbT = 0
            if (nbFA == n2 & solution!=-1){
                return(T)
            }
            last = F
        }
    }
    return(F)
}

虽然这可能不是一个非常有效的功能!我还没有测试 100 次,但看起来它工作正常!

测试:

x = c(T,F,T,T,F,F,T,T,T,F,F,T,F,F)
fun_2(x, 3, 2) # TRUE
fun_2(x, 3, 3) # FALSE

现在,不管你信不信,我想创建一个函数 (fun_3) returns TRUE 如果在布尔向量中有一个(至少)系列至少n1 TRUE 包裹在(至少)两个(每边一个)系列之间 n2 false,其中整个事物(三个系列)包裹在(至少)两个(每边一个)之间side) 一系列 n3 TRUE。由于我担心不得不进一步解决这个问题,我在这里寻求帮助以创建一个函数 fun_n,我们在其中输入两个参数 TFveclist_n,其中 list_n 是任意长度的 n 列表。

你能帮我创建函数fun_n吗?

创建一个模板,tpl 0 和 1,将其转换为正则表达式模式 pat。将 x 转换为零和一的单个字符串,并使用 greplpat 与其匹配。没有使用包。

fun_n <- function(x, lens) {
  n <- length(lens)
  reps <- c(rev(lens), lens[-1])
  TF <- if (n == 1) 1 else if (n %% 2) 1:0 else 0:1
  tpl <- paste0(rep(TF, length = n), "{", reps, ",}")
  pat <- paste(tpl, collapse = "")
  grepl(pat, paste(x + 0, collapse = ""))
}

# test
x <- c(F, T, T, F, F, T, T, T, F, F, T, T, T, F)
fun_n(x, 3:1)
## TRUE
fun_n(x, 1:3)
## FALSE
fun_n(x, 100)
## FALSE
fun_n(x, 3)
## TRUE
fun_n(c(F, T, F), c(1, 1))
## [1] TRUE
fun_n(c(F, T, T, F), c(1, 1)) 
## [1] TRUE

运行 时间不如下面示例中的 runfun 快,但仍然相当快 运行 在我的笔记本电脑上显示的示例的 10,000 个实例仅需 2 秒多一点。而且代码长度相对较短且无循环。

> library(rbenchmark)
> benchmark(runfun(x, 1:3), fun_n(x, 1:3), replications = 10000)[1:4]

            test replications elapsed relative
2  fun_n(x, 1:3)        10000    2.29    1.205
1 runfun(x, 1:3)        10000    1.90    1.000

为了方便,记录一下阈值的长度

n = length(list_n)

将TRUE和FALSE的向量表示为运行长度的编码,为了方便记住每个运行的长度

r = rle(TFvec); l = r$length

寻找可能的起始位置

idx = which(l >= list_n[1] & r$value)

确保起始位置的嵌入足以满足所有测试

idx = idx[idx > n - 1 & idx + n - 1 <= length(l)]

然后检查连续远程运行的长度是否符合条件,只保留那些

的起点
for (i in seq_len(n - 1)) {
    if (length(idx) == 0)
        break     # no solution
    thresh = list_n[i + 1]
    test = (l[idx + i] >= thresh) & (l[idx - i] >= thresh)
    idx = idx[test]
}

如果idx中还有剩余值,则这些是满足条件的rle的索引;初始向量中的起点是 cumsum(l)[idx - 1] + 1.

合并:

runfun = function(TFvec, list_n) {
    ## setup
    n = length(list_n)
    r = rle(TFvec); l = r$length

    ## initial condition
    idx = which(l >= list_n[1] & r$value)
    idx = idx[idx > n - 1 & idx + n - 1 <= length(l)]

    ## adjacent conditions
    for (i in seq_len(n - 1)) {
        if (length(idx) == 0)
            break     # no solution
        thresh = list_n[i + 1]
        test = (l[idx + i] >= thresh) & (l[idx - i] >= thresh)
        idx = idx[test]
    }

    ## starts = cumsum(l)[idx - 1] + 1
    ## any luck?
    length(idx) != 0
}

这很快并且允许 运行s >= 问题中规定的阈值;例如

x = sample(c(TRUE, FALSE), 1000000, TRUE)
system.time(runfun(x, rep(2, 5)))

不到 1/5 秒即可完成。

一个有趣的概括允许灵活的条件,例如 运行s 恰好 list_n,如 rollapply 解决方案

runfun = function(TFvec, list_n, cond=`>=`) {
    ## setup
    n = length(list_n)
    r = rle(TFvec); l = r$length

    ## initial condition
    idx = which(cond(l, list_n[1]) & r$value)
    idx = idx[idx > n - 1 & idx + n - 1 <= length(l)]

    ## adjacent conditions
    for (i in seq_len(n - 1)) {
        if (length(idx) == 0)
            break     # no solution
        thresh = list_n[i + 1]
        test = cond(l[idx + i], thresh) & cond(l[idx - i], thresh)
        idx = idx[test]
    }

    ## starts = cumsum(l)[idx - 1] + 1
    ## any luck?
    length(idx) != 0
}