需要帮助将 Excel 公式转换为 R 函数 - 循环/迭代以构建矩阵

Question

我已经构建了这个 Excel 公式，它接受值并从中构建一个新矩阵。

但是我在 R 中工作，在 Excel 中更新电子表格并稍后将其导入 R 不是很方便。

我的工作 excel 代码：

=IF(AND($A8=H$2;H$10>0;$I8>0;$I8>H$10);1;IF(AND($A8<>H$2;H$10>0;$I8>0;MAXIFS($I:$I;$A:$A;$A8)=$I8;MAXIFS($10:$10;$2:$2;H$2)=H$10;$I8>=MAXIFS($10:$10;$2:$2;H$2));1;0))

这是我的数据集样本的样子：

我有 X 个组（橙色）和 Y 个不同的项目（绿色），它们都有一个不同的值（蓝色）。

第一步是在 R 中实现这个公式。

第二个是，因为我有几列，实现一个自动 for 循环，加起来就是我需要的 final 矩阵。

任何帮助表示赞赏！

我的 df 的负责人（组 = 橙色组，名称 = 绿色，col_X = 值（蓝色） - 在我的 excel 示例中，它只是一列）。

 ID group Name col_1 col_2 col_3 col_4 col_5 col_6 col_7
1  1    X1    a     0     0     0     0     0     0     0
2  2    X1    b     0     0     0     3     0     0     0
3  3    X2    c     3     0     0     0     0     2     0
4  4    X2    d     0     0     0     0     1     0     0
5  5    Y3    e     0     0     0     0     0     0     0
6  6    X1    f     0     0     1     0     1     0     0

Answer 1

如果您以“整齐的长数据格式”而不是“矩阵宽数据格式”来考虑这一点，这会容易得多。如果你使用expand.grid(ColB=letters[1:6], Row3=letters[1:6])，你会得到a到f小写字母的所有36个组合，然后你就可以进行所有的计算。以下代码将返回您的预期结果：

library(dplyr)
library(tidyr)

base <- data.frame(
  lowerletter=letters[1:6],
  upperletter=c('A', 'A', 'B', 'B', 'C', 'C'),
  number=c(5, 4, 3, 1, 5, 4)
)

df <- expand.grid(ColB=letters[1:6], Row3=letters[1:6]) %>%
  left_join(rename(base, ColB=lowerletter), by='ColB') %>%
  left_join(rename(base, Row3=lowerletter), by='Row3') %>%
  rename(
    ColA=upperletter.x,
    ColI=number.x,
    Row2=upperletter.y,
    Row10=number.y
  )

df <- df %>%
  group_by(ColA) %>%
  mutate(maxIbyA=max(ColI)) %>%
  ungroup() %>%
  group_by(Row2) %>%
  mutate(max10by2=max(Row10)) %>%
  ungroup() %>%
  mutate(
    z = case_when(
      (ColA==Row2) & (Row10>0) & (ColI>Row10) ~ 1,
      (ColA!=Row2) & (Row10>0) & (ColI>0) & (maxIbyA==ColI) & (max10by2==Row10) & (ColI >= max10by2) ~ 1,
      TRUE~0
    )
  )

df %>%
  mutate(
    Col=paste(Row2, Row3, Row10, sep='_'),
    Row=paste(ColA, ColB, ColI)
  ) %>%
  tidyr::pivot_wider(id_cols='Row', names_from='Col', values_from='z')

会输出

# A tibble: 6 x 7
  Row   A_a_5 A_b_4 B_c_3 B_d_1 C_e_5 C_f_4
  <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 A a 5     0     1     1     0     1     0
2 A b 4     0     0     0     0     0     0
3 B c 3     0     0     0     1     0     0
4 B d 1     0     0     0     0     0     0
5 C e 5     1     0     1     0     0     1
6 C f 4     0     0     0     0     0     0

要同时将此逻辑应用于多个列，您可以将原始数据框转换为长格式，将列名添加到expand.grid，如expand.grid(ColB=unique(base$Name), Row3=unique(base$Name), col=unique(base$col))，并将列包含到使用的group_by计算max 值。

df <- data.frame(
  ID=1:6,
  group=c('X1', 'X2', 'X2', 'X2', 'Y2', 'X1'),
  Name=c('a','b','c','d','e','f'),
  col_1=c(0,0,3,0,0,0),
  col_2=c(0,0,0,0,0,0),
  col_3=c(0,0,0,0,0,1),
  col_4=c(0,3,0,0,0,0),
  col_5=c(0,0,0,1,0,1),
  col_6=c(0,0,2,0,0,0),
  col_7=c(0,0,0,0,0,0)
)

base <- df %>%
  pivot_longer(cols=starts_with('col_'), names_to='col') %>%
  select(group, Name, value, col)


df2 <- expand.grid(ColB=unique(base$Name), Row3=unique(base$Name), col=unique(base$col)) %>%
  left_join(rename(base, ColB=Name), by=c('ColB', 'col')) %>%
  left_join(rename(base, Row3=Name), by=c('Row3', 'col')) %>%
  rename(
    ColA=group.x,
    ColI=value.x,
    Row2=group.y,
    Row10=value.y
  ) %>%
  group_by(col, ColA) %>%
  mutate(maxIbyA=max(ColI, na.rm=TRUE)) %>%
  ungroup() %>%
  group_by(col, Row2) %>%
  mutate(max10by2=max(Row10, na.rm=TRUE)) %>%
  ungroup() %>%
  mutate(
    z = case_when(
      (ColA==Row2) & (Row10>0) & (ColI>Row10) ~ 1,
      (ColA!=Row2) & (Row10>0) & (ColI>0) & (maxIbyA==ColI) & (max10by2==Row10) & (ColI >= max10by2) ~ 1,
      TRUE~0
    )
  )

然后你可以过滤任何你感兴趣的原始列，它会输出矩阵：

df2 %>%
  filter(col == 'col_5') %>%
  mutate(
    Col=paste(Row2, Row3, Row10, sep='_'),
    Row=paste(ColA, ColB, ColI)
  ) %>%
  tidyr::pivot_wider(id_cols='Row', names_from='Col', values_from='z')

会输出：

  Row    X1_a_0 X2_b_0 X2_c_0 X2_d_1 Y2_e_0 X1_f_1
  <chr>   <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
1 X1 a 0      0      0      0      0      0      0
2 X2 b 0      0      0      0      0      0      0
3 X2 c 0      0      0      0      0      0      0
4 X2 d 1      0      0      0      0      0      1
5 Y2 e 0      0      0      0      0      0      0
6 X1 f 1      0      0      0      1      0      0