creando una sequenza di numeri positivi e negativi in ​​R

Question

ho cercato di creare una funzione per la sequenza dei seguenti serie:

1, -2, -3, 4, 5, 6, -7, - 8, -9, -10 ........ n (1 positivo, 2 negativi, 3 positivi, 4 negativi ... e continua fino a n).

Creare una sequenza non negativa è abbastanza semplice, ma questi termini negativi mi stanno mettendo alla prova.

Se qualcuno mi può aiutare su questo

Answer 1

Ecco un modo per farlo.

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 

si avvantaggia del fatto che è possibile trovare quale numero triangolare si è a con sqrt(i*2 + 0.25) - 0.5. Applicando anche a numeri non triangolari, possiamo determinare l'indice del prossimo numero triangolare e usarlo come esponente per -1.

C'è probabilmente un modo migliore, però.

Answer 2

Anche se forse non il più elegante, ma credo che questo fornirà ciò che si desidera.

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 

Un altro modo possibile per un vettore di lunghezza specifico utilizzando l'equazione fornita da 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 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 

Il valore per k è dispendiosamente alto, ma io sono troppo stanco per fare i calcoli e trovare un limite inferiore. Lascio questo a te.

Answer 4

Ci sono tanti modi per farlo!

Ad esempio:

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 5

Per una soluzione facile da capire ciclo:

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 6

non riesco nemmeno a dire che è meglio, quindi un time-sfida seguirà. Ecco la mia:

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 

Qui ci sono le prove a cronometro per le funzioni "più bello" (orientato opinione :-)):

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 

ho lasciato di Roland fuori perche' si tratta di un importante ingordo di memoria: - (

Eseguire di nuovo con MSO ha modificato il codice:

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