data.table (r) 中的加权滚动中位数

weighted rolling median in data.table (r)

我知道有很多函数计算滚动中位数,但我找不到任何计算 weighted 滚动中位数的函数(我找到了 ema,但那是平均值)。这是我试过的

*** 2019 年 1 月 31 日编辑: 当我只按 V2 分组时,我发现代码工作正常。只有当我按 V2:V4

分组时才会出现错误
library(spatstat)
library(data.table)
library(zoo)


a <- data.table(V1 = c(rep(NA, 10), runif(90)), 
                V2 = c(rep('good', 50), rep('bad', 50)),
                V3 = c(rep('monday', 70), rep('friday', 30)),
                V4 = c(rep('male', 90), rep('female', 10)))
a <- a[,'lag1':=lag(V1, n = 1), by = .(V2)]
set.seed(55)
rn <- runif(45)
w <- sort(rn/sum(rn), decreasing = T)

weight_median_calc <- function(u){
  weighted.median(x = u,
                w = w)
}

a <- a[,'roll_weighted_median':= 1][,roll_weighted_median:=rollapply(data = lag1,
                                                                   width = 45,
                                                                   FUN = weight_median_calc,
                                                                   by.column = FALSE,
                                                                   align = 'right',
                                                                   fill = NA
),
by = .(V2, V3, V4)][]

Error in [.data.table(a[, :=("roll_weighted_median", 1)], , :=(roll_weighted_median, : Type of RHS ('logical') must match LHS ('double'). To check and coerce would impact performance too much for the fastest cases. Either change the type of the target column, or coerce the RHS of := yourself (e.g. by using 1L instead of 1)

你的代码有不少问题。给出当前错误的主要问题是由 rollapplyfill = NA 参数引起的。默认情况下,NA 是逻辑类型,当我们尝试使用 := 将其分配到数值向量时会发生冲突。所以改为使用 fill = as.numeric(NA) - 像这样:

a[, roll_weighted_median := rollapply(
  data = lag1, width = 45, FUN = weight_median_calc,
    by.column = FALSE, align = 'right', fill = as.numeric(NA)),
  by = .(V2, V3, V4)][]

您的代码的另一个可能问题是,如果仅传递 NA 值,weight_median_calc 将引发错误。我们可以这样重写它来避免这些错误

weight_median_calc <- function(u){
  if (!all(is.na(u))) 
    weighted.median(x = u, w = w[1:length(u)]) 
  else as.numeric(NA)
}

要解决的第三个问题是您对 lag 的使用。 lag 没有 n= 参数。在 data.table 中,您可能应该使用 shift 而不是

a[, lag1 := shift(V1, 1), by = .(V2)]

您应该注意的最后一件事是,在 data.table 中,不应将 <- 赋值与 := 赋值结合使用。 :=已经赋值完毕,不用再用<-复制结果。换句话说,不要做 a <- a[, foo := bar]。只要做 a[, foo := bar]