在R中创建具有正数和负数的序列

Question

我一直在尝试为以下系列的序列创建一个函数：

1，-2，-3,4,5,6，-7，-8，-9，-10 ........ n（1个正数，2个负数，3个正数，4个负数......然后继续直至n）。

创建一个非负序列很容易，但这些负面的术语正在测试我。

如果有人可以帮助我

Answer 1

这是一种方法。

myfun <- function(n) {
  myvec <- integer(n)
  for (i in seq_len(n)) {
    curtri <- ceiling(sqrt(i*2 + 0.25) - 0.5)
    myvec[i] <- i * (-1)^(curtri + 1)
  }
  return(myvec)
}

myfun(10)
 [1]   1  -2  -3   4   5   6  -7  -8  -9 -10

它利用了这样一个事实，即你可以找到sqrt(i*2 + 0.25) - 0.5三角形数字。 通过对非三角数应用偶数，我们可以确定下一个三角数的索引，并将其用作-1的指数。

不过，可能有更好的方法。

Answer 2

有很多方法可以做到这一点！

例如：

n <- 30
a <- 1:n
m <- ceiling(uniroot(function(x, N) x*(x+1)/2 - N, N=n, interval=c(0, n))$root)
b <- 2*( ((rep(1:m,1:m))[1:n] %% 2 == 1) - 0.5)
a*b

Answer 3

n <- 20
k <- n
m <- do.call(cbind, rep(list(c((-1)^(seq_len(k)+1))),k))
m[upper.tri(m)] <- 0
sign <- t(m)[t(m) != 0]

seq_len(n) * sign[seq_len(n)]
#[1]   1  -2  -3   4   5   6  -7  -8  -9 -10  11  12  13  14  15 -16 -17 -18 -19 -20

k的值非常高，但是我太累了，无法进行数学运算并找到下限。 我把它留给你。

Answer 4

对于易于理解的循环解决方案：

myfn = function(n){
    nn = 1:n
    x=1; i=0; j=1;
    while(TRUE){
        if(x==-1) for(k in j:(j+i)) { nn[k] = x*nn[k]; }
        x = x*(-1)
        i = i+1
        j = j+i
        if(j>n) break
    }
    nn[1:n]
}

> for(i in 1:20) print(myfn(i))
[1] 1
[1]  1 -2
[1]  1 -2 -3
[1]  1 -2 -3  4
[1]  1 -2 -3  4  5
[1]  1 -2 -3  4  5  6
[1]  1 -2 -3  4  5  6 -7
[1]  1 -2 -3  4  5  6 -7 -8
[1]  1 -2 -3  4  5  6 -7 -8 -9
 [1]   1  -2  -3   4   5   6  -7  -8  -9 -10
 [1]   1  -2  -3   4   5   6  -7  -8  -9 -10  11
 [1]   1  -2  -3   4   5   6  -7  -8  -9 -10  11  12
 [1]   1  -2  -3   4   5   6  -7  -8  -9 -10  11  12  13
 [1]   1  -2  -3   4   5   6  -7  -8  -9 -10  11  12  13  14
 [1]   1  -2  -3   4   5   6  -7  -8  -9 -10  11  12  13  14  15
 [1]   1  -2  -3   4   5   6  -7  -8  -9 -10  11  12  13  14  15 -16
 [1]   1  -2  -3   4   5   6  -7  -8  -9 -10  11  12  13  14  15 -16 -17
 [1]   1  -2  -3   4   5   6  -7  -8  -9 -10  11  12  13  14  15 -16 -17 -18
 [1]   1  -2  -3   4   5   6  -7  -8  -9 -10  11  12  13  14  15 -16 -17 -18 -19
 [1]   1  -2  -3   4   5   6  -7  -8  -9 -10  11  12  13  14  15 -16 -17 -18 -19 -20

Answer 5

虽然也许不是最优雅但我相信这会提供你想要的东西。

pos_neg_seq <- function(n){
  s= seq((n*(n+1)/2))

  loc <-1
  for(i in 1:n){
    if(i %% 2 == 0){
      s[loc:(loc+i-1)] <- sapply(s[loc:(loc+i-1)], FUN = function(x) -x)
    }
    loc <- loc + i
  }
  return(s)
}

pos_neg_seq(4)
[1]   1  -2  -3   4   5   6  -7  -8  -9 -10

使用Vincent提供的等式的特定长度向量的另一种可能方式。

pos_neg_seq <- function(n){
  nn <- seq(n)
  m = ceiling(uniroot(function(x, N) x*(x+1)/2 - N, N=n, interval=c(0, n))$root)

  vec <- 1
  for(i in 2:m){
    vec <- append(vec, ifelse(rep(i%%2==0, i), rep(-1, i), rep(1, i)))
  }

  return(nn*vec[1:n])
}

pos_neg_seq(7)
[1]  1 -2 -3  4  5  6 -7

Answer 6

我甚至不知道哪个更好，所以接下来会有时间挑战。 这是我的：

pmfoo<-10
curtri <- ceiling(sqrt(pmfoo*2 + 0.25) - 0.5)
pmbar<-integer()
for(j in 1:(curtri)) pmbar<-c(pmbar,rep( (-1)^(j-1),j))
pmbar*1:pmfoo
[1]   1  -2  -3   4   5   6  -7  -8  -9 -10

以下是“更好看”（偏见:-)）功能的时间试验：

Rgames> x <-1e5
Rgames> microbenchmark(cgw(x),mso(x),willb(x),times=5)
Unit: milliseconds
     expr       min        lq    median        uq       max
   cgw(x)  46.61292  47.50237  48.40807  48.42774  52.02789
   mso(x)  88.63360  97.72099  97.84286  99.00899 101.57643
 willb(x) 281.88658 285.76896 286.92397 290.83628 294.96882
 neval
     5
     5
     5

我离开了罗兰的'因为它是一个主要的记忆猪:-(

使用mso的修改代码再次运行：

 microbenchmark(cgw(x),mso(x),willb(x),newmso(x),times=5)
Unit: milliseconds
      expr       min        lq    median        uq       max
    cgw(x)  51.25860  51.29666  56.21858  58.07190  61.32610
    mso(x)  88.08966  89.17924  90.23504  93.28527  95.74666
  willb(x) 280.68967 287.53589 287.81086 288.31673 292.60749
 newmso(x)  71.53771  72.53193  72.68844  72.99419  79.21480
 neval
     5
     5
     5
     5