For predicting whether the agricultural epidemic of powdery mildew in mango will erupt in a certain year in the state of Uttar Pradesh in India, Misra et al. (2004) used annual outbreak 9 A. K. Misra, O. M. Prakash, and V. Ramasubramanian. Forewarning powdery mildew caused by Oidium mangiferae in mango (Mangifera indica) using logistic regression models. Indian Journal of Agricultural Science, 74(2):84-87, 2004 records during 1987-2000. The epidemic typically occurs in the third and fourth week of March, and hence outbreak status is known by the end of March of a given year. The authors used a logistic regression model with two weather predictors (maximum temperature and relative humidity) to forecast an outbreak. The data is shown in the table below and are available in PowderyMildewEpidemic.xls.

library(pander)
library(forecast)
library(caret)
library(dplyr)
setwd("/Users/Chris Iyer/Documents/")
mildew <- read.csv("PowderyMildewEpidemic.csv")

mildew <- mildew %>% mutate(Outbreak1 = ifelse(Outbreak == "Yes", 1,0))
pander(mildew)
length(mildew)

Is the mildew following a trend?

mildew.ts <- ts(mildew$RelHumidity, start = 1987, frequency = 1)
plot(mildew.ts)

** Question: 1. In order for the model to serve as a forewarning system for farmers, what requirements must be satisfied regarding data availability?**

Answer: In order to generate a forecast using logistic regression, the measurement of the object of interest can either be numerical or binary, however since the forecast is binary, if the object of interest is numerical, the forecaster has to create a derived variable. In the case of predicting whether the powdery mildew will occur in Uttar Pradesh, India, we are given a dataset with the measurements of two predictor variables and a binary yes/no for the outbreak outcome. The outbreak variable has to be converted to a 0,1 for no/yes outcomes. The 0,1 is the derived variable.

  1. Write an equation for the model fitted by the researchers in the form of equation (8.1). Use predictor names instead of x notation.

