将向量拆分为具有恒定长度和恒定重叠的子向量答案

【问题标题】：Split a vector into sub vectors with constant length and constant overlap将向量拆分为具有恒定长度和恒定重叠的子向量
【发布时间】：2021-07-06 11:58:56
【问题描述】：

我想将一个向量拆分为一组子向量，以使这些条件成立：

所有子向量必须具有恒定长度
所有子向量必须以恒定的重叠长度重叠

我需要对此进行修改：

########Block function######################
blocks <- function(len, ov, n) {

  starts <- unique(sort(c(seq(1, n, len), seq(len-ov+1, n, len))))
  ends <- pmin(starts + len - 1, n)

  # truncate starts and ends to the first num elements
  num <- match(n, ends)
  head(data.frame(starts, ends), num)
}

########Moving block#############
vec = 1:17 # a list or vector
len = 8 # the length of the subvector 
ov = ceiling(len/2) # the length of overlap
b <- blocks(len, ov, length(vec))
with(b, Map(function(i, j) vec[i:j], starts, ends))

产生这个：

[1] 1 2 3 4 5 6 7 8 # 子向量1

[2] 5 6 7 8 9 10 11 12 # 子向量2

[3] 9 10 11 12 13 14 15 16 # 子向量3

[4] 13 14 15 16 17 # 子向量4：重叠需要修改以达到恒定长度

我想要什么

我希望最后一个未达到指定长度的子向量有这样的重叠：

new_overlap = old_overlap + (old_length - new_length)

new_overlap 是其长度小于设定长度的最后一个子向量的重叠长度。
old_overlap 是设定的重叠长度
old_length 是子向量的设定长度

[1] 1 2 3 4 5 6 7 8 # 我想要的子向量1

[2] 5 6 7 8 9 10 11 12 # 我想要的子向量2

[3] 9 10 11 12 13 14 15 16 # 我想要的子向量3

[4] 10 11 12 13 14 15 16 17 # 我想要的子向量4

我希望按照以下条件拆分列表：

它应该具有相同的子列表长度。
它应该与一个常数重叠

尝试的解决方案有错误消息但结果很好

blocks <- function(len, ov, n) {

  starts <- unique(sort(c(seq(1, n, len), seq(len-ov+1, n, len))))
  ends <- pmin(starts + len - 1, n)

  # truncate starts and ends to the first num elements
  num <- match(n, ends)
  head(data.frame(starts, ends), num)
}

########Moving block#############
vec = 1:10 # vector
len = 5 #set length
ov = 1#ceiling(len/2) # set overlap
b <- blocks(len, ov, length(vec))
#with(b, Map(function(i, j) vec[i:j], starts, ends))

out <- with(b, Map(function(i, j) vec[i:j], starts, ends))
last_1en <- length(out)
if(length(out[l1]) < len) { # if last length is less than set length
  out[[l1]] <- unlist(out[(ov) + (len - l1)])
}
out

out[[l1]] 错误：下标越界

[[1]] [1] 1 2 3 4 5

[[2]] [1] 5 6 7 8 9

[[3]] [1] 6 7 8 9 10

二次编辑

我已通过将out[[l1]] 更改为out[l1] 来调试错误。

【问题讨论】：

您可以将b修改为b$starts[nrow(b)] <- b$ends[nrow(b)] - len + 1
要求的结果不满足您陈述的条件。
@norie 你能帮我指出来吗？
最后一个子向量的重叠是7，不是4。
也可以尝试将函数第一行blocks改为starts <- pmin(n-len+1, unique(sort(c(seq(1, n, len), seq(len-ov+1, n, len)))))

标签： r split

【解决方案1】：

一个 tidyverse 策略，我认为应该适用于所有类型的输入向量

vec = 1:23
len = 7
ov = 6

