взвешенная скользящая медиана в data.table (r)

Question

Я знаю, что тонны функций вычисляют скользящую медиану, но я не смог найти ничего, что вычисляет взвешенную скользящую медиану (я нашел ema, но это среднее значение).Вот что я пробовал

*** отредактировано 31 января 2019 года: я обнаружил, что код работает нормально, когда я группирую только по 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)][]

Ошибка в [.data.table (a [, := ("roll_weighted_median", 1)],, := (roll_weighted_median,: Тип RHS («логический») должен совпадать с LHS («двойной»). Чтобы проверить и принудительно повлиять на производительность слишком быстро для самых быстрых случаев. Либо измените тип целевого столбца, либо приведите RHS: = себе(например, используя 1L вместо 1)

Answer 1

С вашим кодом довольно много проблем.Основная проблема, которая дает вашу текущую ошибку, вызвана аргументом fill = NA для rollapply.По умолчанию 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)][]

Другая возможная проблема с вашим кодом состоит в том, что weight_median_calc выдаст ошибку, если ему будут переданы только NA значения.Мы можем переписать это так, чтобы избежать этих ошибок

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]