Home > Net >  How to find optimum
How to find optimum

Time:09-03

I have this dataframe

product = data.frame(length = c(100, 200, 300, 400), qty = c(1, 2, 1, 3)) 

And price is defined by this equation (product[["length"]] * old_const * 2) setup_price where old_const = 0.0158 and setup_price = 20.8

product[["old_price"]] = (product[["length"]] * old_const * 2)   setup_price

And I would like to get rid of constat setup_price by increasing old_const and get new_const which multiply prices and keep my revenues which is:

rev1 = sum((product[["length"]] * old_const * 2    setup_price)* product[["qty"]]) 

So I would like to find rev1 - rev2 = 0

sum((product[["length"]] * old_const * 2    setup_price)* product[["qty"]]) - sum((product[["length"]] * old_const * 2)* product[["qty"]]) = 0

I generated new const like const = seq(from = 0.0158, to = 0.018, by = 0.00000001)

And loop new constant to my equation

eval = NULL
diff = NULL

    for(j in 1:length(const)){
        
        eval[j] = sum(((product[["length"]] * const[j] * 2 ))* product[["qty"]])
        diff[j] = rev1 - eval[j]
      }
    plot(const, diff)

I can see there is a value of const which get some value close to zero, but I don't know how to get exact value of const?

Any suggestion? If someone would know more elegant way I would be grateful for any help.

CodePudding user response:

Write a function with the formula in the for loop and use uniroot to find its root.

product <- data.frame(length = c(100, 200, 300, 400), qty = c(1, 2, 1, 3))

old_const <- 0.0158 
setup_price <- 20.8
rev1 <- sum((product[["length"]] * old_const * 2    setup_price)* product[["qty"]]) 

fun <- function(x, data, rev1) {
  rev1 - 2 * x * sum(data[["length"]] * data[["qty"]])
}

sol <- uniroot(fun, c(0, 1), product, rev1 = rev1)

ev <- sum(((product[["length"]] * sol$root * 2 ))* product[["qty"]])
rev1 - ev
#> [1] -2.842171e-14

Created on 2022-09-02 by the reprex package (v2.0.1)

The function evaluated at sol$root is zero, give or take floating-point precision.

  • Related