R:将向量分割为具有重叠和反弹的子向量

c9x0cxw0  于 2023-05-04  发布在  其他
关注(0)|答案(2)|浏览(197)

bounty还有5天到期。回答此问题可获得+50声望奖励。Daniel James想要引起更多关注这个问题:我需要的解决方案,可以采取时间序列作为输入或向量,而不是由这个唯一的答案提供的时间序列作为键入这个的时间。

我想将一个名为ts的父向量分割成几个满足以下条件的子向量:

为清楚起见编辑

1.每个子向量具有相等的长度l,其小于父向量v的数量。
1.每个子向量在其元素的组成方面是唯一的,并且包含连续的元素。
1.特定子向量的元素与先前和后续子向量的元素重叠。
1.每个元素在整个拆分过程中出现l - 1时间。
1.一些块元素可以以这样的方式反弹,即父向量的开始到结束的元素形成子向量。
1.输入应该是父向量v的向量,以及块长度l的整数。而输出应该是向量的列表(不是矩阵),使得每个子向量作为向量输出,并且所有子向量的列表是列表。
为了说明,考虑父向量110,子向量大小为3,其父向量的连续元素如下:

1, 2, 3
2, 3, 4
4, 5, 6
5, 6, 7
7, 8, 9
8, 9, 10
10, 1, 2

我所做的是用这个R代码形成一个length(ts)子向量(也就是说,子向量的数量等于父向量的数量):

v <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
l <- 3

purrr::map(
  v, 
 seq, length.out = l
) |> 
  purrr::map(\(x) ifelse(x > max(v), x - max(v), x))

产生了这个

1, 2, 3
2, 3, 4
3, 4, 5
4, 5, 6
5, 6, 7
6, 7, 8
7, 8, 9
8, 9, 10
9, 10, 1
10, 1, 2

然后手动删除一些破坏my rule3的子向量

3, 4, 5
6, 7, 8
9, 10, 1

我需要什么

我需要一个R代码,它可以提供我想要的输出

1, 2, 3
2, 3, 4
4, 5, 6
5, 6, 7
7, 8, 9
8, 9, 10
10, 1, 2

无需人工干预。

wztqucjr

wztqucjr1#

我们假设反弹意味着min(myVec)可以紧跟着max(myVec),并且它仍然被视为“连续”。我们假设连续意味着除了反弹之外,值增加1。
使用embed创建以子向量为行的tab矩阵,并创建一个consec矩阵,该矩阵的列是长度为subLen的有效“连续”子向量(考虑到反弹)。
然后遍历tab的行,如果该行不是consec中的列,或者其中的任何元素都将导致subLen出现多次,则将ok设置为FALSE。最后由它得到子集tab
在问题中,0不是myVec的元素,我们假设这通常是真的,因此我们可以将不满足条件的行清零。如果这不是真的,一般来说,我们可以NA出这些行,但使用0会导致更短的代码。

myVec <- 1:10
subLen <- 3

Embed <- function(vec, n) embed(vec, n)[, n:1]

tab <- head(Embed(c(myVec, myVec), subLen), length(myVec))
consec <- t(Embed(rep(seq(min(myVec), max(myVec)), 2), subLen))

ok <- rep(TRUE, length(myVec))
for(i in 1:nrow(tab)) {
  ok[i] <- any(colSums(consec != tab[i, ]) == 0) &&
    max(table(tab[1:i, ] * ok[1:i])[as.character(tab[i, ])]) < subLen
}
tab[ok, ]

给予

tab[ok, ]
##      [,1] [,2] [,3]
## [1,]    1    2    3
## [2,]    2    3    4
## [3,]    4    5    6
## [4,]    5    6    7
## [5,]    7    8    9
## [6,]    8    9   10
1tu0hz3e

1tu0hz3e2#

我猜你可以试试下面的代码

# split vector into subvectors following all rules
f <- function(ts, l) {
  m <- seq_along(ts)
  embed(c(ts, head(ts, l - 1)), l)[m %% l > 0 & m <= length(ts) %/% l * l, l:1]
}

# check the validity (the max occurrence is less than `l` 
isvalid <- function(v, l) max(table(f(v, l))) < l

我们可以做一些测试

set.seed(0)
v <- runif(10)
l <- 3:(length(v) - 1)
lapply(l, \(k) list(subvec = f(v, k), check = isvalid(v, k)))

它给出了

[[1]]
[[1]]$subvec
          [,1]      [,2]      [,3]
[1,] 0.8966972 0.2655087 0.3721239
[2,] 0.2655087 0.3721239 0.5728534
[3,] 0.5728534 0.9082078 0.2016819
[4,] 0.9082078 0.2016819 0.8983897
[5,] 0.8983897 0.9446753 0.6607978
[6,] 0.9446753 0.6607978 0.6291140

[[1]]$check
[1] TRUE

[[2]]
[[2]]$subvec
          [,1]      [,2]      [,3]      [,4]
[1,] 0.8966972 0.2655087 0.3721239 0.5728534
[2,] 0.2655087 0.3721239 0.5728534 0.9082078
[3,] 0.3721239 0.5728534 0.9082078 0.2016819
[4,] 0.9082078 0.2016819 0.8983897 0.9446753
[5,] 0.2016819 0.8983897 0.9446753 0.6607978
[6,] 0.8983897 0.9446753 0.6607978 0.6291140

