Index insurance¶
Introduction¶
Here we evaluate the same contract as in the previous chapter. But we use predicted yield from remote sensing instead of observed yield. That is, index insurance instead of “area_yield”.
First we predict yield for all years.
mods <- readRDS("rice_models.rds")
m1 <- mods$m1
idx <- agrodata::data_rice("indices")
idx$yield <- predict(m1, idx)
head(idx)
## region zone year ndvi evi gpp et lai
## 1 Northern_zone Maore N 2003 1.4206567 0.8657794 -696.7520 16.157267 39.73491
## 2 Northern_zone Maore N 2004 3.1310693 1.9807431 630.2755 13.138944 115.83244
## 3 Northern_zone Maore N 2005 2.4698370 1.9425927 -266.2523 24.803501 -53.02961
## 4 Northern_zone Maore N 2006 2.3945700 1.9158301 413.5486 9.404288 12.20075
## 5 Northern_zone Maore N 2007 0.9845668 0.1089129 -750.5597 -4.219634 -22.88956
## 6 Northern_zone Maore N 2008 1.0604903 0.6076455 929.0493 5.373560 -52.76833
## rain yield
## 1 689.2841 1439.311
## 2 629.2459 1586.212
## 3 543.0463 1486.967
## 4 492.0629 1562.221
## 5 935.5226 1433.355
## 6 768.3948 1619.286
We combine this with the household data
z <- readRDS("hh_rice_yield.rds")
z <- merge(z, idx[, c("zone", "year", "yield")])
head(z)
## zone year region fid y n y_zt y_z y_dz yield
## 1 Maore N 2003 Northern_zone 208 3000.000 13 1360 1600 0.85 1439.311
## 2 Maore N 2003 Northern_zone 228 1360.000 13 1360 1600 0.85 1439.311
## 3 Maore N 2003 Northern_zone 267 2560.000 13 1360 1600 0.85 1439.311
## 4 Maore N 2003 Northern_zone 275 1050.000 13 1360 1600 0.85 1439.311
## 5 Maore N 2003 Northern_zone 255 840.000 13 1360 1600 0.85 1439.311
## 6 Maore N 2003 Northern_zone 215 1923.077 13 1360 1600 0.85 1439.311
Now compute income with and without insurance.
We create an insurance payout function.
get_payout <- function(y, y_z, trigger, price){
pmax( (trigger * y_z) - y, 0) * price
}
And compute payouts.
price <- 0.23
premium <- 10
trigger <- 0.9
rho <- 1.5
z$income <- z$y * price
z$payout <- get_payout(z$yield, rho, trigger, price)
z$income_with_ins <- z$income + z$payout - premium
head(z)
## zone year region fid y n y_zt y_z y_dz yield income
## 1 Maore N 2003 Northern_zone 208 3000.000 13 1360 1600 0.85 1439.311 690.0000
## 2 Maore N 2003 Northern_zone 228 1360.000 13 1360 1600 0.85 1439.311 312.8000
## 3 Maore N 2003 Northern_zone 267 2560.000 13 1360 1600 0.85 1439.311 588.8000
## 4 Maore N 2003 Northern_zone 275 1050.000 13 1360 1600 0.85 1439.311 241.5000
## 5 Maore N 2003 Northern_zone 255 840.000 13 1360 1600 0.85 1439.311 193.2000
## 6 Maore N 2003 Northern_zone 215 1923.077 13 1360 1600 0.85 1439.311 442.3077
## payout income_with_ins
## 1 0 680.0000
## 2 0 302.8000
## 3 0 578.8000
## 4 0 231.5000
## 5 0 183.2000
## 6 0 432.3077
On to the certainty equivalent income. We compute it with and without insurance in one step
zz <- aggregate(z[, c("income", "income_with_ins")], z[,"zone", drop=FALSE], function(i) agro::ce_income(i, 1.5))
Now compute the benefit of insurance
zz$benefit <- (zz$income_with_ins - zz$income)
zz$rel_benefit <- zz$benefit/ zz$income
head(zz)
## zone income income_with_ins benefit rel_benefit
## 1 Maore N 157.2417 142.0214 -15.22030 -0.09679558
## 2 Maore SE 261.7988 251.7007 -10.09808 -0.03857191
## 3 Maore SW 193.5088 170.8489 -22.65982 -0.11709972
## 4 Ndungu E 253.1700 246.1525 -7.01757 -0.02771880
## 5 Ndungu N 301.5164 262.6818 -38.83461 -0.12879765
## 6 Ndungu S 214.4688 189.3386 -25.13014 -0.11717392
mean(zz$benefit)
## [1] -16.79514
Does the contract pass the test?
And plot it
quantile(zz$benefit)
## 0% 25% 50% 75% 100%
## -38.83461 -21.86450 -13.23622 -10.32365 -7.01757
barplot(sort(zz$rel_benefit), ylab="relative benefit", xlab="zone", las=1)