Search code examples
rnumerical-methods

How do I translate this maximization problem inside an equation to R?


fellow programmers. I'm studying a book on numerical solutions for economics (Judd 1998). I'm trying to reproduce a problem from that same book in R so I can use the optim package to see if I can get similar results.

The problem established by the author is this one: and his results were these.

I have tried to transcribe this problem to R, which resulted in this code chunk:

DisutilityJudd <- function(L){
  if(L == 0){
    return(0)
  }else{
    return(0.1)
  }
}

AgentUtilityJudd <- function(w, L){
  (-exp(-2*w) + 1) - DisutilityJudd(L)
}

reservation.utility.judd <- AgentUtilityJudd(1, 1)

MaxEffortUtility <- function(w1, w2, L = 1){
  0.8 * AgentUtilityJudd(w1, L) + 0.2 * AgentUtilityJudd(w2, L)
}

LeastEffortUtility <- function(w1, w2, L = 0){
  0.4 * AgentUtilityJudd(w1, L) + 0.6 * AgentUtilityJudd(w2, L)
}

UtilityDifferenceJudd <- function(w1, w2){
  MaxEffortUtility(w1, w2) - LeastEffortUtility(w1, w2)
}

PenaltyFunctionJudd <- function(w1, w2, P = 100000){
  if(length(w1) == 2){
    y <- -1 *  (0.8 * (2 - w1[1]) - 0.2 * w1[2] - P * 
                  (pmax(0, -MaxEffortUtility(w1[1], w1[1]) - reservation.utility.judd))^2 -
                  P * (pmax(0, -UtilityDifferenceJudd(w1[1], w1[1])))^2)
  }else{
    y <- -1 * (0.8 * (2 - w1) - 0.2 * w2 - P * 
                 (pmax(0, -MaxEffortUtility(w1, w2) - reservation.utility.judd))^2 -
                 P * (pmax(0, -UtilityDifferenceJudd(w1, w2)))^2)
  }
  return(y)
}

There were no errors, but the results generated by my code were nowhere near to what I was expecting:

optim(c(1.1, 0.5), PenaltyFunctionJudd)
$par
[1]  1.343909e+49 -2.370681e+51

$value
[1] -4.633849e+50

$counts
function gradient 
     501       NA 

$convergence
[1] 1

$message
NULL

Perhaps there is a problem to my penalty function. I'm assuming that it is due to the pmax function. Could somebody help me identify it? Thank you, I appreciate your attention.

Edit: a typo.


Solution

  • I believe you meant w1[2] in when if(length(w1) == 2) is true.

    I have modified your code, without touching how you define the previous function. It is not clear if it the result expected : what does IV(-1) mean, is it the result minus 1 ? a power if 10 ?

    PenaltyFunctionJudd <- function(w1, w2, P = 1e5){
    
            if(length(w1) > 1){
                    w2 <- w1[2]
                    w1 <- w1[1]
            }
            # cat("length is 2 \n")
    
            y <- 0.8 * (2 - w1) - 0.2 * w2 - P *
                    ( pmax(0, -MaxEffortUtility(w1, w2) - reservation.utility.judd) )^2 -
                    P * ( pmax(0, -UtilityDifferenceJudd(w1, w2)) )^2
    
            # cat("pmax1 :", pmax(0, -MaxEffortUtility(w1, w2) - reservation.utility.judd), "\n")
            # cat("pmax2 :", pmax(0, -UtilityDifferenceJudd(w1, w2)), "\n")
    
            return(y)
    }
    
    optim(c(1.1, 0.5), PenaltyFunctionJudd, control = list(fnscale = -1) )
    optim(c(11, 5), PenaltyFunctionJudd, method = "BFGS", control = list(fnscale = -1, maxit = 100) )
    

    You can use cat or print to check your values (here I noticed some Inf and 0 the leaded me to notice code error).

    Friendly warning : provided you defined correctly the previous function, there is lot of instability in optimisation (problem badly set ? More penalty needed ?). Indeed when running twice or more the algorithm parameters fluctuate a lot...