## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----setup--------------------------------------------------------------------
library(tempodisco)

## -----------------------------------------------------------------------------
indiff_fn <- function(data, p) {
  k <- p['c'] * data$val_del^p['m']
  1 / (1 + k * data$del)
}

## -----------------------------------------------------------------------------
par_lims <- list(c = c(0, Inf))

## -----------------------------------------------------------------------------
par_starts <- list(m = c(-1, 0, 1),
                   c = c(-10, -5, -1))

## -----------------------------------------------------------------------------
ED50_fn <- function(p, val_del) {
  k <- p['c'] * val_del^p['m']
  1 / k
}

## -----------------------------------------------------------------------------
custom_discount_function <- td_fn(name = 'hyp-mag-eff',
                                  fn = indiff_fn,
                                  par_starts = par_starts,
                                  par_lims = par_lims,
                                  ED50 = ED50_fn)
print(custom_discount_function)

## -----------------------------------------------------------------------------
data("td_bc_single_ptpt")
mod <- td_bcnm(td_bc_single_ptpt, discount_function = custom_discount_function)
print(mod)

## -----------------------------------------------------------------------------
dsh <- td_fn(name = 'dual-systems-hyperbolic',
             fn = function(data, p) {
               p['w'] * 1/(1 + p['k1']*data$del) + (1 - p['w']) * 1/(1 + p['k2']*data$del)
             },
             par_starts = list(k1 = c(0.001, 0.0001),
                               k2 = c(0.1, 0.01),
                               w = 0.5),
             par_lims = list(w = c(0, 1),
                             k1 = c(0, Inf),
                             k2 = c(0, Inf)),
             par_chk = function(p) {
               # Ensure k1 < k2
               if (p['k1'] > p['k2']) {
                 # Switch k1 and k2
                 k2 <- p['k1']
                 k1 <- p['k2']
                 p['k1'] <- k1
                 p['k2'] <- k2
                 # Complement of w
                 p['w'] <- 1 - p['w']
               }
               return(p)
             })
print(dsh)

## -----------------------------------------------------------------------------
mod <- td_bcnm(td_bc_single_ptpt, discount_function = dsh)
print(mod)