如何根據應用於不同列的條件語句應用引用特定列和前導值的 function

Question

我有一個包含日期時間、濁度值和采樣方法代碼的數據集。 我想 select 任何使用采樣方法代碼 10 或 40 的行，然后為這些行計算新的濁度值。 新的濁度值需要進行時間加權，因此我需要參考我正在重新計算的濁度值之后的兩個濁度值。 我是 R 編程的新手，所以我在這個方面有點掙扎。

示例數據：

約會時間	渦輪	樣品方法	twm
2018 年 5 月 1 日 12:15	1.4	不適用
2018 年 5 月 1 日 12:30	1.6	不適用
2018 年 5 月 1 日 12:45	1.4	不適用
2018 年 5 月 1 日 13:00	1.4	不適用
2018 年 5 月 1 日 14:15	1.3	10
2018 年 5 月 1 日 14:30	1.4	不適用
2018 年 5 月 1 日 14:45	1.4	不適用
2018 年 5 月 1 日 15:00	1.4	不適用
2018 年 5 月 1 日 15:15	1.4	不適用
2018 年 5 月 1 日 15:30	1.3	不適用
2018 年 5 月 1 日 15:45	1.3	40
2018 年 5 月 1 日 16:00	1.3	不適用
2018 年 5 月 1 日 16:15	1.4	不適用
2018 年 5 月 1 日 16:30	1.3	不適用
2018 年 5 月 1 日 16:45	1.3	4033
2018 年 5 月 1 日 17:00	1.3	不適用

我首先嘗試了一個 ifelse function：

twtbl$twm<-ifelse(twtbl$sample_meth==10|40,(((twtbl$TURB[i]+lead(twtbl$TURB[i],1)/2)*15)+((lead(twtbl$TURB[i],1)+lead(twtbl$TURB[i],2)/2)*15))/30)

我已經嘗試定義一個 function 並在 for 循環中使用它（我認為我做的不正確），我還嘗試將計算放在一個 for 循環中以獲得所有值的時間加權平均值，期望到那時清理它們。

  for(i in twtbl$TURB){
  twtbl$twm<-(((((twtbl$TURB[i]+lead(twtbl$TURB[i],1))/2)*15)+(((lead(twtbl$TURB[i],1)+lead(twtbl$TURB[i],2))/2)*15))/30)
}

我嘗試的時間加權計算的語法是基於我發現的關於滯后和領先值的信息：

(((((twtbl$TURB[i]+lead(twtbl$TURB[i],1))/2)*15)+(((lead(twtbl$TURB[i],1)+lead(twtbl$TURB[i],2))/2)*15))/30)

在 Excel 工作表中，此計算類似於：

=((((B$1+B$2)/2)*15)+((((B$2+B$3)/2)*15))/30

Answer 1

以下內容未經測試，因為數據不符合問題的標准。 它使用 package zoo , function rollapplyr來計算公式。 我已經簡化了公式，但在 R 中編碼的原始公式仍在 function 主體中。

f_aux <- function(x){
  #(15*(x[1] + x[2])/2 + 15*(x[2] + x[3])/2)/30
  (x[1] + 2*x[2] + x[3])/4
}

i <- with(twtbl, sample_meth %in% c(10, 40))
twtbl$twm <- NA_real_
twtbl$twm[i] <- zoo::rollapplyr(twtbl$TURB[i], width = 3, FUN = f_aux)

Answer 2

我們也可以在base R中做，讓我們按順序開發代碼。 （這不會是最有效或最短的，但我會優先考慮清晰性。）

首先，編造一些數據。 （以下省略了 10 或 40 彼此接近或接近數據末尾的情況。您需要決定在這些情況下該怎么做。）

set.seed(0)
n <- 10
twtbl <- data.frame(
  date.time=seq.Date(from=as.Date("2010-01-01"), by=123, length.out=n), 
  turb=sample.int(n=5, size=n, replace=TRUE), 
  sample_meth=c(10, 999, 999, 40, 999, 999, 999, 10, 999, 999)
)

> twtbl
    date.time turb sample_meth
1  2010-01-01    1          10
2  2010-05-04    4         999
3  2010-09-04    1         999
4  2011-01-05    2          40
5  2011-05-08    5         999
6  2011-09-08    3         999
7  2012-01-09    2         999
8  2012-05-11    3          10
9  2012-09-11    3         999
10 2013-01-12    1         999

這是 R 我們不需要循環:-)。 我們可以得到需要修復濁度的行號：

rowsToFix <- which(twtbl$sample_meth %in% c(10, 40))

接下來，用 function 修復它們。 給定一個行號和一個 dataframe（在本例中twtbl ），它返回一個新的濁度值。 （請注意，此版本假定行按日期排序。如果不是，並且首先對 dataframe 進行排序是不切實際的，您可以使用lead()編寫一個版本，盡管我不確定您上面使用的語法是否正確。另外，我希望這能正確計算，我可能誤解了？）

recalculate <- function(i, df) {
  newValue <- (df$turb[i] + df$turb[i+1] * 15/2 + 
    (df$turb[i+1] + df$turb[i+2] * 15/2)) / 30
  return(newValue)
}

最后，我們可以將此應用於 dataframe。 我們將復制twtb1並對其進行修改，以便我們進行比較：

fixedTwtbl <- twtbl
fixedTwtbl[rowsToFix, "turb"] <- 
  sapply(X=rowsToFix, FUN=function(u) recalculate(i=u, df=twtbl))

> twtbl
    date.time turb sample_meth
1  2010-01-01    1          10
2  2010-05-04    4         999
3  2010-09-04    1         999
4  2011-01-05    2          40
5  2011-05-08    5         999
6  2011-09-08    3         999
7  2012-01-09    2         999
8  2012-05-11    3          10
9  2012-09-11    3         999
10 2013-01-12    1         999
> fixedTwtbl
    date.time   turb sample_meth
1  2010-01-01 1.4167          10
2  2010-05-04 4.0000         999
3  2010-09-04 1.0000         999
4  2011-01-05 2.2333          40
5  2011-05-08 5.0000         999
6  2011-09-08 3.0000         999
7  2012-01-09 2.0000         999
8  2012-05-11 1.2000          10
9  2012-09-11 3.0000         999
10 2013-01-12 1.0000         999