inst/doc/nlraa-AgronJ-paper.R

In nlraa: Nonlinear Regression for Agricultural Applications

## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(echo = TRUE, fig.width = 7, fig.height = 6)
library(lattice)
library(nlme)
library(ggplot2)
library(nlraa)

## ----strsm--------------------------------------------------------------------
data(sm)
str(sm)
head(sm)

## ----sm-ggplot, echo = FALSE--------------------------------------------------
ggplot(data = sm, aes(y = Yield, x = DOY)) +
   facet_grid(. ~ Input) +
   geom_point(aes(fill=Crop, shape=Crop), size=2) +
   scale_shape_manual(values=c(24,21,1)) +
   scale_fill_manual(values = c("grey","black","black")) +
   scale_x_continuous("Day of the Year") +
   scale_y_continuous("Dry biomass (Mg/ha)") +
   theme_bw()

## ----create-eu----------------------------------------------------------------
sm$eu <- with(sm, factor(Block):factor(Input):factor(Crop))
sm2 <- subset(sm, DOY != 141)

## ----grouped-data-------------------------------------------------------------
smG <- groupedData(Yield ~ DOY | eu, data = sm2)

## ----nls-list-sm--------------------------------------------------------------
fit.lis <- nlsList(Yield ~ SSbgf(DOY, w.max, t.e, t.m), data = smG)
## But this works better
## Added 2020/1/2
fit.lis.rp <- nlsList(Yield ~ SSbgrp(DOY, w.max, lt.e, ldt), data = smG) 

## ----nls-list-plot, echo = FALSE----------------------------------------------
print(plot(fit.lis))
print(plot(intervals(fit.lis)))

## ----relax-control------------------------------------------------------------
fit.me <- nlme(fit.lis, control = list(maxIter = 100, msMaxIter = 300, pnlsMaxIter = 20))

## ----plot-resid-nlme, echo = FALSE--------------------------------------------
print(plot(fit.me))
print(plot(augPred(fit.me, level = 0:1)))

## ----bgf2---------------------------------------------------------------------
fit.lis2 <- nlsList(Yield ~ bgf2(DOY, w.max, w.b = 0, t.e, t.m, t.b = 141),
                    data = smG,
                    start = c(w.max = 30, t.e=280, t.m=240))

## ----plot-bgf2, echo = FALSE--------------------------------------------------
print(plot(fit.lis2))

## ----nlme-update--------------------------------------------------------------
fit.me2 <- nlme(fit.lis2)
## Error message, but the next model is the one we care about
fit2.me2 <- update(fit.me2, random = pdDiag(w.max + t.e + t.m ~ 1))
anova(fit.me2, fit2.me2)
## The second model is simpler and it seems to be marginally better than 
## the orginial, but we need to keep in mind that the simpler model
## converges much more easily

## ----nlme-update-two----------------------------------------------------------
fe <- fixef(fit2.me2) ## Some starting values with visual help
fit3.me2 <- update(fit2.me2, fixed = list(w.max + t.e + t.m ~ Crop),
                  start = c(fe[1], -10, 20, fe[2], -40, 0, fe[3], -40, 0))
## We next include the Input
fe2 <- fixef(fit3.me2)
fit4.me2 <- update(fit3.me2, fixed = list(w.max + t.e + t.m
                               ~ Crop + Input),
                  start = c(fe2[1:3], 0, fe2[4:6], 0, fe2[7:9], 0))
## and the interaction
fe3 <- fixef(fit4.me2)
fit5.me2 <- update(fit4.me2,
                   fixed = list(w.max + t.e + t.m
                     ~ Crop + Input + Crop:Input),
                  start = c(fe3[1:4], 0, 0,
                            fe3[5:8], 0, 0,
                            fe3[9:12], 0, 0))

## ----fit5-plot, echo = FALSE--------------------------------------------------
print(plot(fit5.me2))

## ----fit6-and-fit7------------------------------------------------------------
fit6.me2 <- update(fit5.me2,
                   weights = varPower(form = ~ fitted(.) | Crop))

fit7.me2 <- update(fit6.me2, weights = varPower(form = ~ fitted(.)))

anova(fit6.me2, fit7.me2)

## ----fit6.me2-----------------------------------------------------------------
fit6.me2

## ----gnls---------------------------------------------------------------------
## Random effects are almost zero
fit8.me2 <- gnls(Yield ~ bgf2(DOY, w.max, t.e, t.m, w.b=0, t.b=141),
                 data = smG,
                 params = list(w.max + t.e + t.m ~ Crop + Input
                                                   + Crop:Input),
                 weights = varPower(form = ~ fitted(.) | Crop),
                 start = fixef(fit7.me2))
anova(fit6.me2, fit8.me2)

## ----anova-fit8---------------------------------------------------------------
anova(fit8.me2)

## ----plot-fit8----------------------------------------------------------------
print(plot(fit8.me2))

## ----fit8-fitted--------------------------------------------------------------
smG$prds <- fitted(fit8.me2)

doys <- 168:303
ndat <- expand.grid(DOY=doys, Crop= unique(smG$Crop), Input=c(1,2))
ndat$preds <- predict(fit8.me2, newdata = ndat)

## Here I'm just removing prediction for maize that go beyond
## day of the year 270
ndat2 <- ndat
ndat2[ndat2$Crop == "M" & ndat2$DOY > 270,"preds"] <- NA
ndat2 <- na.omit(ndat2)

## ----fit8-fitted-plot, echo = FALSE-------------------------------------------
 ggplot(data = smG, aes(y = Yield, x = DOY)) +
  facet_grid(. ~ Input) +
   geom_point(aes(fill=Crop, shape=Crop), size=2) +
   geom_line(aes(x = DOY, y = preds, linetype = Crop), data=ndat2) +
   scale_shape_manual(values=c(24,21,1)) +
   scale_fill_manual(values = c("grey","black","black")) +
   scale_x_continuous("Day of the Year") +
   scale_y_continuous("Dry biomass (Mg/ha)") +
   theme_bw()