Go to the RMD, R, PDF, or HTML version of this file. Go back to fan’s REconTools research support package, R4Econ examples page, PkgTestR packaging guide, or Stat4Econ course page.
We have a function \(f(\mu)\), we know that \(a\le \mu \le b\), and we want to find the value of \(\mu\) that maximizes \(f(\mu)\) within the bounds. The same idea here is used in various aspects of solving the dynamic equilibrium borrowing and savings problem in Wang (2022) (preprint pdf).
First, we create a simple quadratic function. the minimum of the function is where \(\mu = -2\)
# Define Function
ffi_quad_func <- function(fl_mu) {
1 + (fl_mu + 2)^2
}
# Test Function
print(paste0("ffi_quad_func(-3)=", ffi_quad_func(-3)))
## [1] "ffi_quad_func(-3)=2"
print(paste0("ffi_quad_func(-2)=", ffi_quad_func(-2)))
## [1] "ffi_quad_func(-2)=1"
print(paste0("ffi_quad_func(-1)=", ffi_quad_func(-1)))
## [1] "ffi_quad_func(-1)=2"
Second, we develop the maximizer function given grid.
# Function
ffi_find_min <- function(fl_min = -4, fl_max = 2, it_grid_len = 7) {
# Construct grid where to evaluate the function
ar_fl_mu <- seq(fl_min, fl_max, length.out = it_grid_len)
# Evaluate likelihood
ar_obj <- sapply(ar_fl_mu, ffi_quad_func)
# Find min grid
it_min_idx <- which.min(ar_obj)
fl_min_val <- ar_obj[it_min_idx]
# Find lower and upper bound
fl_min_new <- ar_fl_mu[max(it_min_idx - 1, 1)]
fl_max_new <- ar_fl_mu[min(it_min_idx + 1, it_grid_len)]
# return
return(list(
fl_min_val = fl_min_val,
fl_min_new = fl_min_new,
fl_max_new = fl_max_new
))
}
# Test Function
print("ffi_find_min(-3,-1,10)")
## [1] "ffi_find_min(-3,-1,10)"
print(ffi_find_min(-3, -1, 10))
## $fl_min_val
## [1] 1.012346
##
## $fl_min_new
## [1] -2.333333
##
## $fl_max_new
## [1] -1.888889
# Test function if lower bound is actual min
print("ffi_find_min(-2,-1,10)")
## [1] "ffi_find_min(-2,-1,10)"
print(ffi_find_min(-2, -1, 10))
## $fl_min_val
## [1] 1
##
## $fl_min_new
## [1] -2
##
## $fl_max_new
## [1] -1.888889
# Test function if upper bound is actual min
print("ffi_find_min(-3,-2,10)")
## [1] "ffi_find_min(-3,-2,10)"
print(ffi_find_min(-3, -2, 10))
## $fl_min_val
## [1] 1
##
## $fl_min_new
## [1] -2.111111
##
## $fl_max_new
## [1] -2
Third, we iterately zoom-in to ever finer grid around the point in the last grid where the objective function had the lowest value.
# Initialize min and max and tolerance criteria
fl_min_cur <- -10
fl_max_cur <- 10
it_grid_len <- 10
fl_tol <- 1e-5
it_max_iter <- 5
# Initialize initial gaps etc
fl_gap <- 1e5
fl_min_val_last <- 1e5
it_iter <- 0
# Iteratively loop over grid to find the maximum by zooming in
while ((fl_gap > fl_tol) && it_iter <= it_max_iter) {
# Iterator counts up
it_iter <- it_iter + 1
print(paste0("it_iter=", it_iter))
# build array
ls_find_min <- ffi_find_min(
fl_min = fl_min_cur, fl_max = fl_max_cur, it_grid_len = it_grid_len
)
# Min objective value current
fl_min_val <- ls_find_min$fl_min_val
# Find new lower and upper bound
fl_min_cur <- ls_find_min$fl_min_new
fl_max_cur <- ls_find_min$fl_max_new
print(paste0("fl_min_cur=", fl_min_cur))
print(paste0("fl_max_cur=", fl_max_cur))
# Compare
fl_gap <- abs(fl_min_val - fl_min_val_last)
fl_min_val_last <- fl_min_val
print(paste0("fl_gap=", fl_gap))
}
## [1] "it_iter=1"
## [1] "fl_min_cur=-3.33333333333333"
## [1] "fl_max_cur=1.11111111111111"
## [1] "fl_gap=99998.2098765432"
## [1] "it_iter=2"
## [1] "fl_min_cur=-2.34567901234568"
## [1] "fl_max_cur=-1.35802469135802"
## [1] "fl_gap=0.768175582990399"
## [1] "it_iter=3"
## [1] "fl_min_cur=-2.12620027434842"
## [1] "fl_max_cur=-1.90672153635117"
## [1] "fl_gap=0.0216769123947906"
## [1] "it_iter=4"
## [1] "fl_min_cur=-2.02865416857186"
## [1] "fl_max_cur=-1.97988111568358"
## [1] "fl_gap=0.00025274863560476"
## [1] "it_iter=5"
## [1] "fl_min_cur=-2.00697725617707"
## [1] "fl_max_cur=-1.99613879997968"
## [1] "fl_gap=1.57853178373024e-05"
## [1] "it_iter=6"
## [1] "fl_min_cur=-2.00095589162296"
## [1] "fl_max_cur=-1.99854734580132"
## [1] "fl_gap=2.36575822887275e-06"