Perform MAD calculation on two different columns of a dataframe in R

user_16336328 0
Viewed 59

Sample Data

date = seq(as.Date("2019/01/01"), by = "month", length.out = 48)
subproduct=rep("x",48)
actuals <- c(seq(1:29),rep(0,19))
m1 <- c(rep(0,24),seq(1:24))
m2<- c(rep(0,24),rep(10,24))
dfone <- data.frame(date,
                subproduct,
                actuals,m1,m2)

      date subproduct actuals m1 m2

Here is row 24-30 for the dfone

 date           subproduct  actuals m1 m2
24 2020-12-01          x      24  0  0
25 2021-01-01          x      25  1 10
26 2021-02-01          x      26  2 10
27 2021-03-01          x      27  3 10
28 2021-04-01          x      28  4 10
29 2021-05-01          x      29  5 10
30 2021-06-01          x       0  6 10

What I want to do is apply this formula onto row where there is numbers not 0 in all three columns (row 25-29) I want to take actuals at row 25

m1abs1 <- abs(25-1)
m1abs2<- abs(26-2)
m1abs3 <- abs(27-3)
m1abs4 <- abs(28-4)
m1abs5 <- abs(29-5)

m1MAD <- sum(m1abs1,m1abs2,m1abs3,m1abs4,m1abs5)/5
# 24

m2abs1 <- abs(25-10)
m2abs2<- abs(26-10)
m2abs3 <- abs(27-10)
m2abs4 <- abs(28-10)
m2abs5 <- abs(29-10)

m2MAD <- sum(m2abs1,m2abs2,m2abs3,m2abs4,m2abs5)/5
# 17

max(m1MAD,m2MAD)

Now that we have max, remove the column from dataframe that isn't the max so m2MAD in this case.

Question: Is there a way to do this in R more easily?

data-manipulation r
1 Answers

We can use if_all to filter the rows where there are no zeros in those columns, then summarise to return the max of mean of absolute deviations

library(dplyr)
dfone %>% 
    filter(if_all(actuals:m2, ~ . != 0)) %>% 
    summarise(MADmax = max(mean(abs(actuals - m1)), 
          mean(abs(actuals - m2))))

-output

   MADmax
1     24

If we want to remove the column which is not the max

dfone %>% 
     filter(if_all(actuals:m2, ~ . != 0)) %>% 
     summarise(nm1 = c('m1', 'm2')[which.max(c(mean(abs(actuals - m1)), 
           mean(abs(actuals - m2))))]) %>%
      pull(nm1) %>% setdiff(names(dfone), .) -> tmp
dftwo <- dfone %>%
    select(all_of(tmp))

Or another option is

library(tidyr)
library(magrittr)
dfone %>% 
   filter(if_all(c(actuals, matches('^m\\d+')), ~ . != 0))  %>% 
   summarise(across(matches('^m\\d+'), ~ mean(abs(actuals - .)))) %>% 
   pivot_longer(everything()) %>%
   filter(value != max(value)) %$% 
   select(dfone, -all_of(name))

Or using base R with subset and rowSums to create a logical vector to subset and get the max of 'MAD'

with(subset(dfone, !rowSums(dfone[c('actuals', 'm1', 'm2')] == 0)), 
       max(mean(abs(actuals - m1)), 
           mean(abs(actuals - m2))))
[1] 24
user_37322710
Related