Для предупреждения цикла: «количество заменяемых элементов не кратно длине замены» с двумя кадрами данных

Question

Я пытаюсь создать новый вектор, применяя преобразование к переменной в одном из моих кадров данных на основе данных другого кадра данных.

У меня есть два кадра данных df1 и df2. У df1 и df2 разное измерение, у меня более 20 000 строк в df1 и 76 строк в df2. df1 - мой оригинальный набор данных. Я создал df2 для Ag_ppm следующим образом:

df2 <- df1%>%
  filter(!is.na(Ag_ppm)) %>%
  group_by(Year,Zone, SubZone) %>%
  summarise(
    n = sum(!is.na(Ag_ppm)),
    min = min(Ag_ppm),
    max = max(Ag_ppm),
    mean = mean(Ag_ppm),
    sd = sd(Ag_ppm),
    iqr = IQR(Ag_ppm),
    Q1 = quantile(Ag_ppm, 0.25),
    median = median(Ag_ppm),
    Q3 = quantile(Ag_ppm, 0.75),
    LW = min(Ag_ppm > (quantile(Ag_ppm, .25)-1.5*IQR(Ag_ppm))),
    UF = quantile(Ag_ppm, .75) + 1.5*IQR(Ag_ppm)) 

Вот как выглядят первые строки каждого фрейма данных:

head(df1, n=5)

# A tibble: 5 x 12
  Year  Zone            SubZone         Au_ppm Ag_ppm Cu_ppm Pb_ppm Zn_ppm As_ppm Sb_ppm Bi_ppm Mo_ppm
  <chr> <chr>           <chr>            <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
1 1990  BugLake         BugLake          0.007    3.7     17     27     23      1      1     NA      1
2 1983  Johnny Mountain Johnny Mountain  0.01     1.6     71     63    550      4     NA     NA     NA
3 1983  Khyber Pass     Khyber Pass      0.12    11.5    275    204   8230    178      7     60     NA
4 1987  Chebry          Ridge Line Grid  0.05     2.2     35     21    105     16      6     NA     NA
5 1987  Chebry          Handel Grid      0.004    1.3     29     27    663     45      2     NA     NA

head(df2, n=5)
# A tibble: 5 x 14
# Groups:   Year, Zone [3]
  Year  Zone            SubZone         n   min   max  mean    sd   iqr    Q1 median    Q3    LW    UF
  <chr> <chr>           <chr>       <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>  <dbl> <dbl> <int> <dbl>
1 1981  Chebry          Handel         52   0.6   5.1 1.83  0.947 0.925  1.2    1.6   2.12     1  3.51
2 1981  Imperial Metals Handel         24   0.9   6.9 2.81  1.43  1.35   1.95   2.65  3.3      1  5.33
3 1983  Chebry          Chebry          5   0.7   3.7 1.78  1.19  0.9    1.2    1.2   2.1      1  3.45
4 1983  Chebry          Handel         17   0.1   0.7 0.318 0.163 0.2    0.2    0.3   0.4      1  0.7 
5 1983  Chebry          Handel Grid   225   0.1  16   0.892 1.33  0.7    0.3    0.6   1        1  2.05

Я хочу применить следующее уравнение к моему столбцу Ag_ppm в df1, используя медиану и IQR, рассчитанные для каждой подгруппы в df2: Z = (X - медиана) / IQR

Для этого я написал:

# Initialize Ag_std vector with NA values
Ag_std <- rep(NA, times = nrow(df1))     

# Populate Ag_std vector with standardized Ag values
Ag_std <- 
  for (i in 1:nrow(df1)) {
    if (!is.na(df1$Ag_ppm[i])) { 
        filter(df2, Zone == df1$Zone[i], Year == df1$Year[i], 
           SubZone == df1$SubZone[i]) 
        Ag_std[i] <- (df1$Ag_ppm[i] - df2$median)/df2$iqr
    }
  }

Но цикл не работает (он возвращает NULL-вектор), и у меня есть это предупреждение:

1: In Ag_std[i] <- (df1$Ag_ppm[i] - df2$median)/df2$iqr :
  number of items to replace is not a multiple of replacement length

Я посмотрел похожие вопросы и не нашел ответа, который бы мне помог. Любая помощь приветствуется!

Если есть лучшие способы достижения того же самого без цикла (я уверен, что есть, например, apply ()), я был бы также признателен за такие комментарии. К сожалению, я недостаточно знаком с альтернативами, чтобы иметь возможность быстро их реализовать.

Answer 1

Это можно сделать относительно легко за data.table

library(data.table)

DT <- data.table(df1)

#function to apply
fun <- function(x) (x - median(x)) / diff (quantile( x, c(.25, .75)))

# create a new column with desired result
DT[, Ag_std := fun(Ag_ppm), by = list(Year, Zone, SubZone)]

Кроме того, я думаю, что ваш цикл можно исправить, присвоив результат 'filter' временному объекту

  for (i in 1:nrow(df1)) {
    if (!is.na(df1$Ag_ppm[i])) { 
        temp.var <- filter(df2, Zone == df1$Zone[i], Year == df1$Year[i], 
           SubZone == df1$SubZone[i]) 
        Ag_std[i] <- (df1$Ag_ppm[i] - temp.var$median)/temp.var$iqr
    }
  }

Answer 2

Поскольку у вас есть df2 в качестве отдельного фрейма данных, вы можете join и mutate:

df1 %>%
  left_join(df2, by = c("Year", "Zone", "SubZone")) %>%
  mutate(Z = (Ag_ppm - median) / iqr)

Фактически вы могли бы сгенерировать информацию в df2 в самом df1, используя summarise