library(tidyverse)
anil <- function(vec, len, ov){
  seq_len((length(vec) - ov) %/% (len - ov) +1) %>%
  as.data.frame() %>%
  setNames('id') %>%
  mutate(start = accumulate(id, ~ .x + len - ov),
         end = pmin(start + len - 1, length(vec)),
         start = pmin(start, end - len + 1)) %>%
  filter(!duplicated(paste(start, end, sep = '-'))) %>%
  transmute(desired = map2(start, end, ~ vec[.x:.y])) %>%
  as.list
}

anil(1:23, len = 7, ov = 6)
#> $desired
#> $desired[[1]]
#> [1] 1 2 3 4 5 6 7
#> 
#> $desired[[2]]
#> [1] 2 3 4 5 6 7 8
#> 
#> $desired[[3]]
#> [1] 3 4 5 6 7 8 9
#> 
#> $desired[[4]]
#> [1]  4  5  6  7  8  9 10
#> 
#> $desired[[5]]
#> [1]  5  6  7  8  9 10 11
#> 
#> $desired[[6]]
#> [1]  6  7  8  9 10 11 12
#> 
#> $desired[[7]]
#> [1]  7  8  9 10 11 12 13
#> 
#> $desired[[8]]
#> [1]  8  9 10 11 12 13 14
#> 
#> $desired[[9]]
#> [1]  9 10 11 12 13 14 15
#> 
#> $desired[[10]]
#> [1] 10 11 12 13 14 15 16
#> 
#> $desired[[11]]
#> [1] 11 12 13 14 15 16 17
#> 
#> $desired[[12]]
#> [1] 12 13 14 15 16 17 18
#> 
#> $desired[[13]]
#> [1] 13 14 15 16 17 18 19
#> 
#> $desired[[14]]
#> [1] 14 15 16 17 18 19 20
#> 
#> $desired[[15]]
#> [1] 15 16 17 18 19 20 21
#> 
#> $desired[[16]]
#> [1] 16 17 18 19 20 21 22
#> 
#> $desired[[17]]
#> [1] 17 18 19 20 21 22 23

anil(LETTERS[1:21], 7, 2)
#> $desired
#> $desired[[1]]
#> [1] "A" "B" "C" "D" "E" "F" "G"
#> 
#> $desired[[2]]
#> [1] "F" "G" "H" "I" "J" "K" "L"
#> 
#> $desired[[3]]
#> [1] "K" "L" "M" "N" "O" "P" "Q"
#> 
#> $desired[[4]]
#> [1] "O" "P" "Q" "R" "S" "T" "U"

anil(1:17, 8, 4)
#> $desired
#> $desired[[1]]
#> [1] 1 2 3 4 5 6 7 8
#> 
#> $desired[[2]]
#> [1]  5  6  7  8  9 10 11 12
#> 
#> $desired[[3]]
#> [1]  9 10 11 12 13 14 15 16
#> 
#> $desired[[4]]
#> [1] 10 11 12 13 14 15 16 17

^{由reprex package (v2.0.0) 于 2021-07-07 创建}

【讨论】：

在ov = 3:7的范围内工作，也就是说，相当不错。
@Chris，为什么呢？我没有限制ov范围？请查看我编辑的答案
@Daniel-James 不承诺重叠为 1/2 长度，只是保持不变，至少按照编辑前的建议，但我的谨慎只是为了将来的复制/粘贴。至于字母，见ov =1。
@Chris，也许我无法正确理解您。我认为 OP 提供了三个输入，ov、len 和一个 vec，他想要一个具有 2 个条件的输出列表。我完全理解这一点是不正确的吗？
@27ϕ9，感谢您指出。它在 len-ov = 1 时提供重复。不过，我使用了一个额外的步骤，也没有创建函数 anil，恕我直言，它在所有条件下都运行良好。

【解决方案2】：

这是修改blocks 函数以实现所需输出的另一种方法。以下是关于我如何编写此函数的更多详细信息：

