CODEWITHSUNDEEP
rminimization
J. Díaz-Colunga
J. Díaz-Colunga

Reputation: 13

Solving an overdetermined system of non-linear equations while maximizing a different function

I'm having trouble trying to implement this in R. I have a user-defined, non-linear function that takes a vector x and gives another vector F as output. In addition, I have a second function L that takes the vector and gives a number as output (which is, in fact, related to the likelihood of x, but this is not relevant for the question). Here is how these functions could look like (I just made these up as an example):

F <- function(x) {
  c(
    exp(x[1]*(1-x[2])) / (exp(x[1]*(1-x[2])) + exp(x[3]*(1-x[4]))) - 0.2,
    exp(x[3]*(1-x[4])) / (exp(x[1]*(1-x[2])) + exp(x[3]*(1-x[4]))) - 0.8
    )
}

L <- function(x) {
  0.5^exp(x[1]*abs(x[4]-x[2]))
}

On one hand, I want to find the values of x that minimize F (i.e. I want to solve F(x)=0), but that's not all. First, the system F(x)=0 is always overdetermined. What I want to do is to find the solution with the maximum L(x) out of all the possible ones. I thought I could try to just minimize something like sum(F(x)) + 1/L(x), but I see a few problems with this (for instance, the scales of F and L can be very different and I don't know them beforehand).

If anyone knew a way to approach this it would be awesome. Thanks in advance!

J

Upvotes: 0

Views: 208

Answers (1)

Emmanuel Hamel
Emmanuel Hamel

Reputation: 2213

You can consider the following approach :

library(DEoptim)

fn_Opt <- function(x, bool_Print = FALSE)
{
  term1 <- (exp(x[1] * (1 - x[2])) / (exp(x[1] * (1 - x[2])) + exp(x[3] * (1 - x[4]))) - 0.2) 
  term2 <- (exp(x[3] * (1 - x[4])) / (exp(x[1] * (1 - x[2])) + exp(x[3] * (1 - x[4]))) - 0.8) 
  term3 <- (0.5 ^ exp(x[1] * abs(x[4] - x[2])))
  val_Ret <- term1 + term2 - term3
  
  if(bool_Print == TRUE)
  {
    print("term1")
    print(term1)
    print("term2")
    print(term2)
    print("term3")
    print(term3)
  }
  
  if(is.nan(val_Ret))
  {
    return(10 ^ 30)
    
  }else
  {
    return(val_Ret)
  }
}

obj_DEoptim <- DEoptim(fn = fn_Opt, lower = rep(0, 4), upper = rep(1, 4), control = list(itermax = 1000))
fn_Opt(x = obj_DEoptim$optim$bestmem, bool_Print = TRUE)

It seems that there is more than one solution to this problem.

Upvotes: 0

Related Questions