library(nlme)
data(ralu.model)
back.transform <- function(y) exp(y + 0.5 * stats::var(y, na.rm=TRUE))
rmse = function(p, o){ sqrt(mean((p - o)^2)) }
x = c("DEPTH_F", "HLI_F", "CTI_F", "cti", "ffp")
sidx <- sample(1:nrow(ralu.model), 100)
train <- ralu.model[sidx,]
test <- ralu.model[-sidx,]
# Specify constrained gravity model
( gm <- gravity(y = "DPS", x = x, d = "DISTANCE", group = "FROM_SITE",
data = train, ln = FALSE) )
( p <- predict(gm, test[,c(x, "DISTANCE")]) )
rmse(back.transform(p), back.transform(ralu.model[,"DPS"][-sidx]))
# WIth model sigma-based back transformation
( p <- predict(gm, test[,c(x, "DISTANCE")], back.transform = "simple") )
( p <- predict(gm, test[,c(x, "DISTANCE")], back.transform = "Miller") )
( p <- predict(gm, test[,c(x, "DISTANCE")], back.transform = "Naihua") )
# Using grouped data
test <- nlme::groupedData(stats::as.formula(paste(paste("DPS", 1, sep = " ~ "),
"FROM_SITE", sep = " | ")),
data = test[,c("DPS", "FROM_SITE", x, "DISTANCE")])
( p <- predict(gm, test, groups = "FROM_SITE") )
( y.hat <- back.transform(ralu.model[,"DPS"][-sidx]) )
na.idx <- which(is.na(p))
rmse(back.transform(p)[-na.idx], y.hat[-na.idx])
# Specify unconstrained gravity model (generally, not recommended)
( gm <- gravity(y = "DPS", x = x, d = "DISTANCE", group = "FROM_SITE",
data = train, ln = FALSE, constrained=TRUE) )
( p <- predict(gm, test[,c(x, "DISTANCE")]) )
rmse(back.transform(p), back.transform(ralu.model[,"DPS"][-sidx]))
Run the code above in your browser using DataLab