Apply two different formulas on four data frame columns

Viewed 79

I want to apply two different formulas on four columns of my dataframe df. I have done this manually, but since my original data frame has several columns, I want to be able to use loops or case when to do this faster.

Here's how sample dataframe df looks like:

A   B   C  D
20  100 4  1200
40  150 6  2300 
34  200 3  1230
32  225 9  1100
12  220 10 1000

Formula 1:

(x-max(x))/(max(x)-min(x))

Formula 2:

(min(x)-x)/(max(x)-min(x))

I'd like to apply formula 1 on columns B and D and formula 2 on columns A and C.

After applying the formula, I want to store the values in a different dataframe but with the same column names.

Here's what I did:

formula_1 <-function(x) {
  (((x - min(x)))/(max(x) - min(x))) 
}

    formula_2 <-function(x){(min(x)-x)/(max(x)-min(x))
}

Create an empty dataframe BI_score
BI_score$B <- formula_1(df$B)
BI_score$D <- formula_1 (df$D)
BI_score$A <- formula_2 (df$A)
BI_score$C <- formula_2 (df$C)    
3 Answers

EDIT

As there are some NAs and Inf values and if we want to exclude them from calculation, we can handle it by updating the function as below and then apply the function to column as shown previously.

formula_1 <-function(x) {
   temp <- x[is.finite(x)]
   replace(x, is.finite(x), (((temp - min(temp)))/(max(temp) - min(temp))))
}

formula_2 <-function(x) {
   temp <- x[is.finite(x)]
   replace(x, is.finite(x), (min(temp)-temp)/(max(temp)-min(temp)))
}

The most straight forward approach would be to use lapply to apply the function separately on selected columns.

BI_score <- df
fm1_cols <- c("B", "D")
fm2_cols <- c("A", "C")
BI_score[fm1_cols] <- lapply(df[fm1_cols], formula_1)
BI_score[fm2_cols] <- lapply(df[fm2_cols], formula_2)


BI_score
#      A    B     C     D
#1 -0.29 0.00 -0.14 0.154
#2 -1.00 0.40 -0.43 1.000
#3 -0.79 0.80  0.00 0.177
#4 -0.71 1.00 -0.86 0.077
#5  0.00 0.96 -1.00 0.000

As mentioned by @Sotos, if you want to apply the function on alternate columns you could do

BI_score[c(TRUE, FALSE)] <- lapply(df[c(TRUE, FALSE)], formula_1)
BI_score[c(FALSE, TRUE)] <- lapply(df[c(FALSE, TRUE)], formula_2)

Just for fun, approach using dplyr

library(dplyr)

bind_cols(df %>% select(fm1_cols) %>% mutate_all(formula_1), 
          df %>% select(fm2_cols) %>% mutate_all(formula_2))

If your goal is to apply the two functions on alternating columns, then you can do it via logical indexing

cbind.data.frame(sapply(df[c(TRUE, FALSE)], formula_2),  
                 sapply(df[c(FALSE, TRUE)], formula_1))


#           A          C    B          D
#1 -0.2857143 -0.1428571 0.00 0.15384615
#2 -1.0000000 -0.4285714 0.40 1.00000000
#3 -0.7857143  0.0000000 0.80 0.17692308
#4 -0.7142857 -0.8571429 1.00 0.07692308
#5  0.0000000 -1.0000000 0.96 0.00000000

We can use mutate_at from dplyr

library(dplyr)
df1 %>%
    mutate_at(vars(B, D), formula_1) %>%
    mutate_at(vars(A, C), formula_2)
Related