Взвешенная сумма нескольких столбцов в R с использованием tidyverse

#r #tidyverse #group-summaries

#r #tidyverse #групповые сводки

Вопрос:

Я пытаюсь получить взвешенную сумму для каждого уровня фактора. У меня есть четыре столбца данных:

 col1 = surface area
col 2 = dominant
col 3 = codominant
col 4 = sub

1    2    3     4
125  A    NA    NA
130  A    NA    B
150  C    B     NA
160  B    NA    NA
90   B    A     NA
180  C    A     B
 
  • Если заполнен только столбец 2, значение получает полную сумму столбца 1.
  • Если столбцы 2 и 3 заполнены, значение в столбце 1 делится пополам.
  • Если столбцы 2, 3 и 4 заполнены, значение в столбце 1 делится на три.
  • Если столбцы 2 и 4 заполнены, значение в столбце 1 делится как 75/25.

Итак, для приведенного выше примера вывода мой новый фрейм данных будет:

 1    2
A    326.9
B    331.4
C    134.4
 

Я повозился ifelse и придумал что-то вроде (для двух столбцов для этого примера):

      df1 <- df %>% 
            mutate(weighted_dominant = ifelse(!is.na(dominant) amp; is.na(codominant), Surface_Area, 
            Surface_Area/2),
                   weighted_codominant = ifelse(!is.na(codominant), Surface_Area/2, NA )
 

Теперь я изолирую столбцы intereset:

 df2 <- df1 %>% select(dominant, weighted_dominant) %>% 
               group by (dominant) %>%
               summarise (sum = sum(weighted_dominant) 
 

также выполните это для столбца codominant, свяжите строки двух новых фреймов данных и снова выполните функцию summarise .

Это позволяет выполнить работу, но также занимает около 50 строк кода и, на мой взгляд, не очень чисто.

Мой вопрос: существуют ли лучшие (tidyverse) способы выполнения такого взвешенного суммирования?

Комментарии:

1. Я не уверен, что понимаю случай «Если столбцы 1 и 4 заполнены, значение в столбце 1 делится как 75/25». Что получает 75, а что 25? Разве в этой ситуации нет только одного значения (col 4)? Не могли бы вы уточнить подробнее?

2. Привет, Бен, это была небрежная ошибка с моей стороны. Это должно быть col2 вместо col1. Таким образом, столбцы 2 и 4 заполнены, col 2 получает col1 * 0.75 , а col 4 получает col1 * 0.25 .

3. Я также отредактировал свой предыдущий код, используя !is.na() вместо == ""

Ответ №1:

С tidyverse вами можно рассмотреть следующий подход.

Включите номера строк в отдельный столбец, чтобы вы могли выполнять вычисления в каждой строке. pivot_longer Ваши данные будут переведены в длинный формат.

После группировки по номеру строки вы можете определить значения для A, B и C в зависимости от того, какие столбцы отсутствуют. Это предполагает, что всегда есть «доминирующий» столбец (в противном случае вы могли бы настроить логику здесь).

Затем удалите свои NA и суммируйте взвешенные значения для A, B и C.

 df %>%
  mutate(rn = row_number()) %>%
  pivot_longer(cols = c(dominant, codominant, sub)) %>%
  group_by(rn) %>%
  mutate(weight = case_when(
    is.na(value[name == "codominant"]) amp; is.na(value[name == "sub"]) ~ as.numeric(Surface_Area),
    is.na(value[name == "codominant"]) amp; name == "dominant" ~ Surface_Area * .75,
    is.na(value[name == "codominant"]) amp; name == "sub" ~ Surface_Area * .25,
    is.na(value[name == "sub"]) ~ Surface_Area / 2,
    TRUE ~ Surface_Area / 3
  )) %>%
  drop_na() %>%
  group_by(value) %>%
  summarise(total = sum(weight))
 

Вывод

   value total
  <chr> <dbl>
1 A      328.
2 B      372.
3 C      135 
 

Комментарии:

1. Большое вам спасибо, это был ответ, который я искал. Мне нужно немного подправить его, так как мой фрейм данных представляет собой шейп-файл, но это сработает. Спасибо, что показали мне аккуратный способ!

Ответ №2:

Это то, что вы ищете:

 # your data
df <- read.table(text = "
125  A    NA    NA
130  A    NA    B
150  C    B     NA
160  B    NA    NA
90   B    A     NA
180  C    A     B", header = FALSE)
names(df) <- c("surface_area", "dominant", "codominant", "sub")


# make a matrix out of the last 3 columns
m <- as.matrix(df[2:4])


# get a logical matrix of non-NA
x <- !is.na(m)


# calculate as follow:
# 2  NA  NA  ->  1    0    0
# 2   3  NA  ->  1/2  1/2  0
# 2  NA   4  ->  1/2  0    1/2
# 2   3   4  ->  1/3  1/3  1/3
x <- x * (1/rowSums(x))


# correct
# 2  NA   4  ->  0.75  0  0.25
x[apply(x, 1, identical, c(dominant=0.5,codominant=0,sub=0.5)),] <- c(dominant=0.75,codominant=0,sub=0.25)


# multiply by surface_area
x <- x * df$surface_area


# get unique letters
l <- sort(unique(c(m)))
l <- l[!is.na(l)]


# sum by each letter
r <- sapply(l, function(i) sum(x[m==i], na.rm = TRUE))


# create final dataframe
data.frame(X1 = names(r), X2 = unname(r))
#>   X1    X2
#> 1  A 327.5
#> 2  B 372.5
#> 3  C 135.0
 

Конечные цифры не совпадают, я неправильно понял ваше объяснение? Мне это не совсем понятно.

Комментарии:

1. Это выглядит великолепно! Спасибо за помощь, это действительно ответило на мой вопрос базовым способом R, но прежде чем я соглашусь, я также хочу подробно ознакомиться с ответом Бена.