CODEWITHSUNDEEP
rexcelexcel-formulamatrix-multiplication
retrofuture
retrofuture

Reputation: 53

Need help translating a Excel formula to R function - Looping / iterating to build a matrix

I have built this Excel formula, which takes values and builds a new matrix out of it.

However I am working in R and it's not very convenient to update the spreadsheet in Excel and import it into R later on.

My working excel code:

=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))

This is how a sample of my dataset looks like:

enter image description here

I have X groups (orange) and Y different items (green) with all one distinct value (blue).

A first step would be to just implement this formula in R.

A second would be, since I have several columns, to have an automatic for loop implemented that adds up to a final matrix that I need.

Any help appreciated!

head of my df (group = orange groups, Name = green, col_X = the values (blue) - in my excel example it's just one column).

 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

Upvotes: 0

Views: 522

Answers (1)

Daniel R
Daniel R

Reputation: 2042

This gets a lot easier if you think about this in "tidy long data format" instead of "matrix wide data format". If you use expand.grid(ColB=letters[1:6], Row3=letters[1:6]) you get all 36 combinations of a to f lower case letters, and from that you can make all calculations. The following code will return your intended outcome:

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')

will output

# 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

to apply this logic at the same time to multiple columns, you can turn your original data frame to long format, add the column name to the expand.grid like expand.grid(ColB=unique(base$Name), Row3=unique(base$Name), col=unique(base$col)), and include the column to the group_by used to calculate the max values.

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
    )
  )

then you can just filter whatever original column you are interested and it will output the matrix:

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')

which would output:

  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

Upvotes: 1

Related Questions