Stat 210A: Exponential Tilting Demo

This notebook illustrates what it means to “exponentially tilt” a carrier measure \(h(x)\) toward a linear combination of sufficient statistics \(T(x) \in \mathbb{R}^s\).

We will start off with the carrier density \(h(x) = 1 - |x|\) on the set \(\mathcal{X} = [-1, 1]\) (which we will numerically approximate with a fine grid of equally spaced points). Note that \(h(x)\) is a probability density function so we can write \(p_0(x) = h(x)\).

## Inputs: 
##   p0:          carrier density, evaluated at a fine grid of points (n-vector)
##   suff.stats:  sufficient statistics, evaluated at the same points (n x s matrix)
##   nat.params:  natural parameters
## Output:
##   p_eta, evaluated at the same points
exp.fam <- function(p0, suff.stats, nat.params) {
  p <- exp(suff.stats %*% nat.params) * p0
  norm.const <- sum(p)/sum(p0)     ## Assumes p0 is a probability density
  p / norm.const
}
## Inputs:
##   x.grid:  grid of points at which to plot densities
##   rest same as above
## Output:
##   creates plot showing p0 and its exponential tilt p_eta
plot.exp.fam <- function(x.grid, p0, suff.stats, nat.params) {
  p.eta <- exp.fam(p0, suff.stats, nat.params)
  plot(x.grid, p0, type="l",ylim=c(0,1.01*max(c(p0,p.eta))),
       lty=2,ylab="density",xlab="x",yaxs="i",xaxs="i",
       main=bquote("Exponential tilt:"~eta == "("~.(paste(nat.params, collapse=", "))~")")
       )
  lines(x.grid, p.eta)
  legend("topright", bty="n", lty=c(2,1),
         legend=c(expression(p[0](x),p[eta](x))))
}
## Triangle density
x.grid <- seq(-1,1,by=.001)
p0 <- 1-abs(x.grid)

We begin by using the sufficient statistics \(T_1(x) = x\) and \(T_2(x) = x^2\).

## X, X^2 ~~> natural parameters shift first two moments
suff.stats <- cbind(x.grid, x.grid^2)

By leaving \(\eta_2 = 0\) and taking \(\eta_1\) positive or negative, we tilt to the right or left respectively.

## Tilt to the right or left
plot.exp.fam(x.grid, p0, suff.stats, c(.5,0))

plot.exp.fam(x.grid, p0, suff.stats, c(4,0))

plot.exp.fam(x.grid, p0, suff.stats, c(-2,0))

By making \(\eta_2\) positive or negative we can tilt to the outside or inside, respectively:

## Outside / inside
plot.exp.fam(x.grid, p0, suff.stats, c(0,-2))

plot.exp.fam(x.grid, p0, suff.stats, c(0,4))

plot.exp.fam(x.grid, p0, suff.stats, c(.5,2))

\(X\) and \(X^2\) are two natural examples of sufficient statistics but we can try something more exotic, such as a “wiggly” function like \(T_3(X) = \cos(100X)\)

## add a "wiggly" natural parameter
suff.stats <- cbind(x.grid, x.grid^2, cos(100*X))
plot.exp.fam(x.grid, p0, suff.stats, c(-1,2,.1))