объединить две циклические структуры для получения вывода матрицы

#r #dataframe #matrix #dplyr #tidyverse

#r #фрейм данных #матрица #dplyr #tidyverse

Вопрос:

Я использую две тесно связанные формулы в R. Мне было интересно, можно ли было бы объединить B1 и B2 получить желаемый результат матрицы, показанный ниже?

 z <- "group    y1    y2
1 1         2     3
2 1         3     4
3 1         5     4
4 1         2     5
5 2         4     8
6 2         5     6
7 2         6     7
8 3         7     6
9 3         8     7
10 3        10     8
11 3         9     5
12 3         7     6"

dat <- read.table(text = z, header = T)

(B1 = Reduce(" ", group_split(dat, group, .keep = FALSE) %>%
  map(~ nrow(.)*(colMeans(.)-colMeans(dat[-1]))^2)))

#     y1       y2 
#61.86667 19.05000

(B2 = Reduce(" ",group_split(dat, group, .keep = FALSE) %>%
              map(~ nrow(.)*prod(colMeans(.)-colMeans(dat[-1])))))

# 24.4
 

желаемый выход матрицы:

 matrix(c(61.87,24.40,24.40,19.05),2)
#      [,1]  [,2]
#[1,] 61.87 24.40
#[2,] 24.40 19.05
 

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

1. Две операции практически идентичны. Итак, вы можете сделать.одну группировку и получить результат. Пожалуйста, проверьте решение ниже.

Ответ №1:

Может быть, так?

 mat <- matrix(B2, length(B1), length(B1))
diag(mat) <- B1
mat
#      [,1]  [,2]
#[1,] 61.87 24.40
#[2,] 24.40 19.05
 

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

1. Как вы думаете, B1 и B2 нужно вычислять изолированно? (вот в чем вопрос)

2. @rnorouzian Вы можете сделать Reduce(" ", group_split(dat, group, .keep = FALSE) %>% map(~ {c(nrow(.)*(colMeans(.)-colMeans(dat[-1]))^2, nrow(.)*prod(colMeans(.)-colMeans(dat[-1])))})) , чтобы выполнить все вычисления вместе. но вам все равно нужно выполнить некоторые манипуляции, чтобы получить вывод в желаемом формате.

Ответ №2:

Мы также могли бы сделать это в одной цепочке без необходимости повторять вычисления. Одно из преимуществ использования sum по сравнению с in Reduce заключается в том, что он может учитывать пропущенные значения с na.rm аргументом, тогда как, если при выполнении есть какие-либо NA , он возвращается NA благодаря свойству NA

 library(dplyr)
dat %>% 
     # // group by group
     group_by(group) %>%
     # // create a count column 'n' 
     summarise(n = n(), 
      # // loop across y1, y2, get the difference between the grouped 
      # // column  mean value and the full data column mean
       across(c(y1, y2), ~ (mean(.) - mean(dat[[cur_column()]]))),
          .groups = 'drop') %>% 
      # // create the columns by multiplying the output of y1, y2 with n        
     transmute(y1y2 = y1 * y2 * n, 
            # //  Get the raised power of y1, y2, and multiply with n
           across(c(y1, y2), list(new1 = ~ n * .^2))) %>%
     # // then do a columnwise sum, replicate the 'y1y2' clumn
     summarise(across(everything(), sum, na.rm = TRUE), y1y2new = y1y2) %>% 
     # // rearrange the column order
     select(c(2, 1, 4, 3)) %>% 
     # // unlist to a vector
     unlist %>%
     # // create a matrix with 2 rows, 2 columns
     matrix(2, 2)
#         [,1]  [,2]
#[1,] 61.86667 24.40
#[2,] 24.40000 19.05