utility <- function(x,params){
if (params$CRRA != 1){
floor.x <- x # copy actual consumption (can be negative) into floored consumption
floor.x[x < params$cutoff] <- params$cutoff # replace consumption below cutoff with cutoff
diff.cons <- x - floor.x # difference between actual and floored consumption
tmp.x <- floor.x^(1-params$CRRA)
gradient of utility:
du.dx <- tmp.x/floor.x
hessian of utility:
ddu.dxx <- -params$CRRA*du.dx/floor.x
third derivative of u:
dddu.dxxx <- -(1+params$CRRA)*ddu.dxx/floor.x
CRRA utility at floor.x:
util <- (tmp.x - 1)/(1-params$CRRA)
} else {
floor.x <- x
floor.x[x < params$cutoff] <- params$cutoff # replace consumption below cutoff with cutoff
diff.cons <- x - floor.x # difference between actual and floored consumption
util <- log(floor.x) # u(cons)
du.dx <- 1/floor.x # u'(cons)
ddu.dxx <- -1/floor.x^2 # u"(cons)
dddu.dxxx <- 2/floor.x^3 # u'''(cons)
}
if
return.util <- util + du.dx*diff.cons + 0.5*ddu.dxx*diff.cons^2 + 1/6*dddu.dxxx*diff.cons^3
return.grad <- du.dx + ddu.dxx*diff.cons + 0.5*dddu.dxxx*diff.cons^2
return.hess <- ddu.dxx + dddu.dxxx*diff.cons
if (params$diag.plot){
par(mfcol=c(3,2))
plot(x=x,return.util,type="l",main="approx. utility",xlab="consumption",ylab="utility")
abline(v = params$cutoff,col="red")
grid()
plot(x=x,return.grad,type="l",main="approx. gradient",xlab="consumption",ylab="gradient")
abline(v = params$cutoff,col="red")
grid()
plot(x=x,return.hess,type="l",main="approx. hessian",xlab="consumption",ylab="hessian")
abline(v = params$cutoff,col="red")
grid()
plot(x=x,util,type="l",main="capped utility",xlab="consumption",ylab="capped utility")
grid()
plot(x=x,du.dx,type="l",main="capped gradient",xlab="consumption",ylab="capped gradient")
grid()
plot(x=x,ddu.dxx,type="l",main="capped hessian",xlab="consumption",ylab="capped hessian")
grid()
par(mfcol=c(1,1))
}
return list of values
return(list(utility=return.util,gradient=return.grad,hessian=return.hess))
}