1svysurvreg<-function (formula, design, weights=NULL, subset = NULL, ...)
2{
3    UseMethod("svysurvreg", design)
4}
5
6residuals.svysurvreg<-function(object, type = c("response", "deviance", "dfbeta",
7                                           "dfbetas", "working", "ldcase", "ldresp", "ldshape", "matrix"),
8                               rsigma = TRUE, collapse = FALSE, weighted = TRUE, ...) {
9    NextMethod()
10}
11
12
13svysurvreg.survey.design<-
14    function (formula, design, weights=NULL, subset=NULL, ...)
15{
16    subset <- substitute(subset)
17    subset <- eval(subset, model.frame(design), parent.frame())
18    if (!is.null(subset))
19        design <- design[subset, ]
20    if (any(weights(design) < 0))
21        stop("weights must be non-negative")
22    data <- model.frame(design)
23    g <- match.call()
24    g$formula <- eval.parent(g$formula)
25    g$design <- NULL
26    g$var <- NULL
27    if (is.null(g$weights))
28        g$weights <- quote(.survey.prob.weights)
29    else g$weights <- bquote(.survey.prob.weights * .(g$weights))
30    g[[1]] <- quote(survreg)
31    g$data <- quote(data)
32    g$subset <- quote(.survey.prob.weights > 0)
33    g$model <- TRUE
34    data$.survey.prob.weights <- (1/design$prob)/mean(1/design$prob)
35    if (!all(all.vars(formula) %in% names(data)))
36        stop("all variables must be in design= argument")
37    g <- with(list(data = data), eval(g))
38    g$call <- match.call()
39    g$call[[1]] <- as.name(.Generic)
40    g$printcall <- sys.call(-1)
41    g$printcall[[1]] <- as.name(.Generic)
42    class(g) <- c("svysurvreg", class(g))
43    g$survey.design <- design
44    nas <- g$na.action
45    if (length(nas))
46        design <- design[-nas, ]
47    dbeta.subset <- resid(g, "dfbeta", weighted = TRUE)
48    if (nrow(design) == NROW(dbeta.subset)) {
49        dbeta <- as.matrix(dbeta.subset)
50    }
51    else {
52        dbeta <- matrix(0, ncol = NCOL(dbeta.subset), nrow = nrow(design))
53        dbeta[is.finite(design$prob), ] <- dbeta.subset
54    }
55    g$inv.info <- g$var
56    if (inherits(design, "survey.design2"))
57        g$var <- svyrecvar(dbeta, design$cluster, design$strata,
58                           design$fpc, postStrata = design$postStrata)
59    else if (inherits(design, "twophase"))
60        g$var <- twophasevar(dbeta, design)
61    else if (inherits(design, "twophase2"))
62        g$var <- twophase2var(dbeta, design)
63    else if (inherits(design, "pps"))
64        g$var <- ppsvar(dbeta, design)
65    else g$var <- svyCprod(dbeta, design$strata, design$cluster[[1]],
66                           design$fpc, design$nPSU, design$certainty, design$postStrata)
67    g$ll <- g$loglik
68    g$loglik <- NA
69    g$degf.resid <- degf(design) - length(coef(g)[!is.na(coef(g))]) +
70        1
71    g
72}
73