R使用dplyr按組計算加權統計量

Question

幾年來，我一直在使用 Hmisc 包和基礎 R 來計算加權統計摘要。 通常，我使用雙權重，一個是空間影響權重，另一個是數據支持值，例如長度、體積、物理密度等。 以 'mtcars' 數據集為例，其中 mpg 是感興趣的變量，並且從汽車 'wt' 和 'hp' 設計出雙權重，Hmisc + base R 工作流程通常類似於下面的工作流程。

require(Hmisc)

mtcars$Wt2 <- mtcars$wt * mtcars$hp               # double weight
mtcars$Acc <- mtcars$Wt2 * mtcars$mpg             # accumulation

min(mtcars$mpg)                                   # min
sqrt(wtd.var(mtcars$mpg, mtcars$mpg))             # wtd sd
wtd.quantile(mtcars$mpg, mtcars$mpg,0.05)         # wtd 5th 
wtd.quantile(mtcars$mpg, mtcars$mpg,0.50)         # wtd median
wtd.quantile(mtcars$mpg, mtcars$mpg,0.95)         # wtd 95th
max(mtcar$mpg)                                    # max

使用循環，然后可以為更大的數據幀中的每個感興趣區域過濾和計算這些加權統計數據。 但是，當我嘗試學習如何使用 dplyr 時，我想知道如何計算這些加權統計數據。 可以使用加權平均選項，但其他選項需要更多工作。 下面是我計算出如何根據第一原理計算加權平均值的代碼（並根據 dplyr 內置函數進行了檢查）。 但是，我很困惑如何使用 dplyr 按組計算加權 SD 和分位數，因為我需要以某種方式將平方加權平均差（對於每組）放入管道鏈中。

mtcars %>% 
  mutate(Car = row.names(mtcars)) %>%  # variable for car name
  mutate(Wt2 = wt * hp) %>%            # double weight
  mutate(Acc = Wt2 * mpg) %>%          # weighted consumption
  group_by(Car) %>%                    # group by car type
  summarise(n = n(),
            SmWt2 = sum(Wt2),                    # Sum of double weight
            SmAcc = sum(Acc),                    # Sum of accumulations
            WtMn = SmAcc/SmWt2,                  # Weighted mean
            WtMnChk = weighted.mean(mpg, Wt2)    # Check weighted mean
            )

Answer 1

我不確定我是否完全理解您正在使用的方法，但這里有一個通過gear找到加權平均值和加權標准偏差的示例，使用wt作為權重：

library(dplyr)
datasets::mtcars %>% 
  group_by(gear) %>%
  summarize(n = n(),
            mpg_weighted_by_weight = sum(mpg*wt) / sum(wt),
            mpg_weighted_by_weight_check = weighted.mean(mpg, wt),
            
            mpg_sd = sqrt(sum(wt * ((mpg - mpg_weighted_by_weight)^2))/(sum(wt)-1)),
            mpg_sd_check = sqrt(Hmisc::wtd.var(mpg, wt)))


# A tibble: 3 x 6
   gear     n mpg_weighted_by_weight mpg_weighted_by_weight_check mpg_sd mpg_sd_check
* <dbl> <int>                  <dbl>                        <dbl>  <dbl>        <dbl>
1     3    15                   15.6                         15.6   3.32         3.32
2     4    12                   23.6                         23.6   4.81         4.81
3     5     5                   19.7                         19.7   5.63         5.63

我不熟悉加權標准差的公式，而是欺騙並依賴Hmisc::wtd.var的公式。 如果您在 RStudio 中按住 Control 鍵單擊公式名稱，則會顯示該函數的底層代碼。 大部分都是錯誤處理，直到底部：

#Hmisc::wtd.var
function (x, weights = NULL, normwt = FALSE, na.rm = TRUE, method = c("unbiased", 
  "ML")) 
{
  # ...  skipping error handling
  sw <- sum(weights)
  # ...
  xbar <- sum(weights * x)/sw
  sum(weights * ((x - xbar)^2))/(sw - 1)
}