\(log(odds(Mildew)_t=\beta_0 + \beta_{mildew_{t-1}} + \beta_{humidity_{t-1}} + \beta_{maxTemp_{t-1}}\)

  1. Create a scatter plot of the two predictors, using different hue for epidemic and non-epidemic markers. Does there appear to be a relationship between epidemic status and the two predictors?
plot(mildew$MaxTemp ~ mildew$RelHumidity, xlab = "Relative Humidity", ylab = "Max Temp (degrees Celsius)", col = mildew$Outbreak1 + 1, bty = "l", pch = 15)
legend(60,29, c("No Outbreak", "Outbreak"), col = 1:2, pch = 15, bty = "l")

plot(mildew$RelHumidity ~ mildew$MaxTemp, ylab = "Relative Humidity", xlab = "Max Temp (degrees Celsius)", col = mildew$Outbreak1 + 1, bty = "l", pch = 15)
legend(27,70, c("No Outbreak", "Outbreak"), col = 1:2, pch = 15, bty = "l")

  1. Compute naive forecasts of epidemic status for years 1995- 1997 using next-year forecasts (Ft+1 = Ft). What is the naive forecast for year 2000? Summarize the results for these four years in a classification matrix. Use a roll forward naive forecast. Use roll fwd.
naiveForecasts <- mildew$Outbreak1[(length(mildew$Outbreak1)-1-3) : (length(mildew$Outbreak1)-1)]
class(naiveForecasts)
[1] "numeric"
confusionMatrix(naiveForecasts, mildew$Outbreak1[(length(mildew$Outbreak1)-3): length(mildew$Outbreak1)], positive = c("1"))
Confusion Matrix and Statistics

          Reference
Prediction 0 1
         0 1 1
         1 2 0
                                          
               Accuracy : 0.25            
                 95% CI : (0.0063, 0.8059)
    No Information Rate : 0.75            
    P-Value [Acc > NIR] : 0.9961          
                                          
                  Kappa : -0.5            
 Mcnemar's Test P-Value : 1.0000          
                                          
            Sensitivity : 0.0000          
            Specificity : 0.3333          
         Pos Pred Value : 0.0000          
         Neg Pred Value : 0.5000          
             Prevalence : 0.2500          
         Detection Rate : 0.0000          
   Detection Prevalence : 0.5000          
      Balanced Accuracy : 0.1667          
                                          
       'Positive' Class : 1               
                                          
  1. Partition the data into training and validation periods, so that years 1987-1994 are the training period. Fit a logistic regression to the training period using the two predictors, and report the outbreak probability as well as a forecast for year 1995 (use a threshold of 0.5).
trainOutMildew <- mildew[1:8,]
trainOutMildew

Fit a Logistic Regression Model

outLogRegMildew <- glm(Outbreak1 ~ MaxTemp + RelHumidity, data = trainOutMildew, family = "binomial")
summary(outLogRegMildew)

Call:
glm(formula = Outbreak1 ~ MaxTemp + RelHumidity, family = "binomial", 
    data = trainOutMildew)

Deviance Residuals: 
      1        2        3        4        5        6  
 0.7466  -1.7276  -0.3132   1.0552  -1.1419   1.2419  
      7        8  
-0.3908   0.6060  

Coefficients:
            Estimate Std. Error z value Pr(>|z|)
(Intercept) -56.1543    44.4573  -1.263    0.207
MaxTemp       1.3849     1.1406   1.214    0.225
RelHumidity   0.1877     0.1578   1.189    0.234

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 11.0904  on 7  degrees of freedom
Residual deviance:  8.1198  on 5  degrees of freedom
AIC: 14.12

Number of Fisher Scoring iterations: 5

Forecast

predictionsMildew <- predict(outLogRegMildew, mildew[9:12,],type = "response")
predictionsMildew
        9        10        11        12 
0.1119407 0.7021411 0.5705413 0.3894790 

Confusion Matrix for the Forecast

Cutoff value = 0.5

confusionMatrix(ifelse(predictionsMildew > 0.5, 1,0), mildew[9:12,]$Outbreak1, positive = c("1"))
Confusion Matrix and Statistics

          Reference
Prediction 0 1
         0 2 0
         1 1 1
                                          
               Accuracy : 0.75            
                 95% CI : (0.1941, 0.9937)
    No Information Rate : 0.75            
    P-Value [Acc > NIR] : 0.7383          
                                          
                  Kappa : 0.5             
 Mcnemar's Test P-Value : 1.0000          
                                          
            Sensitivity : 1.0000          
            Specificity : 0.6667          
         Pos Pred Value : 0.5000          
         Neg Pred Value : 1.0000          
             Prevalence : 0.2500          
         Detection Rate : 0.2500          
   Detection Prevalence : 0.5000          
      Balanced Accuracy : 0.8333          
                                          
       'Positive' Class : 1               
                                          
LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpGb3IgcHJlZGljdGluZyB3aGV0aGVyIHRoZSBhZ3JpY3VsdHVyYWwgZXBpZGVtaWMgb2YgcG93ZGVyeSBtaWxkZXcgaW4gbWFuZ28gd2lsbCBlcnVwdCBpbiBhIGNlcnRhaW4geWVhciBpbiB0aGUgc3RhdGUgb2YgVXR0YXIgUHJhZGVzaCBpbiBJbmRpYSwgTWlzcmEgZXQgYWwuICgyMDA0KSB1c2VkIGFubnVhbCBvdXRicmVhayA5IEEuIEsuIE1pc3JhLCBPLiBNLiBQcmFrYXNoLCBhbmQgVi4gUmFtYXN1YnJhbWFuaWFuLiBGb3Jld2FybmluZyBwb3dkZXJ5IG1pbGRldyBjYXVzZWQgYnkgT2lkaXVtIG1hbmdpZmVyYWUgaW4gbWFuZ28gKE1hbmdpZmVyYSBpbmRpY2EpIHVzaW5nIGxvZ2lzdGljIHJlZ3Jlc3Npb24gbW9kZWxzLiBJbmRpYW4gSm91cm5hbCBvZiBBZ3JpY3VsdHVyYWwgU2NpZW5jZSwgNzQoMik6ODQtODcsIDIwMDQgcmVjb3JkcyBkdXJpbmcgMTk4Ny0yMDAwLiBUaGUgZXBpZGVtaWMgdHlwaWNhbGx5IG9jY3VycyBpbiB0aGUgdGhpcmQgYW5kIGZvdXJ0aCB3ZWVrIG9mIE1hcmNoLCBhbmQgaGVuY2Ugb3V0YnJlYWsgc3RhdHVzIGlzIGtub3duIGJ5IHRoZSBlbmQgb2YgTWFyY2ggb2YgYSBnaXZlbiB5ZWFyLiBUaGUgYXV0aG9ycyB1c2VkIGEgbG9naXN0aWMgcmVncmVzc2lvbiBtb2RlbCB3aXRoIHR3byB3ZWF0aGVyIHByZWRpY3RvcnMgKG1heGltdW0gdGVtcGVyYXR1cmUgYW5kIHJlbGF0aXZlIGh1bWlkaXR5KSB0byBmb3JlY2FzdCBhbiBvdXRicmVhay4gVGhlIGRhdGEgaXMgc2hvd24gaW4gdGhlIHRhYmxlIGJlbG93IGFuZCBhcmUgYXZhaWxhYmxlIGluIFBvd2RlcnlNaWxkZXdFcGlkZW1pYy54bHMuDQoNCmBgYHtyfQ0KbGlicmFyeShwYW5kZXIpDQpsaWJyYXJ5KGZvcmVjYXN0KQ0KbGlicmFyeShjYXJldCkNCmxpYnJhcnkoZHBseXIpDQpzZXR3ZCgiL1VzZXJzL0NocmlzIEl5ZXIvRG9jdW1lbnRzLyIpDQptaWxkZXcgPC0gcmVhZC5jc3YoIlBvd2RlcnlNaWxkZXdFcGlkZW1pYy5jc3YiKQ0KDQptaWxkZXcgPC0gbWlsZGV3ICU+JSBtdXRhdGUoT3V0YnJlYWsxID0gaWZlbHNlKE91dGJyZWFrID09ICJZZXMiLCAxLDApKQ0KcGFuZGVyKG1pbGRldykNCmxlbmd0aChtaWxkZXcpDQoNCmBgYA0KDQoNCg0KSXMgdGhlIG1pbGRldyBmb2xsb3dpbmcgYSB0cmVuZD8NCg0KYGBge3J9DQptaWxkZXcudHMgPC0gdHMobWlsZGV3JFJlbEh1bWlkaXR5LCBzdGFydCA9IDE5ODcsIGZyZXF1ZW5jeSA9IDEpDQpwbG90KG1pbGRldy50cykNCg0KYGBgDQoNCioqIFF1ZXN0aW9uOiAxLiBJbiBvcmRlciBmb3IgdGhlIG1vZGVsIHRvIHNlcnZlIGFzIGEgZm9yZXdhcm5pbmcgc3lzdGVtIGZvciBmYXJtZXJzLCB3aGF0IHJlcXVpcmVtZW50cyBtdXN0IGJlIHNhdGlzZmllZCByZWdhcmRpbmcgZGF0YSBhdmFpbGFiaWxpdHk/KioNCg0KQW5zd2VyOiBJbiBvcmRlciB0byBnZW5lcmF0ZSBhIGZvcmVjYXN0IHVzaW5nIGxvZ2lzdGljIHJlZ3Jlc3Npb24sIHRoZSBtZWFzdXJlbWVudCBvZiB0aGUgb2JqZWN0IG9mIGludGVyZXN0IGNhbiBlaXRoZXIgYmUgbnVtZXJpY2FsIG9yIGJpbmFyeSwgaG93ZXZlciBzaW5jZSB0aGUgZm9yZWNhc3QgaXMgYmluYXJ5LCBpZiB0aGUgb2JqZWN0IG9mIGludGVyZXN0IGlzIG51bWVyaWNhbCwgdGhlIGZvcmVjYXN0ZXIgaGFzIHRvIGNyZWF0ZSBhIGRlcml2ZWQgdmFyaWFibGUuIEluIHRoZSBjYXNlIG9mIHByZWRpY3Rpbmcgd2hldGhlciB0aGUgcG93ZGVyeSBtaWxkZXcgd2lsbCBvY2N1ciBpbiBVdHRhciBQcmFkZXNoLCBJbmRpYSwgd2UgYXJlIGdpdmVuIGEgZGF0YXNldCB3aXRoIHRoZSBtZWFzdXJlbWVudHMgb2YgdHdvIHByZWRpY3RvciB2YXJpYWJsZXMgYW5kIGEgYmluYXJ5IHllcy9ubyBmb3IgdGhlIG91dGJyZWFrIG91dGNvbWUuIFRoZSBvdXRicmVhayB2YXJpYWJsZSBoYXMgdG8gYmUgY29udmVydGVkIHRvIGEgMCwxIGZvciBuby95ZXMgb3V0Y29tZXMuIFRoZSAwLDEgaXMgdGhlIGRlcml2ZWQgdmFyaWFibGUuDQoNCjIuIFdyaXRlIGFuIGVxdWF0aW9uIGZvciB0aGUgbW9kZWwgZml0dGVkIGJ5IHRoZSByZXNlYXJjaGVycyBpbiB0aGUgZm9ybSBvZiBlcXVhdGlvbiAoOC4xKS4gVXNlIHByZWRpY3RvciBuYW1lcyBpbnN0ZWFkIG9mIHggbm90YXRpb24uIA0KDQokbG9nKG9kZHMoTWlsZGV3KV90PVxiZXRhXzAgKyBcYmV0YV97bWlsZGV3X3t0LTF9fSArIFxiZXRhX3todW1pZGl0eV97dC0xfX0gKyAgXGJldGFfe21heFRlbXBfe3QtMX19JA0KDQozLiBDcmVhdGUgYSBzY2F0dGVyIHBsb3Qgb2YgdGhlIHR3byBwcmVkaWN0b3JzLCB1c2luZyBkaWZmZXJlbnQgaHVlIGZvciBlcGlkZW1pYyBhbmQgbm9uLWVwaWRlbWljIG1hcmtlcnMuIERvZXMgdGhlcmUgYXBwZWFyIHRvIGJlIGEgcmVsYXRpb25zaGlwIGJldHdlZW4gZXBpZGVtaWMgc3RhdHVzIGFuZCB0aGUgdHdvIHByZWRpY3RvcnM/IA0KDQpgYGB7cn0NCnBsb3QobWlsZGV3JE1heFRlbXAgfiBtaWxkZXckUmVsSHVtaWRpdHksIHhsYWIgPSAiUmVsYXRpdmUgSHVtaWRpdHkiLCB5bGFiID0gIk1heCBUZW1wIChkZWdyZWVzIENlbHNpdXMpIiwgY29sID0gbWlsZGV3JE91dGJyZWFrMSArIDEsIGJ0eSA9ICJsIiwgcGNoID0gMTUpDQpsZWdlbmQoNjAsMjksIGMoIk5vIE91dGJyZWFrIiwgIk91dGJyZWFrIiksIGNvbCA9IDE6MiwgcGNoID0gMTUsIGJ0eSA9ICJsIikNCmBgYA0KDQoNCg0KYGBge3J9DQpwbG90KG1pbGRldyRSZWxIdW1pZGl0eSB+IG1pbGRldyRNYXhUZW1wLCB5bGFiID0gIlJlbGF0aXZlIEh1bWlkaXR5IiwgeGxhYiA9ICJNYXggVGVtcCAoZGVncmVlcyBDZWxzaXVzKSIsIGNvbCA9IG1pbGRldyRPdXRicmVhazEgKyAxLCBidHkgPSAibCIsIHBjaCA9IDE1KQ0KbGVnZW5kKDI3LDcwLCBjKCJObyBPdXRicmVhayIsICJPdXRicmVhayIpLCBjb2wgPSAxOjIsIHBjaCA9IDE1LCBidHkgPSAibCIpDQpgYGANCg0KNC4gQ29tcHV0ZSBuYWl2ZSBmb3JlY2FzdHMgb2YgZXBpZGVtaWMgc3RhdHVzIGZvciB5ZWFycyAxOTk1LSAxOTk3IHVzaW5nIG5leHQteWVhciBmb3JlY2FzdHMgKEZ0KzEgPSBGdCkuIFdoYXQgaXMgdGhlIG5haXZlIGZvcmVjYXN0IGZvciB5ZWFyIDIwMDA/IFN1bW1hcml6ZSB0aGUgcmVzdWx0cyBmb3IgdGhlc2UgZm91ciB5ZWFycyBpbiBhIGNsYXNzaWZpY2F0aW9uIG1hdHJpeC4gVXNlIGEgcm9sbCBmb3J3YXJkIG5haXZlIGZvcmVjYXN0LiBVc2Ugcm9sbCBmd2QuIA0KYGBge3J9DQpuYWl2ZUZvcmVjYXN0cyA8LSBtaWxkZXckT3V0YnJlYWsxWyhsZW5ndGgobWlsZGV3JE91dGJyZWFrMSktMS0zKSA6IChsZW5ndGgobWlsZGV3JE91dGJyZWFrMSktMSldDQpjbGFzcyhuYWl2ZUZvcmVjYXN0cykNCg0KY29uZnVzaW9uTWF0cml4KG5haXZlRm9yZWNhc3RzLCBtaWxkZXckT3V0YnJlYWsxWyhsZW5ndGgobWlsZGV3JE91dGJyZWFrMSktMyk6IGxlbmd0aChtaWxkZXckT3V0YnJlYWsxKV0sIHBvc2l0aXZlID0gYygiMSIpKQ0KYGBgDQoNCg0KNS4gUGFydGl0aW9uIHRoZSBkYXRhIGludG8gdHJhaW5pbmcgYW5kIHZhbGlkYXRpb24gcGVyaW9kcywgc28gdGhhdCB5ZWFycyAxOTg3LTE5OTQgYXJlIHRoZSB0cmFpbmluZyBwZXJpb2QuIEZpdCBhIGxvZ2lzdGljIHJlZ3Jlc3Npb24gdG8gdGhlIHRyYWluaW5nIHBlcmlvZCB1c2luZyB0aGUgdHdvIHByZWRpY3RvcnMsIGFuZCByZXBvcnQgdGhlIG91dGJyZWFrIHByb2JhYmlsaXR5IGFzIHdlbGwgYXMgYSBmb3JlY2FzdCBmb3IgeWVhciAxOTk1ICh1c2UgYSB0aHJlc2hvbGQgb2YgMC41KS4NCg0KYGBge3J9DQp0cmFpbk91dE1pbGRldyA8LSBtaWxkZXdbMTo4LF0NCnRyYWluT3V0TWlsZGV3DQpgYGANCg0KIyNGaXQgYSBMb2dpc3RpYyBSZWdyZXNzaW9uIE1vZGVsDQoNCmBgYHtyfQ0Kb3V0TG9nUmVnTWlsZGV3IDwtIGdsbShPdXRicmVhazEgfiBNYXhUZW1wICsgUmVsSHVtaWRpdHksIGRhdGEgPSB0cmFpbk91dE1pbGRldywgZmFtaWx5ID0gImJpbm9taWFsIikNCnN1bW1hcnkob3V0TG9nUmVnTWlsZGV3KQ0KYGBgDQoNCiMjRm9yZWNhc3QNCg0KYGBge3J9DQpwcmVkaWN0aW9uc01pbGRldyA8LSBwcmVkaWN0KG91dExvZ1JlZ01pbGRldywgbWlsZGV3Wzk6MTIsXSx0eXBlID0gInJlc3BvbnNlIikNCnByZWRpY3Rpb25zTWlsZGV3DQpgYGANCg0KIyNDb25mdXNpb24gTWF0cml4IGZvciB0aGUgRm9yZWNhc3QNCkN1dG9mZiB2YWx1ZSA9IDAuNQ0KDQpgYGB7cn0NCmNvbmZ1c2lvbk1hdHJpeChpZmVsc2UocHJlZGljdGlvbnNNaWxkZXcgPiAwLjUsIDEsMCksIG1pbGRld1s5OjEyLF0kT3V0YnJlYWsxLCBwb3NpdGl2ZSA9IGMoIjEiKSkNCmBgYA0K