## ----d1-----------------------------------------------------------------------
d <- readRDS("pred_mort2.rds")


## ----d2-----------------------------------------------------------------------
d$predicted_mortality[d$NDVI > 0.1] <- 0.1


## ----d3-----------------------------------------------------------------------
trigger <- quantile(d$predicted_mortality, 0.8)
round(trigger, 2)


## ----d4-----------------------------------------------------------------------
tndvi <- max(d$NDVI[d$predicted_mortality > trigger])
round(tndvi, 2)


## ----d5-----------------------------------------------------------------------
d$pay <- pmax(0, d$predicted_mortality - trigger)

plot(d$NDVI, d$pay, cex=.1, xlab="NDVI", ylab="payout")


## ----d6-----------------------------------------------------------------------
boxplot(pay~year, data=d)


## ----d7-----------------------------------------------------------------------
nd <- d[d$NDVI < tndvi, ]
m <- lm(pay ~ NDVI, data=nd)
plot(pay ~ NDVI, data=nd, cex=.1)
abline(m, col="red")
cf <- coefficients(m)
cf


## ----dd8----------------------------------------------------------------------
payout <- function(zNDVI) {
  pmax(0, -0.24 + -0.2675 * zNDVI)
}  

zndvi <- seq(-3, 2, .1)
plot(zndvi, payout(zndvi), type="l", col="red")


## ----d8-----------------------------------------------------------------------
# need to adjust for payout scale (not TLUs?)
epay <- function(zNDVI, trigger=-0.842, exit=-2.326, frac=0.5) {
  zNDVI <- pmax(zNDVI, exit)
  frac * pmax( 0, (trigger-zNDVI) / (trigger-exit) )
}

plot(zndvi, epay(zndvi), type="l")


## ----d10----------------------------------------------------------------------
plot(zndvi, epay(zndvi), col="blue", type="l", lwd=2)
lines(zndvi, payout(zndvi), type="l", col="red", lwd=2, lty=2)
legend("topright", c("contract", "epay"), col= c("red", "blue"), lty=c(2,1), lwd=2)