# R/R2.nls.R In OnofriAndreaPG/aomisc: Statistical methods for the agricultural sciences

#### Documented in R2nls

R2nls <- function(object){

if (!inherits(object, "nls") & !inherits(object, "drc"))
stop("use only with \"nls\" or \"drc\" objects")

if (inherits(object, "nls")){
formula <- as.formula(summary(object)\$formula)
varNames <- all.vars(formula)
if(!is.environment(eval(object\$data))){
Y <- eval(object\$data)[,varNames[1]]
} else {
Y <- get(varNames[1])
}
dfMod <- summary(object)\$df[2]
sigma <- summary(object)\$sigma
} else if (inherits(object, "drc")){
# object\$origData
varNames <- all.vars(object\$call\$formula)
Y <- eval(object\$data)[,varNames[1]]
dfMod <- summary(object)\$df
sigma <- sqrt( summary(object)\$resVar )
}
Y <- as.numeric(unlist(Y))
SSm <- sum( (fitted(object) - mean(Y))^2) # Regression deviance
SSt <- deviance( lm(Y ~ 1) ) # Total deviance about the mean
SSr <- deviance(object)  # Residual deviance
PseudoR2 <- (SSt - SSr)/SSt # R2 as in Schebenberger Eq. 5.24 (pag. 211)
R2 <- SSm/SSt # R2 traditional as in Scebenberger Eq. 5.23

# MSt <- SSt/(length(Y) - 1)
# MSr <- SSr/dfMod
#
# MSE <- SSr/dfMod
# RMSE <- sigma
# RRMSE <- RMSE/mean(Y)

# R2 generalised: to be done for GLMs
# ll1 <- as.numeric(logLik(object))
# ll2 <- as.numeric(logLik( lm(Y ~ 1) ))
# R2gen <- 1 - exp(-2/length(Y)*(ll1 - ll2)) # Schabenberger, 6.46 pag 343
# R2genResc <- R2gen/(1 - exp(2/length(Y) * ll2)) # Schabenberger, 6.48 pag 344
returnList <- list(PseudoR2 = PseudoR2, R2 = R2
#R2gen = R2gen, R2gen.rescaled = R2genResc,
# , MSE = MSE, RMSE = RMSE, RRMSE = RRMSE
)
returnList
}
OnofriAndreaPG/aomisc documentation built on Feb. 26, 2024, 8:21 p.m.