make_kl_fun: Build a KL-divergence point function for use with opt_des()

In optedr: Calculating Optimal and D-Augmented Designs for Single- and Multi-Factor Models

Build a KL-divergence point function for use with opt_des()

Description

Returns a function(x, beta2) computing the point KL divergence at design point x given rival parameters beta2. The result is passed to opt_des via the kl_fun argument, allowing discrimination between models with different family, dispersion, or mean structure without having to derive the formula manually.

Supported family pairs:

• Same family and same phi: any of "Normal", "Poisson", "Binomial", "Gamma". Uses the standard exponential-family cumulant formula.

• "Normal" vs "Normal" with phi1 != phi2: KL = \frac{1}{2}\bigl[\log(\phi_2/\phi_1) + \phi_1/\phi_2 + (\mu_1-\mu_2)^2/\phi_2 - 1\bigr].

• "Gamma" vs "Gamma" with different shape (k_i = 1/\phi_i): closed form involving digamma and lgamma.

For other cross-family pairs provide kl_fun directly.

Usage

make_kl_fun(
  family1,
  model1,
  params1,
  par_values1,
  family2 = family1,
  model2 = model1,
  params2 = params1,
  phi1 = 1,
  phi2 = phi1
)

Arguments

family1	character; reference distribution ("Normal", "Poisson", "Binomial" or "Gamma").
model1	formula; reference model mean function.
params1	character vector; parameter names in model1.
par_values1	numeric vector; nominal values for the reference parameters.
family2	character; rival distribution (default: same as family1).
model2	formula; rival model mean function (default: same as model1).
params2	character vector; rival parameter names (optimised internally). Default: same as params1.
phi1	positive numeric; dispersion of the reference (Normal: variance; Gamma: 1/\text{shape}).
phi2	positive numeric; dispersion of the rival (default: same as phi1).

Value

A function function(x, beta2) giving the point KL divergence. Works for both 1-D (x scalar) and multi-factor designs (x named numeric vector).

Examples

# Same family (Normal), different model structures
kl_fn <- make_kl_fun(
  "Normal",
  model1 = y ~ Vmax * x / (Km + x), params1 = c("Vmax", "Km"),
  par_values1 = c(2, 1),
  model2 = y ~ a * x, params2 = "a"
)
kl_fn(x = 1, beta2 = 0.5)


# Normal vs Normal with different variance (phi2 = 4)
kl_fn2 <- make_kl_fun(
  "Normal",
  model1 = y ~ a * exp(-b * x), params1 = c("a", "b"),
  par_values1 = c(1, 0.5), phi1 = 1,
  family2 = "Normal",
  model2 = y ~ c * exp(-d * x), params2 = c("c", "d"), phi2 = 4
)
opt_des("KL-Optimality",
        model = y ~ a * exp(-b * x), parameters = c("a", "b"),
        par_values = c(1, 0.5), design_space = c(0, 4),
        kl_fun = kl_fn2, rival_pars = c(1, 1),
        rival_lower = c(0.5, 0.8), rival_upper = c(2, 1.5))

optedr documentation built on June 23, 2026, 5:07 p.m.