---
title: 'Stat 210A: Exponential Tilting Demo'
output:
  html_document:
    df_print: paged
---

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)$.

```{r}
## 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$.

```{r}
## 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.

```{r}
## 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:

```{r}
## 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)$

```{r}
## 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))
```



