1
2
3psrsq<-function(object, method=c("Cox-Snell","Nagelkerke"),...){
4	UseMethod("psrsq",object)
5}
6
7psrsq.glm<-function(object, method=c("Cox-Snell","Nagelkerke"),...){
8	nullmodel<-update(object,.~1)
9	method<-match.arg(method)
10	ell0<-as.vector(logLik(nullmodel))
11	ell1<-as.vector(logLik(object))
12	n<-object$df.null+1
13
14	mutualinf<-  -2*(ell1-ell0)/n
15	r2cs<-1-exp(mutualinf)
16	if (method == "Cox-Snell")
17		return(r2cs)
18	scaling<-1-exp(2*ell0/n)
19	r2cs/scaling
20}
21
22psrsq.svyglm<-function(object, method=c("Cox-Snell", "Nagelkerke"),...){
23	method<-match.arg(method)
24	if (!(object$family$family %in% c("binomial","quasibinomial","poisson","quasipoisson")))
25		stop("Only implemented for discrete data")
26	w<-weights(object$survey.design,"sampling")
27	N<-sum(w)
28	n<-sum(object$prior.weights)
29	minus2ell0<-object$null.deviance*(N/n)
30	minus2ell1<-object$deviance*(N/n)
31	mutualinf<-(minus2ell1-minus2ell0)/N
32	r2cs<-1-exp(mutualinf)
33	if (method =="Cox-Snell")
34		return(r2cs)
35	if (any(w<1)) warning("Weights appear to be scaled: rsquared may be wrong")
36	scaling<-1-exp(-minus2ell0/N)
37	r2cs/scaling
38}