Wektoryzować kalkulację produktu, która zależy od poprzednich elementów?

To ładny i prosty przykład, w którym Rcpp może zabłysnąć.

Więc najpierw przekształćmy funkcje 1 i 2 oraz ich skompilowane odpowiedniki:

library(inline)
library(rbenchmark)
library(compiler)

fun1 <- function(z) {
  for(i in 2:NROW(z)) {
    z[i] <- ifelse(z[i-1]==1, 1, 0)
  }
  z
}
fun1c <- cmpfun(fun1)


fun2 <- function(z) {
  for(i in 2:NROW(z)) {
    z[i] <- if(z[i-1]==1) 1 else 0
  }
  z
}
fun2c <- cmpfun(fun2)

Bardzo łatwo piszemy wariant rcpp:

funRcpp <- cxxfunction(signature(zs="numeric"), plugin="Rcpp", body="
  Rcpp::NumericVector z = Rcpp::NumericVector(zs);
  int n = z.size();
  for (int i=1; i<n; i++) {
    z[i] = (z[i-1]==1.0 ? 1.0 : 0.0);
  }
  return(z);
")

Wykorzystuje pakiet inline do kompilacji, ładowania i łączenia pięciolinii w locie.

Teraz możemy zdefiniować naszą datę testu, którą wykonujemy nieco dłużej niż oryginał (ponieważ samo uruchomienie oryginału zbyt kilka razy skutkuje niemożliwością pomiaru razy):

R> z <- rep(c(1,1,0,0,0,0), 100)
R> identical(fun1(z),fun2(z),fun1c(z),fun2c(z),funRcpp(z))
[1] TRUE
R> 

Wszystkie odpowiedzi są postrzegane jako identyczne.

Wreszcie możemy porównać:

R> res <- benchmark(fun1(z), fun2(z),
+                  fun1c(z), fun2c(z),
+                  funRcpp(z),
+                  columns=c("test", "replications", "elapsed", 
+                            "relative", "user.self", "sys.self"),
+                  order="relative",
+                  replications=1000)
R> print(res)
        test replications elapsed relative user.self sys.self
5 funRcpp(z)         1000   0.005      1.0      0.01        0
4   fun2c(z)         1000   0.466     93.2      0.46        0
2    fun2(z)         1000   1.918    383.6      1.92        0
3   fun1c(z)         1000  10.865   2173.0     10.86        0
1    fun1(z)         1000  12.480   2496.0     12.47        0

Dla porównania, oto wynik dla oryginalnego wektora krótkiego nazywanego częściej:

R> z <- c(1,1,0,0,0,0)
R> res2 <- benchmark(fun1(z), fun2(z),
+                  fun1c(z), fun2c(z),
+                  funRcpp(z),
+                  columns=c("test", "replications", 
+                            "elapsed", "relative", "user.self", "sys.self"),
+                  order="relative",
+                  replications=10000)
R> print(res2)
        test replications elapsed  relative user.self sys.self
5 funRcpp(z)        10000   0.046  1.000000      0.04        0
4   fun2c(z)        10000   0.132  2.869565      0.13        0
2    fun2(z)        10000   0.271  5.891304      0.27        0
3   fun1c(z)        10000   1.045 22.717391      1.05        0
1    fun1(z)        10000   1.202 26.130435      1.20        0

Ranking jakościowy pozostaje bez zmian: dominuje wersja Rcpp , function 2 jest na drugim miejscu. wersja skompilowana bajtami jest około dwa razy szybsza od zwykłej wersji R, ale wciąż prawie trzy razy wolniejsza od wersji C++. A różnica względna jest niższa: relatywnie rzecz biorąc, funkcja wywołania ma mniejsze znaczenie, a rzeczywista pętla ma znaczenie więcej: C++ ma większą przewagę nad rzeczywistymi operacjami pętli w dłuższych wektorach. Że jest to ważny wynik, ponieważ sugeruje, że bardziej rzeczywiste dane wielkości, skompilowana wersja może czerpać większe korzyści.

edytowane w celu poprawienia dwóch małych przeoczeń w przykładach kodu. I ponownie edytowane dzięki Joshowi, aby złapać błąd konfiguracji w stosunku do fun2c.

Myślę, że jest to oszustwo i nie uogólnialne, ale: zgodnie z powyższymi regułami, każde wystąpienie 1 w wektorze sprawi, że wszystkie kolejne elementy 1 (przez rekurencję: z[i] będzie 1 ustawione na 1, Jeśli z[i-1] równa się 1; zatem z[i] będzie 1, Jeśli z[i-2] równa się 1; i tak dalej). W zależności od tego, co naprawdę chcesz zrobić, istnieje Może być takie rekurencyjne rozwiązanie dostępne, jeśli dobrze się nad tym zastanowisz ...

z <- c(1,1,0,0,0,0)
first1 <- min(which(z==1))
z[seq_along(z)>first1] <- 1

Edit: to jest złe, ale zostawiam muszę przyznać się do błędów. Bazując na odrobinie grania (i mniej myślenia), myślę, że Rzeczywiste rozwiązanie tej rekurencji jest bardziej symetryczne i jeszcze prostsze:

rep(z[1],length(z))

Przypadki testowe:

z <- c(1,1,0,0,0,0)
z <- c(0,1,1,0,0,0)
z <- c(0,0,1,0,0,0)

Sprawdź funkcję rollapply w zoo.

Nie znam się na tym zbyt dobrze, ale myślę to robi to, co chcesz:

> c( 1, rollapply(z,2,function(x) x[1]) )
[1] 1 1 1 1 1 1

Zamykam go używając okna 2, a potem tylko pierwszego elementu tego okna.

Dla bardziej skomplikowanych przykładów możesz wykonać obliczenia na x[1] i zwrócić je zamiast tego.

Czasami trzeba myśleć o tym zupełnie inaczej. To, co robisz, to tworzenie wektora, w którym każdy element jest taki sam jak pierwszy, jeśli jest 1 lub 0 w przeciwnym razie.

z <- c(1,1,0,0,0,0)
if (z[1] != 1) z[1] <- 0
z[2:length(z)] <- z[1]

Istnieje funkcja, która wykonuje te obliczenia: cumprod (Produkt skumulowany)

> cumprod(z[zi])
[1] 1 0 0 0 0

> cumprod(c(1,2,3,4,0,5))
[1]  1  2  6 24  0  0

W przeciwnym razie, vectorize z Rccp, jak pokazały inne odpowiedzi.

Jest również możliwe, aby to zrobić za pomocą "apply" używając oryginalnego wektora i opóźnionej wersji wektora jako kolumn składowych ramki danych.