[[2]]$check
[1] TRUE

[[3]]
[[3]]$subvec
          [,1]      [,2]      [,3]      [,4]      [,5]
[1,] 0.8966972 0.2655087 0.3721239 0.5728534 0.9082078
[2,] 0.2655087 0.3721239 0.5728534 0.9082078 0.2016819
[3,] 0.3721239 0.5728534 0.9082078 0.2016819 0.8983897
[4,] 0.5728534 0.9082078 0.2016819 0.8983897 0.9446753
[5,] 0.2016819 0.8983897 0.9446753 0.6607978 0.6291140
[6,] 0.8983897 0.9446753 0.6607978 0.6291140 0.8966972
[7,] 0.9446753 0.6607978 0.6291140 0.8966972 0.2655087
[8,] 0.6607978 0.6291140 0.8966972 0.2655087 0.3721239

[[3]]$check
[1] TRUE

[[4]]
[[4]]$subvec
          [,1]      [,2]      [,3]      [,4]      [,5]      [,6]
[1,] 0.8966972 0.2655087 0.3721239 0.5728534 0.9082078 0.2016819
[2,] 0.2655087 0.3721239 0.5728534 0.9082078 0.2016819 0.8983897
[3,] 0.3721239 0.5728534 0.9082078 0.2016819 0.8983897 0.9446753
[4,] 0.5728534 0.9082078 0.2016819 0.8983897 0.9446753 0.6607978
[5,] 0.9082078 0.2016819 0.8983897 0.9446753 0.6607978 0.6291140

[[4]]$check
[1] TRUE

[[5]]
[[5]]$subvec
          [,1]      [,2]      [,3]      [,4]      [,5]      [,6]      [,7]
[1,] 0.8966972 0.2655087 0.3721239 0.5728534 0.9082078 0.2016819 0.8983897
[2,] 0.2655087 0.3721239 0.5728534 0.9082078 0.2016819 0.8983897 0.9446753
[3,] 0.3721239 0.5728534 0.9082078 0.2016819 0.8983897 0.9446753 0.6607978
[4,] 0.5728534 0.9082078 0.2016819 0.8983897 0.9446753 0.6607978 0.6291140
[5,] 0.9082078 0.2016819 0.8983897 0.9446753 0.6607978 0.6291140 0.8966972
[6,] 0.2016819 0.8983897 0.9446753 0.6607978 0.6291140 0.8966972 0.2655087

[[5]]$check
[1] TRUE

[[6]]
[[6]]$subvec
          [,1]      [,2]      [,3]      [,4]      [,5]      [,6]      [,7]
[1,] 0.8966972 0.2655087 0.3721239 0.5728534 0.9082078 0.2016819 0.8983897
[2,] 0.2655087 0.3721239 0.5728534 0.9082078 0.2016819 0.8983897 0.9446753
[3,] 0.3721239 0.5728534 0.9082078 0.2016819 0.8983897 0.9446753 0.6607978
[4,] 0.5728534 0.9082078 0.2016819 0.8983897 0.9446753 0.6607978 0.6291140
[5,] 0.9082078 0.2016819 0.8983897 0.9446753 0.6607978 0.6291140 0.8966972
[6,] 0.2016819 0.8983897 0.9446753 0.6607978 0.6291140 0.8966972 0.2655087
[7,] 0.8983897 0.9446753 0.6607978 0.6291140 0.8966972 0.2655087 0.3721239
          [,8]
[1,] 0.9446753
[2,] 0.6607978
[3,] 0.6291140
[4,] 0.8966972
[5,] 0.2655087
[6,] 0.3721239
[7,] 0.5728534

[[6]]$check
[1] TRUE

[[7]]
[[7]]$subvec
          [,1]      [,2]      [,3]      [,4]      [,5]      [,6]      [,7]
[1,] 0.8966972 0.2655087 0.3721239 0.5728534 0.9082078 0.2016819 0.8983897
[2,] 0.2655087 0.3721239 0.5728534 0.9082078 0.2016819 0.8983897 0.9446753
[3,] 0.3721239 0.5728534 0.9082078 0.2016819 0.8983897 0.9446753 0.6607978
[4,] 0.5728534 0.9082078 0.2016819 0.8983897 0.9446753 0.6607978 0.6291140
[5,] 0.9082078 0.2016819 0.8983897 0.9446753 0.6607978 0.6291140 0.8966972
[6,] 0.2016819 0.8983897 0.9446753 0.6607978 0.6291140 0.8966972 0.2655087
[7,] 0.8983897 0.9446753 0.6607978 0.6291140 0.8966972 0.2655087 0.3721239
[8,] 0.9446753 0.6607978 0.6291140 0.8966972 0.2655087 0.3721239 0.5728534
          [,8]      [,9]
[1,] 0.9446753 0.6607978
[2,] 0.6607978 0.6291140
[3,] 0.6291140 0.8966972
[4,] 0.8966972 0.2655087
[5,] 0.2655087 0.3721239
[6,] 0.3721239 0.5728534
[7,] 0.5728534 0.9082078
[8,] 0.9082078 0.2016819

[[7]]$check
[1] TRUE

相关问题