Conditioned Moving Max

Question

Jestem względnym R noob.

Mam duży zestaw danych, który wygląda mniej więcej tak:

  Tempadjvolt  newmass  rgdeltas 
2794  498.5777 0.5355647187 0.00000000 
2795  499.7577 0.5355647187 0.00000000 
2796  500.7877 0.3415104788 -2.87487763 
2797  502.1177 0.4312854788 -1.54487763 
2798  500.3877 0.5355647187 0.00000000 
2799  502.5377 0.4596354788 -1.12487763 
2800  507.6877 0.8072604788 4.02512237 
2801  505.2577 0.6432354788 1.59512237 
2802  505.7977 0.6796854788 2.13512237 
2803  517.8877 1.4957604788 14.22512237 
2804  502.2477 0.4400604788 -1.41487763 
2805  507.3677 0.7856604788 3.70512237 
2806  519.7277 1.6199604788 16.06512237 
2807  528.9377 2.2416354788 25.27512237 
2808  520.2677 1.6564104788 16.60512237 
2809  519.3877 0.5355647187 0.00000000 
2810  526.5677 2.0816604788 22.90512237 
2811  519.5377 0.5355647187 0.00000000 
2812  526.9277 2.1059604788 23.26512237 
2813  529.9877 2.3125104788 26.32512237 
2814  514.4077 1.2608604788 10.74512237 
2815  518.3777 1.5288354788 14.71512237 

próbuję zidentyfikować wartości ujemne rgdeltas [na przykład wiersz 2804], a następnie „wygląd” 7 pozycji do przodu i tyłu aby znaleźć najwyższy Tempadjvolt i ustawić tempadjvolt wiersza 2804 na ten lokalny maks.

Ramka ma długość ~ 4000 wierszy, z czego ~ 515 to wartości ujemne. Próbowałem pary dla pętli, które działały ... ale także wypluwały kilka NA - co powoduje, że myślę, że były źle/źle skonstruowane.

Każda pomoc będzie mile widziana.

Jak podkreślono w komentarzach, oryginalny post był niejasny. Nie przejmuję się kolejnymi ujemnymi wartościami rgdelt. W przypadku wartości ujemnych w obrębie 7 przedniej i końcowej części ramki, najlepiej pętla powinna wyglądać tak wiele pozycji do przodu i do tyłu przed początkiem/końcem. Mniej zaniepokojony tym w tym momencie.

Nieco więcej tła: Jest to część programu do przetwarzania sygnałów napisanego w języku C#, który próbuję przenieść do R w celu zwiększenia łatwości przetwarzania wsadowego dużej liczby plików wyprowadzanych z monitora środowiskowego. Nie napisałem oryginalnego kodu i jest to tylko jeden mały element znacznie większego zestawu rzeczy.

Doceniam pomoc. Dzięki!

Answer 1

Załóżmy, jego nazwa jest dat:

negidxs <- as.numeric(rownames(dat)[ dat[[3]] < 0 ]) 
for (i in negidxs){ 
     dat[as.character(i), "Tempadjvolt"] <- 
      max(dat[rownames(dat) %in% (i-7):(i+7), "Tempadjvolt"], na.rm=TRUE) } 
dat 
    #----------------------------------# 
    Tempadjvolt newmass rgdeltas 
2794 498.5777 0.5355647 0.000000 
2795 499.7577 0.5355647 0.000000 
2796 517.8877 0.3415105 -2.874878 
2797 517.8877 0.4312855 -1.544878 
2798 500.3877 0.5355647 0.000000 
2799 519.7277 0.4596355 -1.124878 
2800 507.6877 0.8072605 4.025122 
2801 505.2577 0.6432355 1.595122 
2802 505.7977 0.6796855 2.135122 
#snipped----- 

Answer 2

1) Zero Fill. Zakładając, że ramka danych jest nazywany DF używamy rollapply w pakiecie zoo zastosować funkcję f, do ruchomego okna o szerokości 15:

library(zoo) 
# columns of DF are (1) Tempadjvolt, (2) newmass and (3) rgdeltas 
f <- function(x) if (x[8, 3] < 0) max(x[, 1]) else x[8, 1] 
DF[[1]] <- rollapply(DF, 15, f, fill = 0, by.column = FALSE) 

W powyższym mamy wypełniony punkty w pobliżu początku i na końcu z zer ponieważ wydaje się, że dokładny sposób radzenia sobie z tym nie jest tak ważny, ale moglibyśmy użyć innej wartości wypełnienia.

2) Pozostaw wartości końcowe. Inną możliwością jest, aby przetwarzać tylko punkty nie pobliżu końców:

DF[seq(8, nrow(DF)-7), 1] <- rollapply(DF, 15, f, by.column = FALSE) 

3) partials. lub moglibyśmy korzystać partial = TRUE a następnie podjąć max częściowych wartości w pobliżu końców, takich jak ten:

f2 <- function(x) { 
     # Columns of DF2 are (1) Tempadjvolt, (2) newmass, (3) rgdeltas and (4) seq. 
     # Condition is TRUE if passed a partial x near the beginning. 
     # k is row index of current row in x. Normally 8 but near start it varies. 
     k <- if (x[1, 4] == 1) nrow(x) - 7 else 8 
     if (x[k, 3] < 0) max(x[, 1]) else x[k, 1] 
} 
DF2 <- cbind(DF, seq = 1:nrow(DF)) 
DF[[1]] <- rollapply(DF2, 15, f2, partial = TRUE, by.column = FALSE)