R. Run optimization function in data frame

Question

I have a data frame df1 in R that looks like this (all values were chosen randomly but approximate values from real data):

A B    C    D   E   F      G     H
a 0.04 0.01 50  70  0.01   ...   0.0002
b 0.03 0.1  49  69  0.01   ...   0.0003
c 0.03 0.02 51  71  0.005  ...   0.004
d 0.04 0.02 50  70  0.006  ...   0.0005

G is obtained in this way:

# Equation 1:

G = (B - C)^2 - B*(1 - B)/(D- 1) - C*(1 - C)/(E - 1)

library(dplyr)
df2 = df1 %>% mutate(G = (B - C)^2 - B*(1 - B)/(D- 1) - C*(1 - C)/(E - 1))

I want to create a new column G1 applying an optimization function in each row.

G1 is obtained using equation 1, but replacing B by H. H is obtained using Equation 2:

# Equation 2:

H = (B - z*F)/(1 - z)

I would like to create a new column Z, with the value of z, ranging from 0 to 1 (step=0.01) which produces the lowest G1.

I expect to get something like this:

A B    C    D   E   F      G     H      G1  Z
a 0.04 0.01 50  70  0.01   ...   0.0002 ... ...
b 0.03 0.1  49  69  0.01   ...   0.0003 ... ...
c 0.03 0.02 51  71  0.005  ...   0.004  ... ...
d 0.04 0.02 50  70  0.006  ...   0.0005 ... ...

EDIT: (clarification)

My question is how to find the z that produces the lowest G1 given H (and the conditions referred above) and also get G1.

Answer 1

Add the z column, make the calculation, find the minimum within each group. As in the question Cross join with dplyr we add a dummy column to join on to make a cross join.

df2 %>% mutate(cj = 1) %>%
  full_join(data.frame(cj = 1, z = seq(0, 1, by = 0.01)) %>%
  select(-cj) %>%
  mutate(H = (B - z*F)/(1 - z),
         G1 = (H - C)^2 - H*(1 - H)/(D- 1) - C*(1 - C)/(E - 1)) %>%
  group_by(A, B, C, D, E, F) %>%
  arrange(G1) %>%
  slice(1)

Answer 2

Consider looping through multiples of 0.01 from 0.01 to 1 through your G1 function with all other parameters supplied by data frame. Then take the minimum of the returned vector of values.

Specifically, you can set up a function that passes in the row wise values using mapply (the elementwise iterator function) and returns the minimum for z value.

Data (F is changed to F_ to avoid issues with FALSE)

txt <- "A B    C    D   E   F_
a 0.04 0.01 50  70  0.01  
b 0.03 0.1  49  69  0.01  
c 0.03 0.02 51  71  0.005 
d 0.04 0.02 50  70  0.006"

df <- read.table(text=txt, header=TRUE)

Function

main <- function(B_param, C_param, D_param, E_param, F_param) {

  # EXTENDED G1 FUNCTION (WITH HELPER H)
  func <- function(z) {
    H <- (B_param - z*F_param)/(1 - z)
    G1 <- (H - C_param)^2 - H*(1 - H)/(D_param- 1) - C_param*(1 - C_param)/(E_param - 1)
  }

  # ITERATE THROUGH 0.01 MULTIPLES 
  tmp <- sapply(seq(0.01, 0.99, 0.01), func)

  # RETURN Z AT THE MINIMUM OF VECTOR OF VALUES
  min_z <- seq(0.01, 0.99, 0.01)[which.min(tmp)]

  return(min_z)
}

Data frame call (using base's within to add new columns)

final_df <- within(df, {

  G <- (B - C)^2 - B*(1 - B)/(D- 1) - C*(1 - C)/(E - 1)

  # CALCULATE z BY PASSING COLUMN VALUES ELEMENTWISE
  z <- mapply(main, B, C, D, E, F_)
  H <- (B - z*F_)/(1 - z)
  G1 <- (H - C)^2 - H*(1 - H)/(D- 1) - C*(1 - C)/(E - 1)      
})

options(scipen=999)

# RE-ORDER COLUMNS
final_df[order(names(final_df))]
#   A    B    C  D  E    F_              G             G1          H    z
# 1 a 0.04 0.01 50 70 0.010 -0.00002715173 -0.00001456576 0.04030303 0.01
# 2 b 0.03 0.10 49 69 0.010  0.00297022059 -0.00326311275 0.11000000 0.80
# 3 c 0.03 0.02 51 71 0.005 -0.00076200000 -0.00076163193 0.03025253 0.01
# 4 d 0.04 0.02 50 70 0.006 -0.00066773144 -0.00066032187 0.04034343 0.01