juanfung / frbca

Other
0 stars 0 forks source link

Allow variable economic parameters for BCA #9

Closed juanfung closed 1 month ago

juanfung commented 9 months ago

Currently, loss computations for economic parameters provided via input list (ie, displacement, business_income, rental_income, and sc) are hard-coded:

pv_loss <- function(model, p) {
    ## Purpose:
    ## Calculate losses for each model
    return(
        model %>%
        ## NB: assumes total_area column has been created
        dplyr::mutate(
                   displacement=p$displacement*p$tenant*re_occupancy_time*total_area,
                   business_income=(1 - p$recapture)*p$bi*functional_recovery_time*total_area,
                   rental_income=p$ri*functional_recovery_time*total_area
               ) %>%
        dplyr::mutate(sc=(p$sc * business_income))
        )
}

To allow flexibility:

  1. the input list should include an econ sub-list with desired economic parameters
  2. the computations would iterate through the named econ sub-list and extract the names from the list
juanfung commented 6 months ago

Would also need to iterate through econ sub-list under sensitivity

juanfung commented 6 months ago

Implemented per https://github.com/juanfung/frbca/commit/ec9c2d885f79bc95709b75e6e4a8e7ecdfd826d3

...but could be improved. Leaving open for now

juanfung commented 4 months ago

Upon review, sensitivity and set_params can be redefined:

## OLD:
sensitivity <- function(model, params) {
    ## Purpose:
    ## Compute BCR and NPV, using low/high values of parameters
    ## --- ##
    ## get list of sensitivity parameters
    s <- params[['parameters']][['sensitivity']]
    ## store calculations
    m <- list()
    ## iterate low/high
    for (hi_low in c('low', 'high')) {
        ## iterate over parameters
        for (n in names(s)) {
          if (n == 'loss') {
            ss <- s[['loss']]
            for (nn in names(ss)) {
              p <- set_params(params, nn, bound=hi_low)
              m[[paste(nn, hi_low, sep='-')]] <- bcr(model, p, label=hi_low) |>
                dplyr::mutate(parameter=nn)
            }
          } else {
            p <- set_params(params, n, bound=hi_low)
            m[[paste(n, hi_low, sep='-')]] <- bcr(model, p, label=hi_low) |>
              dplyr::mutate(parameter=n)
          }
        }
    }
    return(dplyr::bind_rows(m))
}

## NEW:
sensitivity <- function(model, params) {
    ## Purpose:
    ## Compute BCR and NPV, using low/high values of parameters
    ## --- ##
    ## get list of sensitivity parameters
    s <- params[['parameters']][['sensitivity']]
    ## store calculations
    m <- list()
    ## iterate low/high
    for (hi_low in c('low', 'high')) {
        ## iterate over parameters
        for (n in names(s)) {
          if (n == 'loss') {
            ss <- s[['loss']]
            p <- params
            for (nn in names(ss)) {
              p[['loss']] <- set_params(params[['loss']], nn, bound=hi_low)
              m[[paste(nn, hi_low, sep='-')]] <- bcr(model, p, label=hi_low) |>
                dplyr::mutate(parameter=nn)
            }
          } else {
            p <- set_params(params, n, bound=hi_low)
            m[[paste(n, hi_low, sep='-')]] <- bcr(model, p, label=hi_low) |>
              dplyr::mutate(parameter=n)
          }
        }
    }
    return(dplyr::bind_rows(m))
}

Then removing the conditional in set_params:

## OLD:
set_params <- function(params, param, bound='low') {
    ## Purpose:
    ## Reset baseline parameter to one of {low, high}
    p <- params
    if (grepl('^loss', param)) {
    ## loss_names = names(p[['parameters']][['sensitivity']][['loss']])
    ## for (loss_name in loss_names) {
      p[['parameters']][['base']][['loss']][[param]] <- p[['parameters']][['sensitivity']][['loss']][[param]][[bound]]
    ## }
  } else {
    p[['parameters']][['base']][[param]] <- p[['parameters']][['sensitivity']][[param]][[bound]]
  }
    return(p)
}

## NEW:
set_params <- function(params, param, bound='low') {
    ## Purpose:
    ## Reset baseline parameter to one of {low, high}
    p <- params
    p[['parameters']][['base']][[param]] <- p[['parameters']][['sensitivity']][[param]][[bound]]
    return(p)
}

That won't exactly work but there should be a way to just pass the relevant part of params to be updated...

juanfung commented 1 month ago

Closing for now as above commits should provide flexible economic parameterization (by appending loss_ to any economic loss