为此，我使用了一个名为函数工厂的结构，它实际上是一个创建另一个函数的函数
如果你注意我把 len 参数放在最外层的函数中，因为我需要首先设置我的 out 向量，而不是全局环境
在定义 len 参数时第一次调用 blocks 后，我们将进入第二个函数，我们指定 vec 和 ov 参数
在最里面的函数中，我使用 recursion 让函数本身在更长的向量中完成重复操作
关于递归的更多信息，它是一种编程技术，其中一个函数从其执行环境内部调用自身 & 如果你注意到每次我在每个操作结束时修改 vec 和新的 vec将是在同一 ov 上运行的下一个 blocks 函数的输入
所以如果我们打电话给blocks 就像blocks(len)(vec, ov)
最后，我使用了Original_vector 来获取你想要的输出我知道这种方法可能有点复杂，但我认为您可以像其他解决方案一样将其用于您的目的。

# First I create a copy of our vector
Original_vector <- vec

# Then I rewrite `blocks` function in order to get the required indices
blocks <- function(len) {
  out <- c(1, len)
  
  fn <- function(vec, ov) {

    if(length(vec[-c(min(out):max(out))]) > ov) {
      out <<- c(out, c(out[length(out)] - (ov - 1), out[length(out)] + (len - ov)))
    } else {
      out <<- c(out, c(vec[length(vec)] - (len - 1), vec[length(vec)]))
      return(out)
    }
    out
    vec <<- vec[-c(min(out):max(out))]
    
    fn(vec, ov)
  }
  
}

result <- blocks(8)(1:17, 4)
> result
[1]  1  8  5 12  9 16 10 17

然后我使用获取的索引来子集我想要的输出

m <- as.data.frame(matrix(result, ncol = 2, byrow = TRUE))
mapply(function(x, y) Original_vector[x:y], m$V1, m$V2, SIMPLIFY = FALSE)

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

[[2]]
[1]  5  6  7  8  9 10 11 12

[[3]]
[1]  9 10 11 12 13 14 15 16

[[4]]
[1] 10 11 12 13 14 15 16 17

【讨论】：

【解决方案3】：

这将给出预期的结果，但它非常复杂，所以我很确定会有更好的解决方案。

########Block function######################
blocks <- function(len, ov, n) {

  starts <- seq(1, n,len-ov)
  ends <- pmin(starts + len - 1, n)
  

  if(ends[length(starts)-1]-starts[length(starts)-1]+1 < len){
    ends[length(starts)-1] = n
    starts[length(starts)-1] = ends[length(starts)-1]-len+1
  }
  
  # truncate starts and ends to the first num elements
  num <- match(n, ends)
  head(data.frame(starts, ends), num)
}

########Moving block#############
vec = 1:17 # a list or vector
len = 8 # the length of the sublist or subvector 
ov = ceiling(len/2) # the length of overlap
b <- blocks(len, ov, length(vec))
b
with(b, Map(function(i, j) vec[i:j], starts, ends))

【讨论】：

【解决方案4】：

为什么不做一些更微妙的事情？

len <- 8
ov <- ceiling(len / 2)

Map(`+`, list(1:len), as.list(c((ov*0:(ov - 1))[-ov], 17 - len)))
# [[1]]
# [1] 1 2 3 4 5 6 7 8
# 
# [[2]]
# [1]  5  6  7  8  9 10 11 12
# 
# [[3]]
# [1]  9 10 11 12 13 14 15 16
# 
# [[4]]
# [1] 10 11 12 13 14 15 16 17

【讨论】：

@AnilGoyal 示例不表示这种情况。
这个的用处在于时间序列数据，不一定是整数。我使用 1,2,3,... 只是为了监控结果的性能。

【解决方案5】：

这是一种相对简单的方法来计算结束和开始索引，然后迭代结果以提取子向量：

blocks <- function(vec, len, ov) {
  end <- unique(c(seq(len, length(vec), len - ov), length(vec)))
  start <- end - len + 1
  Map(\(s, e) vec[s:e], start, end)
}

blocks(vec, len, ov)

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

[[2]]
[1]  5  6  7  8  9 10 11 12

[[3]]
[1]  9 10 11 12 13 14 15 16

[[4]]
[1] 10 11 12 13 14 15 16 17

【讨论】：