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}