Sostituire i valori negativi da zero

Vogliamo impostare tutti i valori in un array zero, che sono negativi.

Ho provato un sacco di roba, ma ancora non ottenere una soluzione di lavoro.
Ho pensato a un ciclo con condizione, tuttavia questo non sembra funzionare.

#pred_precipitation is our array
pred_precipitation <-rnorm(25,2,4)     

for (i in nrow(pred_precipitation))
{
  if (pred_precipitation[i]<0) {pred_precipitation[i] = 0}
  else{pred_precipitation[i] = pred_precipitation[i]}
}

 

3 Replies
  1. 46

    Grazie per la riproducibile esempio. Questo è abbastanza di base R roba. È possibile assegnare a selezionato gli elementi di un vettore (nota che l’array di dimensioni, e quello che hai dato è un vettore e non una matrice):

    > pred_precipitation[pred_precipitation<0] <- 0
    > pred_precipitation
     [1] 1.2091281 0.0000000 7.7665555 0.0000000 0.0000000 0.0000000 0.5151504 0.0000000 1.8281251
    [10] 0.5098688 2.8370263 0.4895606 1.5152191 4.1740177 7.1527742 2.8992215 4.5322934 6.7180530
    [19] 0.0000000 1.1914052 3.6152333 0.0000000 0.3778717 0.0000000 1.4940469

    Benchmark guerre!

    @James ha trovato anche un metodo più veloce e lasciato in un commento. Io con voto positivo a lui, se non altro perché so che la sua vittoria sarà di breve durata.

    Prima, cerco di compilazione, ma che non sembra aiutare chiunque:

    p <- rnorm(10000)
    gsk3 <- function(x) { x[x<0] <- 0; x }
    jmsigner <- function(x) ifelse(x<0, 0, x)
    joshua <- function(x) pmin(x,0)
    james <- function(x) (abs(x)+x)/2
    library(compiler)
    gsk3.c <- cmpfun(gsk3)
    jmsigner.c <- cmpfun(jmsigner)
    joshua.c <- cmpfun(joshua)
    james.c <- cmpfun(james)
    
    microbenchmark(joshua(p),joshua.c(p),gsk3(p),gsk3.c(p),jmsigner(p),james(p),jmsigner.c(p),james.c(p))
               expr      min        lq    median        uq      max
    1     gsk3.c(p)  251.782  255.0515  266.8685  269.5205  457.998
    2       gsk3(p)  256.262  261.6105  270.7340  281.3560 2940.486
    3    james.c(p)   38.418   41.3770   43.3020   45.6160  132.342
    4      james(p)   38.934   42.1965   43.5700   47.2085 4524.303
    5 jmsigner.c(p) 2047.739 2145.9915 2198.6170 2291.8475 4879.418
    6   jmsigner(p) 2047.502 2169.9555 2258.6225 2405.0730 5064.334
    7   joshua.c(p)  237.008  244.3570  251.7375  265.2545  376.684
    8     joshua(p)  237.545  244.8635  255.1690  271.9910  430.566

    Sostituire i valori negativi da zero

    Ma aspettate! Dirk ha scritto questo Rcpp cosa. Possibile una completa C++ incapace di leggere la sua JSS carta, di adattare il suo esempio, e scrivere il più veloce funzione di tutti? Stay tuned, cari ascoltatori.

    library(inline)
    cpp_if_src <- '
      Rcpp::NumericVector xa(a);
      int n_xa = xa.size();
      for(int i=0; i < n_xa; i++) {
        if(xa[i]<0) xa[i] = 0;
      }
      return xa;
    '
    cpp_if <- cxxfunction(signature(a="numeric"), cpp_if_src, plugin="Rcpp")
    microbenchmark(joshua(p),joshua.c(p),gsk3(p),gsk3.c(p),jmsigner(p),james(p),jmsigner.c(p),james.c(p), cpp_if(p))
             expr      min        lq    median        uq       max
    1   cpp_if(p)    8.233   10.4865   11.6000   12.4090    69.512
    2     gsk3(p)  170.572  172.7975  175.0515  182.4035  2515.870
    3    james(p)   37.074   39.6955   40.5720   42.1965  2396.758
    4 jmsigner(p) 1110.313 1118.9445 1133.4725 1164.2305 65942.680
    5   joshua(p)  237.135  240.1655  243.3990  250.3660  2597.429

    Sostituire i valori negativi da zero

    Che affermativa, capitano.

    Questa modifica l’input p anche se non si assegna ad esso. Se si vuole evitare che il comportamento, è necessario clone:

    cpp_ifclone_src <- '
      Rcpp::NumericVector xa(Rcpp::clone(a));
      int n_xa = xa.size();
      for(int i=0; i < n_xa; i++) {
        if(xa[i]<0) xa[i] = 0;
      }
      return xa;
    '
    cpp_ifclone <- cxxfunction(signature(a="numeric"), cpp_ifclone_src, plugin="Rcpp")

    Che, purtroppo, uccide il vantaggio della velocità.

  2. 14

    Vorrei utilizzare pmax perché ifelse può essere un po ‘ lento a volte e sottoinsieme di sostituzione crea un ulteriore vettore (che può essere un problema con i grandi insiemi di dati).

    set.seed(21)
    pred_precipitation <- rnorm(25,2,4)
    p <- pmax(pred_precipitation,0)

    Sottoinsieme di sostituzione è di gran lunga il più veloce però:

    library(rbenchmark)
    gsk3 <- function(x) { x[x<0] <- 0; x }
    jmsigner <- function(x) ifelse(x<0, 0, x)
    joshua <- function(x) pmin(x,0)
    benchmark(joshua(p), gsk3(p), jmsigner(p), replications=10000, order="relative")
             test replications elapsed relative user.self sys.self
    2     gsk3(p)        10000   0.215 1.000000     0.216    0.000
    1   joshua(p)        10000   0.444 2.065116     0.416    0.016
    3 jmsigner(p)        10000   0.656 3.051163     0.652    0.000

    Sostituire i valori negativi da zero

    • +1 per i benchmark. Aggiunta di una trama di tempi (utilizzando autoplot.microbenchmark in taRifx pacchetto)
    • wow, che cosa avete fatto per rendere la mia soluzione tanto peggio? 😛
    • Kvit tuo kvetching o in faccia la mia uomo talonz. In tutta serietà, però, ho eseguito di nuovo e sembra essere una differenza significativa tra il rbenchmark risultato e il microbenchmark risultato, almeno sul mio sistema. ~2x vs ~3x differenze temporanee.
    • Non ho ancora iniziato a kvetch!
    • Beh, io avrei usato il rbenchmark risultati per il tracciato, tranne per il fatto che non sembra essere un decente ploting metodo per loro.
    • quindi qualcuno dovrebbe scrivere uno… <ehm>
    • Non date la colpa a me. Ho scritto il microbenchmark uno in taRifx e generico autoplot funzione in ggplot2 per farlo funzionare.
    • (abs(p)+p)/2 sembra essere ancora più veloce
    • pmax è anche noto per essere lento
    • Mi affiderei la microbenchmark risultati molto più di rbenchmark – utilizza un molto di alta precisione, timer e randomises l’ordine delle repliche in un modo che rbenchmark non si può.

  3. 7

    In alternativa è anche possibile utilizzare ifelse:

    ifelse(pred_precipitation < 0, 0, pred_precipitation)

Lascia un commento