## Implementing new classes
## Users provide three functions - diagfun, simfun and fitfun,
## in the following way:
##
## diagfun <- function(obj) {
## userfunction(obj, other_argumens)
## # e.g., resid(obj, type="pearson")
## }
##
## simfun <- function(n, obj) {
## userfunction(n, other_arguments) # e.g., rpois(n, fitted(obj))
## }
##
## fitfun <- function(y.) {
## userfunction(y. ~ linear_predictor, other_arguments, data=data)
## # e.g., glm(y. ~ block + factor1 * factor2, family=poisson,
## # data=mydata)
## }
##
## when response is binary:
## fitfun <- function(y.) {
## userfunction(cbind(y., m-y.) ~ linear_predictor,
## other_arguments, data=data)
## #e.g., glm(cbind(y., m-y.) ~ treatment - 1,
## # family=binomial, data=data)
## }
if (FALSE) {
## Example no. 1: Using Cook's distance as a diagnostic measure
y <- rpois(30, lambda=rep(c(.5, 1.5, 5), each=10))
tr <- gl(3, 10)
fit1 <- glm(y ~ tr, family=poisson)
# diagfun
d.fun <- function(obj) cooks.distance(obj)
# simfun
s.fun <- function(n, obj) {
lam <- fitted(obj)
rpois(n, lambda=lam)
}
# fitfun
my.data <- data.frame(y, tr)
f.fun <- function(y.) glm(y. ~ tr, family=poisson, data=my.data)
# hnp call
hnp(fit1, newclass=TRUE, diagfun=d.fun, simfun=s.fun, fitfun=f.fun)
## Example no. 2: Implementing gamma model using package gamlss
# load package
require(gamlss)
# model fitting
y <- rGA(30, mu=rep(c(.5, 1.5, 5), each=10), sigma=.5)
tr <- gl(3, 10)
fit2 <- gamlss(y ~ tr, family=GA)
# diagfun
d.fun <- function(obj) resid(obj) # this is the default if no
# diagfun is provided
# simfun
s.fun <- function(n, obj) {
mu <- obj$mu.fv
sig <- obj$sigma.fv
rGA(n, mu=mu, sigma=sig)
}
# fitfun
my.data <- data.frame(y, tr)
f.fun <- function(y.) gamlss(y. ~ tr, family=GA, data=my.data)
# hnp call
hnp(fit2, newclass=TRUE, diagfun=d.fun, simfun=s.fun,
fitfun=f.fun, data=data.frame(y, tr))
## Example no. 3: Implementing binomial model in gamlss
# model fitting
y <- rBI(30, bd=50, mu=rep(c(.2, .5, .9), each=10))
m <- 50
tr <- gl(3, 10)
fit3 <- gamlss(cbind(y, m-y) ~ tr, family=BI)
# diagfun
d.fun <- function(obj) resid(obj)
# simfun
s.fun <- function(n, obj) {
mu <- obj$mu.fv
bd <- obj$bd
rBI(n, bd=bd, mu=mu)
}
# fitfun
my.data <- data.frame(y, tr, m)
f.fun <- function(y.) gamlss(cbind(y., m-y.) ~ tr,
family=BI, data=my.data)
# hnp call
hnp(fit3, newclass=TRUE, diagfun=d.fun, simfun=s.fun, fitfun=f.fun)
}
Run the code above in your browser using DataLab