├── DESCRIPTION ├── INDEX ├── MD5 ├── NAMESPACE ├── R ├── DBI.R ├── RcppExports.R ├── anova.svyglm.R ├── bootstrap.R ├── chisqsum.R ├── compressweights.R ├── confint.R ├── count.R ├── dAIC.R ├── dbiupdate.R ├── ftable.svystat.R ├── gofchisq.R ├── grake.R ├── greg.R ├── ht.R ├── loglin.R ├── logrank.R ├── margins.R ├── mrb.R ├── mse.R ├── multistage.R ├── multivariate.R ├── naa.R ├── newsvyquantile.R ├── olr.R ├── pFsum.R ├── paley.R ├── pps.R ├── qrule.R ├── recalibrate.R ├── regtest.R ├── rsquared.R ├── score.R ├── smoothArea.R ├── smoothUnit.R ├── stdize.R ├── stratsample.R ├── survey.R ├── surveyby.R ├── surveychisq.R ├── surveygraph.R ├── surveyrep.R ├── svycdf.R ├── svycontrast_svyvar.R ├── svycralpha.R ├── svyhist.R ├── svyivreg.R ├── svykappa.R ├── svykm.R ├── svymi.R ├── svynls.R ├── svypredmeans.R ├── svyqq.R ├── svyquantile.R ├── svyranktest.R ├── svysmooth.R ├── svysurvreg.R ├── svyttest.R ├── sysdata.rda ├── transform.R ├── twophase.R ├── twophase2.R ├── weightconstruction.R ├── withPV.R └── xdesign.R ├── THANKS ├── TODO ├── build └── vignette.rds ├── data ├── api.rda ├── crowd.rda ├── election.rda ├── fpc.rda ├── hospital.rda ├── mu284.rda ├── myco.rda ├── nhanes.rda ├── salamander.rda ├── scd.rda └── yrbs.rda ├── inst ├── BUGS ├── CITATION ├── COPYING ├── NEWS ├── api.db ├── disclaimer ├── doc │ ├── domain.R │ ├── domain.Rnw │ ├── domain.pdf │ ├── epi.R │ ├── epi.Rnw │ ├── epi.pdf │ ├── nwtco-subcohort.rda │ ├── nwts.rda │ ├── phase1.R │ ├── phase1.pdf │ ├── pps.R │ ├── pps.Rnw │ ├── pps.pdf │ ├── precalibrated.R │ ├── precalibrated.Rnw │ ├── precalibrated.pdf │ ├── qrule.Rnw │ ├── qrule.pdf │ ├── survey-sae.html │ ├── survey-sae.html.asis │ ├── survey.R │ ├── survey.Rnw │ └── survey.pdf ├── porting.to.S ├── twostage.pdf └── ucla-examples.pdf ├── man ├── HR.Rd ├── SE.Rd ├── anova.svyglm.Rd ├── api.Rd ├── as.fpc.Rd ├── as.svrepdesign.Rd ├── as.svydesign2.Rd ├── barplot.svystat.Rd ├── bootweights.Rd ├── brrweights.Rd ├── calibrate.Rd ├── compressWeights.Rd ├── confint.svyglm.Rd ├── crowd.Rd ├── dimnames.DBIsvydesign.Rd ├── election.Rd ├── estweights.Rd ├── fpc.Rd ├── ftable.svystat.Rd ├── hadamard.Rd ├── hospital.Rd ├── make.calfun.Rd ├── marginpred.Rd ├── mu284.Rd ├── myco.Rd ├── nhanes.Rd ├── nonresponse.Rd ├── oldsvyquantile.Rd ├── open.DBIsvydesign.Rd ├── paley.Rd ├── pchisqsum.Rd ├── poisson_sampling.Rd ├── postStratify.Rd ├── psrsq.Rd ├── rake.Rd ├── regTermTest.Rd ├── salamander.Rd ├── scd.Rd ├── smoothArea.Rd ├── smoothUnit.Rd ├── stratsample.Rd ├── subset.survey.design.Rd ├── surveyoptions.Rd ├── surveysummary.Rd ├── svrVar.Rd ├── svrepdesign.Rd ├── svy.varcoef.Rd ├── svyCprod.Rd ├── svyby.Rd ├── svycdf.Rd ├── svychisq.Rd ├── svyciprop.Rd ├── svycontrast.Rd ├── svycoplot.Rd ├── svycoxph.Rd ├── svycralpha.Rd ├── svydesign.Rd ├── svyfactanal.Rd ├── svyglm.Rd ├── svygofchisq.Rd ├── svyhist.Rd ├── svyivreg.Rd ├── svykappa.Rd ├── svykm.Rd ├── svyloglin.Rd ├── svylogrank.Rd ├── svymle.Rd ├── svynls.Rd ├── svyolr.Rd ├── svyplot.Rd ├── svyprcomp.Rd ├── svypredmeans.Rd ├── svyqqplot.Rd ├── svyquantile.Rd ├── svyranktest.Rd ├── svyratio.Rd ├── svyrecvar.Rd ├── svyscoretest.Rd ├── svysmooth.Rd ├── svystandardize.Rd ├── svysurvreg.Rd ├── svyttest.Rd ├── trimWeights.Rd ├── twophase.Rd ├── update.survey.design.Rd ├── weights.survey.design.Rd ├── with.svyimputationList.Rd ├── withPV.survey.design.Rd ├── withReplicates.Rd ├── xdesign.Rd └── yrbs.Rd ├── src ├── Makevars.makefile ├── Makevars.win ├── RcppExports.cpp └── arma_multistage.cpp ├── tests ├── 3stage2phase.R ├── DBIcheck.R ├── README ├── anova-svycoxph.R ├── api.R ├── badcal.R ├── badcal.Rout.save ├── brewer_cpp.R ├── bycovmat.R ├── caleg.R ├── check.R ├── check.Rout.save ├── cigsw.rda ├── confintrep.R ├── contrast-replicates.R ├── coxph-termtest.R ├── datos_ejemplo.rds ├── deff.R ├── deff.Rout.save ├── defftest.R ├── degf-svrepdesign.R ├── domain.R ├── domain.Rout.save ├── fpc.R ├── glm-scoping.R ├── kalton.R ├── kalton.Rout.save ├── logranktest.R ├── lonely.psu.R ├── lonely.psu.Rout.save ├── mtcars-var.R ├── multistage-rcpp.R ├── multistage.R ├── na_action.R ├── naa.rda ├── newquantile.R ├── nwtco-subcohort.rda ├── nwts-cch.R ├── nwts.R ├── nwts.Rout.save ├── nwts.rda ├── poisson.R ├── pps.R ├── qrule-swiss.R ├── quantile.R ├── quantile.Rout.save ├── quantiles-chile.R ├── rakecheck.R ├── rakecheck.Rout.save ├── raowuboot.R ├── raowuboot.Rout.save ├── regTermTest-missing.R ├── regpredict.R ├── regpredict.Rout.save ├── rss_scores.R ├── scoping.R ├── simdata1.RData ├── survcurve.R ├── survcurve.Rout.save ├── svyby-strings.R ├── svyby_bug.R ├── svyby_se.R ├── svycontrast.R ├── svyivreg-var.R ├── svyivreg.R ├── svyolr-rake-subset.R ├── svyolr.R ├── testSUMMER │ └── SUMMER.R ├── testoutput │ ├── DBIcheck.R │ ├── DBIcheck.Rout.save │ ├── README │ ├── api.R │ ├── api.Rout.saved │ ├── bycovmat.R │ ├── bycovmat.Rout.save │ ├── caleg.R │ ├── caleg.Rout.save │ ├── fpc.R │ ├── fpc.Rout.save │ ├── multistage.R │ ├── multistage.Rout.save │ ├── nwtco-subcohort.rda │ ├── nwts-cch.R │ ├── nwts-cch.Rout.save │ ├── nwts.rda │ ├── pps.R │ ├── pps.Rout.save │ ├── quantile-new.R │ ├── quantile-new.Rout.save │ ├── scoping.R │ └── scoping.Rout.save ├── toy_example_for_postStratify.R ├── twophase.R └── twophase.Rout.save └── vignettes ├── domain.Rnw ├── epi.Rnw ├── pps.Rnw ├── precalibrated.Rnw ├── qrule.Rnw ├── survey-sae.html.asis └── survey.Rnw /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: survey 2 | Title: Analysis of Complex Survey Samples 3 | Description: Summary statistics, two-sample tests, rank tests, generalised linear models, cumulative link models, Cox models, loglinear models, and general maximum pseudolikelihood estimation for multistage stratified, cluster-sampled, unequally weighted survey samples. Variances by Taylor series linearisation or replicate weights. Post-stratification, calibration, and raking. Two-phase subsampling designs. Graphics. PPS sampling without replacement. Small-area estimation. 4 | Version: 4.4-2 5 | Author: Thomas Lumley, Peter Gao, Ben Schneider 6 | Maintainer: "Thomas Lumley" 7 | License: GPL-2 | GPL-3 8 | Depends: R (>= 4.1.0), grid, methods, Matrix, survival 9 | Imports: stats, graphics, splines, lattice, minqa, numDeriv, mitools 10 | (>= 2.4), Rcpp (>= 0.12.8) 11 | LinkingTo: Rcpp, RcppArmadillo 12 | VignetteBuilder: R.rsp 13 | Suggests: foreign, MASS, KernSmooth, hexbin, RSQLite, quantreg, 14 | parallel, CompQuadForm, DBI, AER, SUMMER (>= 1.4.0), R.rsp 15 | URL: http://r-survey.r-forge.r-project.org/survey/ 16 | NeedsCompilation: yes 17 | Packaged: 2024-03-20 00:51:41 UTC; tlum005 18 | Repository: CRAN 19 | Date/Publication: 2024-03-20 15:30:02 UTC 20 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | arma_onestage <- function(Y, samp_unit_ids, strata_ids, strata_samp_sizes, strata_pop_sizes, singleton_method, use_singleton_method_for_domains, stage) { 5 | .Call('_survey_arma_onestage', PACKAGE = 'survey', Y, samp_unit_ids, strata_ids, strata_samp_sizes, strata_pop_sizes, singleton_method, use_singleton_method_for_domains, stage) 6 | } 7 | 8 | arma_multistage <- function(Y, samp_unit_ids, strata_ids, strata_samp_sizes, strata_pop_sizes, singleton_method, use_singleton_method_for_domains, use_only_first_stage, stage) { 9 | .Call('_survey_arma_multistage', PACKAGE = 'survey', Y, samp_unit_ids, strata_ids, strata_samp_sizes, strata_pop_sizes, singleton_method, use_singleton_method_for_domains, use_only_first_stage, stage) 10 | } 11 | 12 | -------------------------------------------------------------------------------- /R/compressweights.R: -------------------------------------------------------------------------------- 1 | 2 | "dim.repweights_compressed"<-function(x){ 3 | c(length(x$index),ncol(x$weights)) 4 | } 5 | 6 | "dimnames.repweights_compressed"<-function(x){ 7 | list(names(x$index), colnames(x$weights)) 8 | } 9 | 10 | "[.repweights_compressed"<-function(x,i,...,drop=FALSE){ 11 | if (!missing(i)){ 12 | x$index<-x$index[i] 13 | if(!missing(..1)) 14 | x$weights<-x$weights[,..1,drop=FALSE] 15 | } else{ 16 | ## this is faster than just subscripting x$weights (!) 17 | x<-list(index=x$index, 18 | weights=x$weights[,...,drop=FALSE]) 19 | class(x)<-c("repweights_compressed","repweights") 20 | } 21 | x 22 | } 23 | 24 | "as.matrix.repweights_compressed"<-function(x,...){ 25 | x$weights[x$index,,drop=FALSE] 26 | } 27 | 28 | "as.vector.repweights_compressed"<-function(x,...){ 29 | as.vector(x$weights[x$index,]) 30 | } 31 | 32 | "as.matrix.repweights"<-function(x,...){ 33 | x 34 | } 35 | 36 | compressWeights<-function(rw,...){ 37 | UseMethod("compressWeights") 38 | } 39 | 40 | "compressWeights.repweights_compressed"<-function(rw,...){ 41 | compressWeights(as.matrix(rw)) 42 | } 43 | 44 | compressWeights.default<-function(rw,...){ 45 | mat<-as.matrix(rw) 46 | tmp<-apply(mat,1,function(x) paste(x,collapse="\r")) 47 | unq<-!duplicated(mat) 48 | rval<-list(weights=mat[unq,],index=match(tmp,tmp[unq])) 49 | class(rval)<-c("repweights_compressed","repweights") 50 | rval 51 | } 52 | 53 | compressWeights.svyrep.design<-function(rw,...){ 54 | rw$repweights<-compressWeights(rw$repweights,...) 55 | rw 56 | } 57 | -------------------------------------------------------------------------------- /R/confint.R: -------------------------------------------------------------------------------- 1 | format.perc<-function (probs, digits) { 2 | paste(format(100 * probs, trim = TRUE, 3 | scientific = FALSE, digits = digits), "%") 4 | } 5 | 6 | confint.svystat<-function (object, parm, level = 0.95, df=Inf,...) { 7 | tconfint(object, parm, level,df) 8 | } 9 | 10 | confint.svrepstat<-confint.svystat 11 | confint.svyby<-confint.svystat 12 | confint.svyratio<-confint.svystat 13 | 14 | 15 | tconfint<-function (object, parm, level = 0.95, df=Inf) 16 | { 17 | cf <- coef(object) 18 | if (is.matrix(cf)) { 19 | pnames <- sapply(X = colnames(cf), 20 | FUN = function(x) paste(rownames(cf), x, sep = "_"), 21 | simplify = TRUE) 22 | pnames <- as.vector(pnames) 23 | cf <- as.vector(cf) 24 | names(cf) <- pnames 25 | } else { 26 | pnames <- names(cf) 27 | } 28 | if (missing(parm)) 29 | parm <- pnames 30 | else if (is.numeric(parm)) 31 | parm <- pnames[parm] 32 | a <- (1 - level)/2 33 | a <- c(a, 1 - a) 34 | pct <- format.perc(a, 3) 35 | fac <- qt(a, df=df) 36 | ci <- array(NA, dim = c(length(parm), 2L), dimnames = list(parm, pct)) 37 | if (!is.matrix(cf)) { 38 | ses <- unlist(SE(object))[parm %in% pnames] 39 | } else { 40 | ses <- as.vector(SE(object))[parm %in% pnames] 41 | } 42 | ci[] <- cf[parm] + ses %o% fac 43 | ci 44 | } 45 | -------------------------------------------------------------------------------- /R/count.R: -------------------------------------------------------------------------------- 1 | unwtd.count<-function(x, design,...){ 2 | 3 | if (inherits(x, "formula")) { 4 | mf <- model.frame(x, model.frame(design), na.action = na.pass) 5 | xx <- lapply(attr(terms(x), "variables")[-1], 6 | function(tt) model.matrix(eval(bquote(~0 + .(tt))), mf) 7 | ) 8 | cols <- sapply(xx, NCOL) 9 | x <- matrix(nrow = NROW(xx[[1]]), ncol = sum(cols)) 10 | scols <- c(0, cumsum(cols)) 11 | for (i in 1:length(xx)) { 12 | x[, scols[i] + 1:cols[i]] <- xx[[i]] 13 | } 14 | colnames(x) <- do.call("c", lapply(xx, colnames)) 15 | } 16 | else if (typeof(x) %in% c("expression", "symbol")) 17 | x <- eval(x, model.frame(design)) 18 | x <- as.matrix(x) 19 | out<- weights(design,"sampling")==0 20 | nas <- rowSums(is.na(x)) 21 | 22 | x <- x[(nas+out) == 0, , drop = FALSE] 23 | 24 | rval<-NROW(x) 25 | names(rval)<-"counts" 26 | attr(rval,"var")<-matrix(0,1,1) 27 | attr(rval,"statistic")<-"counts" 28 | if (inherits(design,"svyrep.design")) 29 | class(rval)<-"svrepstat" 30 | else 31 | class(rval)<-"svystat" 32 | rval 33 | 34 | } 35 | -------------------------------------------------------------------------------- /R/ftable.svystat.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | ftable.svystat<-function(x, rownames=NULL, ...){ 4 | 5 | m<-cbind(coef(x),SE(x)) 6 | if (is.null(rownames)) 7 | return(as.table(m)) 8 | 9 | statname<-if (is.list(x)) attr(x[[1]],"statistic") else attr(x,"statistic") 10 | 11 | deff<-attr(x,"deff") 12 | has.deff<-!is.null(deff) 13 | if (has.deff) 14 | m<-cbind(m,diag(deff)) 15 | 16 | rowdim<-sapply(rownames,length) 17 | 18 | if (has.deff){ 19 | mm<-array(m,dim=c(rowdim,NCOL(m)), 20 | dimnames=c(as.list(rownames), 21 | list(c(statname,"SE","Deff")))) 22 | 23 | ftable(mm,row.vars=length(rowdim)+0:1) 24 | } else { 25 | mm<-array(m,dim=c(rowdim,NCOL(m)), 26 | dimnames=c(as.list(rownames), 27 | list(c(statname,"SE")))) 28 | 29 | ftable(mm,row.vars=length(rowdim)+0:1) 30 | } 31 | 32 | } 33 | 34 | ftable.svrepstat<-ftable.svystat 35 | 36 | 37 | ftable.svyby <- function (x, ...) 38 | { 39 | info <- attr(x, "svyby") 40 | margins <- info$margins 41 | dimnames <- lapply(x[, margins, drop = FALSE], levels) 42 | dims <- sapply(dimnames, length) 43 | dims <- c(dims, variable = info$nstats) 44 | senames<-c(se="SE",cv="cv",cvpct="cv%",var="Var")[info$vartype] 45 | if (info$vars || info$deffs) { 46 | dims <- c(dims, 1 + info$vars + info$deffs) 47 | dimnames <- c(dimnames, 48 | list(sub("^statistic\\.(.*)$", "\\1", info$variables)), 49 | list(c(info$statistic, 50 | if (info$vars) senames, 51 | if (info$deffs) "DEff"))) 52 | } 53 | else if (info$nstats == 1) { 54 | dimnames <- c(dimnames, list(info$statistic)) 55 | } 56 | else { 57 | dimnames <- c(dimnames, list(info$variables)) 58 | } 59 | ## fix by Sergio Calva for ordering bug. 60 | x <- x[do.call("order",x[,rev(margins),drop = FALSE]),] 61 | rval <- array(as.matrix(x[, -margins, drop = FALSE]), dim = dims, 62 | dimnames = dimnames) 63 | ftable(rval, row.vars = c(1, length(dim(rval)))) 64 | } 65 | 66 | if(FALSE){ 67 | odfTable.svystat <- function(x,...) odfTable(as.data.frame(x),...) 68 | odfTable.table <- odfTable.matrix 69 | } 70 | -------------------------------------------------------------------------------- /R/gofchisq.R: -------------------------------------------------------------------------------- 1 | svygofchisq<-function(formula, p, design,...){ 2 | p<-p/sum(p) 3 | means<-svytotal(formula, design,...) 4 | rval<-chisq.test(means,p=p) 5 | nm<-names(coef(means)) 6 | ncat<-length(coef(means)) 7 | means<-svycontrast(means, list(N=rep(1,ncat)), add=TRUE) 8 | pN<-split(cbind(p,0*diag(p)), paste0("p_",nm)) 9 | names(pN)<-paste0("p_",nm) 10 | means<-svycontrast(means, pN,add=TRUE) 11 | for(i in 1:length(nm)){ 12 | O<-as.name(nm[i]) 13 | E<-as.name(names(pN)[i]) 14 | expr<-list(bquote((.(O)-.(E))/sqrt(.(E)))) 15 | names(expr)[[1]]<-paste0("X2_",O) 16 | means<-svycontrast(means,expr,add=TRUE) 17 | } 18 | result<-svycontrast(means, rep(c(1,0),c(ncat,2*ncat+1))) 19 | lambda<-eigen(vcov(means)[1:ncat,1:ncat])$values 20 | tr <- mean(lambda) 21 | tr2 <- mean(lambda ^2)/(tr^2) 22 | scale = tr * tr2 23 | df = ncat/tr2 24 | rval$parameter<-c(scale=scale,df=df) 25 | rval$p.value<-pchisqsum(rval$statistic,rep(1,ncat), lambda,lower.tail=FALSE) 26 | rval$data.name<-deparse(formula) 27 | rval$method<-"Design-based chi-squared test for given probabilities" 28 | rval$lambda<-lambda 29 | rval 30 | } -------------------------------------------------------------------------------- /R/ht.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | htvar.list<-function(xcheck, Dcheck){ 4 | rval<-sapply(Dcheck, function(stagei) 5 | {htvar.matrix(rowsum(xcheck,stagei$id),stagei$dcheck)}) 6 | rval 7 | } 8 | 9 | ## used in twophase2var() 10 | htvar.matrix<-function(xcheck, Dcheck){ 11 | if (is.null(dim(xcheck))) 12 | xcheck<-as.matrix(xcheck) 13 | rval<-apply(xcheck,2, function(xicheck) 14 | apply(xcheck,2, function(xjcheck) 15 | as.matrix(Matrix::crossprod(xicheck, Dcheck%*%xjcheck)) 16 | )) 17 | if(is.null(dim(rval))) dim(rval)<-c(1,1) 18 | rval 19 | } 20 | 21 | ## used in ppsvar, twophase2var 22 | ygvar.matrix<-function(xcheck,Dcheck){ 23 | ht<-htvar.matrix(xcheck,Dcheck) 24 | if (is.null(dim(xcheck))){ 25 | corr <- sum(Dcheck%*%(xcheck*xcheck)) 26 | } else { 27 | corr <- apply(xcheck,2, function(xicheck) 28 | apply(xcheck,2, function(xjcheck) 29 | sum(Dcheck%*%(xicheck*xjcheck)) 30 | )) 31 | } 32 | rval<-ht-corr 33 | } 34 | 35 | 36 | -------------------------------------------------------------------------------- /R/mrb.R: -------------------------------------------------------------------------------- 1 | ## Rescaled multistage bootstrap 2 | ## Preston http://www.statcan.gc.ca/pub/12-001-x/2009002/article/11044-eng.pdf 3 | ## 4 | 5 | mrbweights<-function(clusters,stratas,fpcs, replicates=50, multicore=getOption("survey.multicore")){ 6 | nstages<-NCOL(clusters) 7 | if (is.null(fpcs$popsize)){ 8 | warning("Design is sampled with replacement: only first stage used") 9 | fpcs$popsize<-matrix(Inf, ncol=1,nrow=NROW(clusters)) 10 | nstages<-1 11 | } 12 | 13 | if (multicore & !requireNamespace("parallel", quietly=TRUE)) 14 | multicore<-FALSE 15 | do.it<-if(multicore) parallel::mclapply else lapply 16 | 17 | weightlist<-do.it(1:replicates, function(k){ 18 | weights<-matrix(1,nrow=NROW(clusters),ncol=nstages) 19 | kept<-rep(TRUE, NROW(clusters)) 20 | cumffs<-rep(1,NROW(clusters)) 21 | for(i in 1:nstages){ 22 | ustrata<-unique(stratas[,i]) 23 | nstrata<-length(ustrata) 24 | for(j in 1:nstrata){ 25 | thisstratum<-stratas[,i]==ustrata[j] 26 | su <- unique(clusters[thisstratum & kept,i] ) 27 | n <-length(su) 28 | nstar<-floor(n/2) 29 | cumff<-cumffs[thisstratum][1] 30 | fpc<- fpcs$sampsize[thisstratum,i][1]/fpcs$popsize[thisstratum,i][1] 31 | if (nstar==0) { 32 | wstar<-0 33 | keep<- rep(FALSE,sum(thisstratum)) 34 | } else { 35 | lambda<-sqrt(cumff*nstar*(1-fpc)/(n-nstar)) 36 | keep<-clusters[thisstratum,i] %in% sample(su,nstar) 37 | wstar<-(-lambda+lambda*(n/nstar)*keep) 38 | } 39 | weights[thisstratum, i]<-wstar*weights[thisstratum, i] 40 | if (nstar>0 & i 2L) { 31 | object <- object[keep, , , drop = FALSE] 32 | temp <- (dn <- dimnames(object))[[1L]] 33 | if (!is.null(temp)) { 34 | temp[naa] <- names(naa) 35 | dimnames(object)[[1L]] <- temp 36 | } 37 | } 38 | else { 39 | object <- object[keep] 40 | temp <- names(object) 41 | if (length(temp)) { 42 | temp[naa] <- names(naa) 43 | names(object) <- temp 44 | } 45 | } 46 | object 47 | } 48 | 49 | naa_longer.exclude<-function(naa,object,...) object 50 | naa_shorter.exclude<-function(naa,object,...) { 51 | if (length(naa) == 0 || !is.numeric(naa)) 52 | stop("invalid argument 'naa'") 53 | if (is.null(object)) 54 | return(object) 55 | n <- NROW(object) 56 | keep <- (1:n)[-naa] 57 | if (is.matrix(object)) { 58 | object <- object[keep, , drop = FALSE] 59 | temp <- rownames(object) 60 | } 61 | else if (is.array(object) && length(d <- dim(object)) > 2L) { 62 | object <- object[keep, , , drop = FALSE] 63 | temp <- (dn <- dimnames(object))[[1L]] 64 | } 65 | else { 66 | object <- object[keep] 67 | temp <- names(object) 68 | } 69 | object 70 | } 71 | 72 | 73 | 74 | 75 | -------------------------------------------------------------------------------- /R/pFsum.R: -------------------------------------------------------------------------------- 1 | pFsum<-function(x,df,a,ddf=Inf,lower.tail=TRUE,method=c("saddlepoint","integration","satterthwaite"),...){ 2 | if (ddf==Inf) return(pchisqsum(x,df=df,a=a,lower.tail=lower.tail,...)) 3 | 4 | method<-match.arg(method) 5 | if (method=="integration" && !(requireNamespace("CompQuadForm",quietly=TRUE))){ 6 | warning("Package 'CompQuadForm' not found, using saddlepoint approximation") 7 | method<-"saddlepoint" 8 | } 9 | 10 | 11 | if (method=="integration"){ 12 | 13 | int<-CompQuadForm::davies(0,lambda=c(a,-x/ddf), h=c(df,ddf),acc=1e-7) 14 | if ( (int$ifault %in% c(0,2))){ 15 | rval<-int$Qq 16 | } else { 17 | rval<-CompQuadForm::davies(0,lambda=c(a,-x/ddf), h=c(df,ddf),acc=1e-5)$Qq 18 | } 19 | if(lower.tail) 20 | return(1-rval) 21 | else 22 | return(rval) 23 | } else if (method %in% c("satterthwaite","saddlepoint")){ 24 | if(any(df>1)){ 25 | a<-rep(a,df) 26 | } 27 | tr<-mean(a) 28 | tr2<-mean(a^2)/(tr^2) 29 | scale=tr*tr2 30 | ndf=length(a)/tr2 31 | rval<-pf(x/ndf/scale, ndf,ddf,lower.tail=lower.tail) 32 | 33 | if (method=="saddlepoint"){ 34 | a<-c(a,-x/ddf) 35 | df<-c(df,ddf) 36 | if(any(df>1)) 37 | a<-rep(a,df) 38 | s<-saddle(0,a) 39 | if (!is.na(s)) { 40 | if (lower.tail) 41 | rval<-1-s 42 | else 43 | rval<-s 44 | } 45 | } 46 | rval 47 | } 48 | } 49 | -------------------------------------------------------------------------------- /R/recalibrate.R: -------------------------------------------------------------------------------- 1 | 2 | recalibrate<-function(design, formula, ...){ 3 | 4 | m<-model.matrix(formula, model.frame(design)) 5 | calibrate(design,formula, colSums(m*weights(design))) 6 | 7 | } 8 | -------------------------------------------------------------------------------- /R/rsquared.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | psrsq<-function(object, method=c("Cox-Snell","Nagelkerke"),...){ 4 | UseMethod("psrsq",object) 5 | } 6 | 7 | psrsq.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 | 22 | psrsq.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 | } -------------------------------------------------------------------------------- /R/stdize.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## This is how NCHS does it: postStratify to a table where proportions for by= are specified and then are applied within each cell of over= 3 | ## 4 | svystandardize<-function(design, by, over=~1, population, excluding.missing=NULL){ 5 | 6 | if (!is.null(excluding.missing)){ 7 | mf<-model.frame(excluding.missing, model.frame(design),na.action=na.omit) 8 | naa<-attr(mf,"na.action") 9 | if(!is.null(naa)) design<-design[-naa,] 10 | } 11 | 12 | if(is.data.frame(population)) population<-population$Freq 13 | 14 | if (isTRUE(all.equal(over,~1))){ 15 | freemargins<-data.frame(`_one_`=1, Freq=sum(weights(design, "sampling"))) 16 | } else { 17 | freemargins<-as.data.frame(svytable(over, design)) 18 | } 19 | fixedmargins<-as.data.frame(svytable(by,design)) 20 | fixedmargins$Freq<-as.vector(population)/sum(as.vector(population)) 21 | combined<-make.formula(c(attr(terms(by),"term.labels"), attr(terms(over),"term.labels"))) 22 | allmargins<-as.data.frame(svytable(combined,design)) 23 | allmargins$Freq<-as.vector(outer(fixedmargins$Freq, freemargins$Freq)) 24 | 25 | design<-postStratify(design, combined, allmargins,partial=TRUE) 26 | design$call<-sys.call() 27 | design 28 | } 29 | -------------------------------------------------------------------------------- /R/stratsample.R: -------------------------------------------------------------------------------- 1 | stratsample<-function(strata, counts){ 2 | strata<-as.character(strata) 3 | n<-length(strata) 4 | rval <- integer(sum(counts)) 5 | allrows<-1:n 6 | j<-0 7 | for(i in 1:length(counts)) { 8 | thisstrat<-names(counts)[i] 9 | rval[j+(1:counts[i])]<-sample(allrows[strata==thisstrat],counts[i]) 10 | j<-j+counts[i] 11 | } 12 | rval 13 | } -------------------------------------------------------------------------------- /R/svycdf.R: -------------------------------------------------------------------------------- 1 | svycdf<-function(formula,design,na.rm=TRUE,...) UseMethod("svycdf",design) 2 | 3 | svycdf.default<-function(formula, design,na.rm=TRUE,...){ 4 | if (inherits(formula, "formula")) 5 | x <- model.frame(formula, model.frame(design), na.action = na.pass) 6 | else if (typeof(formula) %in% c("expression", "symbol")) 7 | x <- eval(formula, model.frame(design, na.action = na.pass)) 8 | else x<-formula 9 | if (na.rm) { 10 | nas <- rowSums(is.na(x)) 11 | x <- x[nas == 0, , drop = FALSE] 12 | } 13 | rval<-vector("list",ncol(x)) 14 | names(rval)<-names(x) 15 | for(i in 1:ncol(x)){ 16 | xx<-x[,i] 17 | w <- weights(design,type="sampling")[nas==0] 18 | oo<-order(xx) 19 | cum.w<-cumsum(w[oo])/sum(w) 20 | cdf <- approxfun( xx[oo],cum.w, method = "constant", 21 | yleft =0, yright =1,ties="max") 22 | 23 | class(cdf)<-"stepfun" 24 | call.i<-match.call() 25 | call.i$formula<-as.formula(paste("~",names(x)[i])) 26 | attr(cdf,"call")<-call.i 27 | rval[[names(x)[i]]]<-cdf 28 | } 29 | class(rval)<-"svycdf" 30 | cc<-sys.call() 31 | cc[[1]]<-as.name(.Generic) 32 | attr(rval,"call")<-cc 33 | rval 34 | } 35 | 36 | 37 | print.svycdf<-function(x,...){ 38 | cat("Weighted ECDFs: ") 39 | print(attr(x,"call")) 40 | invisible(x) 41 | } 42 | 43 | plot.svycdf<-function(x,xlab=NULL,...){ 44 | if(is.null(xlab)) 45 | xlab<-names(x) 46 | else if (length(xlab)==1) 47 | xlab<-rep(xlab,length(names(x))) 48 | 49 | for (i in 1:length(x)) plot(x[[i]], xlab =xlab[i], ...) 50 | } 51 | -------------------------------------------------------------------------------- /R/svycontrast_svyvar.R: -------------------------------------------------------------------------------- 1 | svycontrast.svyvar<-function(stat,contrasts,add=FALSE, ...){ 2 | s<-as.vector(as.matrix(stat)) 3 | nms<-as.vector(outer(rownames(stat),colnames(stat),paste,sep=":")) 4 | v<-vcov(stat) 5 | names(s)<-nms 6 | dimnames(v)<-list(nms,nms) 7 | attr(s,"var")<-v 8 | attr(s,"statistic")<-"variance" 9 | class(s)<-"svystat" 10 | svycontrast(s,contrasts=contrasts,add=add,...) 11 | } 12 | -------------------------------------------------------------------------------- /R/svycralpha.R: -------------------------------------------------------------------------------- 1 | 2 | svycralpha<-function(formula, design, na.rm=FALSE){ 3 | 4 | scoredef<-formula 5 | scoredef[[1]]<-quote(I) 6 | design<-eval(bquote(update(design, `*alpha*`= .(scoredef)))) 7 | vtotal<-coef(svyvar(~`*alpha*`,design,na.rm=na.rm)) 8 | vitems <-diag(coef(svyvar(formula, design,na.rm=na.rm))) 9 | K<-length(attr(terms(formula),"term.labels")) 10 | (K/(K-1))*(1-sum(vitems)/vtotal) 11 | } 12 | -------------------------------------------------------------------------------- /R/svyhist.R: -------------------------------------------------------------------------------- 1 | svyhist<-function(formula, design, breaks = "Sturges", 2 | include.lowest = TRUE, right = TRUE, xlab=NULL, 3 | main=NULL, probability=TRUE, 4 | freq=!probability,...){ 5 | if (inherits(design,"DBIsvydesign") || inherits(design,"ODBCsvydesign")){ 6 | design$variables<-getvars(formula, design$db$connection, design$db$tablename, 7 | updates = design$updates) 8 | class(design)<-"survey.design2" 9 | } 10 | mf<-model.frame(formula,model.frame(design), na.action=na.pass) 11 | if (ncol(mf)>1) stop("Only one variable allowed.") 12 | variable<-mf[,1] 13 | varname<-names(mf) 14 | h <- hist(variable, plot=FALSE, breaks=breaks,right=right) 15 | props <- coef(svymean(~cut(variable, h$breaks,right=right, include.lowest=include.lowest), 16 | design, na.rm=TRUE)) 17 | h$density<-props/diff(h$breaks) 18 | h$counts <- props*sum(weights(design,"sampling")) 19 | if (is.null(xlab)) xlab<-varname 20 | if (is.null(main)) main<-paste("Histogram of",varname) 21 | plot(h, ..., freq=freq,xlab=xlab,main=main) 22 | 23 | if (freq){ 24 | h$count_scale <- mean(diff(h$breaks))*sum(weights(design, "sampling")) 25 | } 26 | 27 | invisible(h) 28 | } 29 | -------------------------------------------------------------------------------- /R/svyivreg.R: -------------------------------------------------------------------------------- 1 | 2 | svyivreg<-function(formula, design, ...) UseMethod("svyivreg",design) 3 | 4 | svyivreg.survey.design<-function(formula, design,...){ 5 | 6 | .data<-model.frame(design) 7 | .data$.weights<-weights(design,"sampling") 8 | .weights<-NULL ## make CMD check happy 9 | ##estfun<-get("estfun",mode="function") 10 | model<- AER::ivreg(formula, data=.data, weights=.weights) 11 | 12 | U<-estfun.ivreg(model)/weights(design,"sampling") 13 | n<-NROW(U) 14 | infl<- U%*%model$cov.unscaled 15 | v<-vcov(svytotal(infl, design)) 16 | 17 | model$invinf<-model$cov.unscaled 18 | model$cov.unscaled<-v 19 | model$df.residual<-degf(design)+1-length(coef(model)) 20 | model$sigma<-model$sigma/sqrt(mean(weights(design,"sampling"))) 21 | model$call<-sys.call(-1) 22 | class(model)<-c("svyivreg","ivreg") 23 | model 24 | } 25 | 26 | 27 | summary.svyivreg<-function(object, df = NULL, ...){ 28 | V<-vcov(object) 29 | class(object)<-"ivreg" 30 | summary(object, vcov.=V, df=df, diagnostics=FALSE,...) 31 | } 32 | 33 | vcov.svyivreg<-function(object,...) object$cov.unscaled 34 | 35 | svyivreg.svyrep.design<-function(formula, design,return.replicates=FALSE,...){ 36 | .pweights<-NULL ## make CMD check happy 37 | 38 | withReplicates(design, return.replicates=return.replicates, 39 | function(.weights, .data){ 40 | .data$.pweights<-.weights 41 | m<-AER::ivreg(formula,data= .data, weights=.pweights) 42 | coef(m) 43 | }) 44 | 45 | } 46 | 47 | 48 | estfun.ivreg<-function (x, ...) 49 | { 50 | xmat <- model.matrix(x) 51 | if (any(alias <- is.na(coef(x)))) 52 | xmat <- xmat[, !alias, drop = FALSE] 53 | wts <- weights(x) 54 | if (is.null(wts)) 55 | wts <- 1 56 | res <- residuals(x) 57 | rval <- as.vector(res) * wts * xmat 58 | attr(rval, "assign") <- NULL 59 | attr(rval, "contrasts") <- NULL 60 | return(rval) 61 | } 62 | -------------------------------------------------------------------------------- /R/svykappa.R: -------------------------------------------------------------------------------- 1 | 2 | svykappa<-function(formula, design,...) UseMethod("svykappa",design) 3 | 4 | svykappa.default<-function(formula, design,...) { 5 | if (ncol(attr(terms(formula), "factors")) != 2) 6 | stop("kappa is only computed for two variables") 7 | rows <- formula[[2]][[2]] 8 | cols <- formula[[2]][[3]] 9 | df <- model.frame(design) 10 | nrow <- length(unique(df[[as.character(rows)]])) 11 | ncol <- length(unique(df[[as.character(cols)]])) 12 | rnames<-paste(".",letters,"_",sep="") 13 | cnames<-paste(".",LETTERS,"_",sep="") 14 | if (nrow != ncol) 15 | stop("number of categories is different") 16 | probs <- eval(bquote(svymean(~.(rows) + .(cols) + interaction(.(rows), 17 | .(cols)), design, ...))) 18 | nms <- c(rnames[1:nrow], cnames[1:ncol], outer(1:nrow, 19 | 1:ncol, function(i, j) paste(rnames[i], cnames[j], 20 | sep = "."))) 21 | names(probs) <- nms 22 | v <- vcov(probs) 23 | dimnames(v) <- list(nms, nms) 24 | attr(probs, "var") <- v 25 | obs <- parse(text = paste(nms[nrow + ncol + 1+ (0:(nrow-1))*(ncol+1)], 26 | collapse = "+"))[[1]] 27 | expect <- parse(text = paste(nms[1:nrow], nms[nrow + 1:ncol], 28 | sep = "*", collapse = "+"))[[1]] 29 | svycontrast(probs, list(kappa = bquote((.(obs) - .(expect))/(1 - 30 | .(expect))))) 31 | } 32 | 33 | 34 | 35 | "names<-.svrepstat"<-function(x, value){ 36 | if (is.list(x) && !is.null(x$replicates)){ 37 | names(x[[1]])<-value 38 | colnames(x$replicates)<-value 39 | x 40 | } else NextMethod() 41 | 42 | } 43 | -------------------------------------------------------------------------------- /R/svypredmeans.R: -------------------------------------------------------------------------------- 1 | 2 | svypredmeans<-function(adjustmodel, groupfactor, predictat=NULL){ 3 | 4 | 5 | design<-eval(bquote(update(adjustmodel$survey.design, .groupfactor=.(groupfactor[[2]])))) 6 | if(is.null(predictat)){ 7 | groups<-unique(model.frame(design)$.groupfactor) 8 | groups<-groups[!is.na(groups)] 9 | } else { 10 | groups <- predictat 11 | } 12 | model<-update(adjustmodel, .~.+.groupfactor,design=design) 13 | w<-weights(design,"sampling") 14 | 15 | fits<-matrix(nrow=NROW(design),ncol=length(groups)) 16 | dg_deta<-matrix(nrow=length(coef(model)),ncol=length(groups)) 17 | for(i in 1:length(groups)){ 18 | mf<-model.frame(design) 19 | mf$.groupfactor<-groups[i] 20 | mu<-predict(model,newdata=mf,type="response",se.fit=FALSE) 21 | eta<-predict(model,newdata=mf,type="link",se.fit=FALSE) 22 | fits[,i]<-coef(mu) 23 | 24 | mm<-model.matrix(terms(model),mf) 25 | dg_deta[,i]<-t(colSums(w*model$family$mu.eta(eta)*mm))/sum(w) 26 | } 27 | colnames(fits)<-as.character(groups) 28 | cond<-svymean(fits,design) 29 | addvar<-t(dg_deta)%*%vcov(model)%*%dg_deta 30 | vv<-addvar+attr(cond,"var") 31 | attr(vv,"parts")<-list(addvar,attr(cond,"var")) 32 | attr(cond,"var")<-vv 33 | cond 34 | } 35 | 36 | -------------------------------------------------------------------------------- /R/svyqq.R: -------------------------------------------------------------------------------- 1 | 2 | svyqqmath<-function(x, design, null=qnorm, na.rm=TRUE,xlab="Expected",ylab="Observed",...){ 3 | 4 | if (inherits(x, "formula")) 5 | x <- model.frame(x, model.frame(design), na.action = na.pass) 6 | else if (typeof(x) %in% c("expression", "symbol")) 7 | x <- eval(x, model.frame(design, na.action = na.pass)) 8 | if (na.rm) { 9 | nas <- rowSums(is.na(x)) 10 | design <- design[nas == 0, ] 11 | if (length(nas) > length(design$prob)) 12 | x <- x[nas == 0, , drop = FALSE] 13 | else x[nas > 0, ] <- 0 14 | } 15 | n<-NROW(x) 16 | for(variable in seq_len(NCOL(x))){ 17 | ii<-order(x[, variable]) 18 | obsi<-x[ii, variable] 19 | w<-weights(design,"sampling")[ii] 20 | cumw<-(cumsum(w)/sum(w))*(n/(n+1)) 21 | expi<-null(cumw) 22 | plot(expi,obsi,xlab=xlab,ylab=ylab,...) 23 | } 24 | invisible(NULL) 25 | } 26 | 27 | 28 | svyqqplot<-function(formula, design, designx=NULL, na.rm=TRUE,qrule="hf8",xlab=NULL,ylab=NULL,...){ 29 | if (is.null(designx)){ 30 | if (inherits(formula, "formula")) 31 | x <- model.frame(formula, model.frame(design), na.action = na.pass) 32 | else if (typeof(x) %in% c("expression", "symbol")) 33 | x <- eval(formula, model.frame(design, na.action = na.pass)) 34 | if (na.rm) { 35 | nas <- rowSums(is.na(x)) 36 | design <- design[nas == 0, ] 37 | if (length(nas) > length(design$prob)) 38 | x <- x[nas == 0, , drop = FALSE] 39 | else x[nas > 0, ] <- 0 40 | } 41 | Y<-x[,1] 42 | X<-x[,2] 43 | wx<-wy<-weights(design,"sampling") 44 | } else { 45 | xform<-formula[-2] 46 | yform<-make.formula(formula[[2]]) 47 | environment(yform)<-environment(formula) 48 | Y<- model.frame(formula, model.frame(design), na.action = na.pass)[[1]] 49 | wy<-weights(design,"sampling") 50 | X<- model.frame(formula, model.frame(designx), na.action = na.pass)[[1]] 51 | wx<-weights(designx,"sampling") 52 | } 53 | n<-length(Y) 54 | m<-length(X) 55 | if(is.null(xlab)) xlab<-deparse(formula[[3]]) 56 | if(is.null(ylab)) ylab<-deparse(formula[[2]]) 57 | 58 | if(is.character(qrule)) 59 | qrule<-get(paste("qrule",qrule,sep="_"), mode="function") 60 | 61 | if (nm){ 64 | Y<-sapply(1:m, function(i) qrule(Y,wy, i/m)) 65 | } 66 | plot(sort(X),sort(Y),xlab=xlab,ylab=ylab,...) 67 | 68 | } 69 | -------------------------------------------------------------------------------- /R/svysurvreg.R: -------------------------------------------------------------------------------- 1 | svysurvreg<-function (formula, design, weights=NULL, subset = NULL, ...) 2 | { 3 | UseMethod("svysurvreg", design) 4 | } 5 | 6 | residuals.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 | 13 | svysurvreg.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 | -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/R/sysdata.rda -------------------------------------------------------------------------------- /R/transform.R: -------------------------------------------------------------------------------- 1 | ## another name for update() 2 | transform.survey.design<-function(`_data`, ...) update(`_data`,...) 3 | transform.svyrep.design<-function(`_data`, ...) update(`_data`,...) 4 | transform.twophase<-function(`_data`, ...) update(`_data`,...) 5 | transform.twophase2<-function(`_data`, ...) update(`_data`,...) 6 | transform.ODBCsvydesign<-function(`_data`, ...) update(`_data`,...) 7 | transform.DBIsvydesign<-function(`_data`, ...) update(`_data`,...) 8 | transform.svyimputationList<-function(`_data`, ...) update(`_data`,...) 9 | 10 | -------------------------------------------------------------------------------- /R/withPV.R: -------------------------------------------------------------------------------- 1 | 2 | withPV.survey.design<-withPV.svyrep.design<-function(mapping, data, action, rewrite=TRUE,...){ 3 | 4 | if(inherits(mapping,"formula")) mapping<-list(mapping) 5 | 6 | if (!is.list(mapping)) 7 | stop("'mapping' must be a list of formulas") 8 | 9 | if (!all(sapply(mapping, length)==3)) 10 | stop("'mapping' must be a list of two-sided formulas") 11 | 12 | df<-model.frame(data,na.action=na.pass) 13 | PVframes<-lapply(mapping, 14 | function(f) model.frame(f[-2], model.frame(data,na.action=na.pass))) 15 | nvars<-length(PVframes) 16 | PVnames<-sapply(mapping, function(f) deparse(f[[2]])) 17 | if (any(PVnames %in% colnames(data))) 18 | stop("working PV names must not already occur in the data") 19 | 20 | nreps<-sapply(PVframes, NCOL) 21 | if (length(unique(nreps))>1) 22 | stop("number of plausible values must be the same for all variables") 23 | nreps<-nreps[1] 24 | 25 | results<-vector("list",nreps) 26 | 27 | if(rewrite){ 28 | sublist<-vector("list",nvars) 29 | names(sublist)<-PVnames 30 | for(i in 1:nreps){ 31 | for(j in 1:nvars) sublist[[j]]<-as.name(names(PVframes[[j]])[i]) 32 | 33 | if (is.function(action)){ 34 | actioni<-action 35 | body(actioni) <- eval(bquote(substitute(.(body(actioni)), sublist))) 36 | results[[i]]<- action(data) 37 | } else { 38 | actioni <- eval(bquote(substitute(.(action), sublist))) 39 | results[[i]] <- eval(actioni) 40 | } 41 | } 42 | 43 | 44 | } else { 45 | .DESIGN<-data 46 | 47 | for(i in 1:nreps){ 48 | dfi<-lapply(PVframes, function(d) d[[i]]) 49 | names(dfi)<-PVnames 50 | .DESIGN$variables<-cbind(df, as.data.frame(dfi)) 51 | if (is.function(action)) 52 | results[[i]] <- action(.DESIGN) 53 | else 54 | results[[i]] <- eval(action) 55 | } 56 | 57 | } 58 | attr(results,"call")<-sys.call() 59 | results 60 | } 61 | 62 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | Possible additional developments in no particular order: 2 | --------------------------------------------------------- 3 | 4 | [done?] options to handle quantiles in rounded continuous data like SUDAAN 5 | does (if I can work out what it does). 6 | 7 | - Score-based confidence intervals for glms 8 | 9 | [mostly done] Rao-Scott-type tests for glms. 10 | 11 | [done] AIC/BIC 12 | 13 | - better choice of denominator df for tests 14 | 15 | [done] More general HT estimator for sampling without replacement 16 | - using joint inclusion probabilities 17 | - using population first-order inclusion probabilities and Hartley-Rao approximation 18 | - using Overton's approximation and sample inclusion probabilities 19 | - using Berger's approximation and sample inclusion probabilities. 20 | 21 | - GEE (you can do the independence working model just as another level of clustering). 22 | 23 | - an interface to the Auckland semiparametric approach to two-phase designs. 24 | 25 | - Parametric survival models (you can do these with svymle) 26 | 27 | - linear mixed models? 28 | - simpler case: multilevel model following sampling design 29 | - nested model exactly matching design 30 | - design is simpler than model 31 | - interesting case: separate model and sampling designs. 32 | - cluster sampling, so that higher-order sampling probabilities are available 33 | - more general sampling. 34 | 35 | [done] standard errors for survival curves, particularly in two-phase studies 36 | 37 | - an interface to twophase and calibrate for IPTW estimation. 38 | 39 | - Replicate weights for two-phase designs 40 | [done] and for multistage designs with large sampling fraction (Fukuoka's BBE?) 41 | 42 | [experimental] parallel processing for replicate weights, svyby(), svyrecvar()? 43 | 44 | - Gini index and other summaries of concentration and inequality. 45 | 46 | - Krista Giles' respondent-driven sampling estimators? 47 | 48 | [done] database-backed designs for replicate weights. 49 | 50 | - Multivariate statistics 51 | [done] principal components 52 | [experimental] factor analysis 53 | [done in lavaan.survey package] SEMs? 54 | 55 | ########## things to fix ################ 56 | 57 | Use naresid() to get better missing-value handling in svyglm, panel.svysmooth, etc 58 | -------------------------------------------------------------------------------- /build/vignette.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/build/vignette.rds -------------------------------------------------------------------------------- /data/api.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/data/api.rda -------------------------------------------------------------------------------- /data/crowd.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/data/crowd.rda -------------------------------------------------------------------------------- /data/election.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/data/election.rda -------------------------------------------------------------------------------- /data/fpc.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/data/fpc.rda -------------------------------------------------------------------------------- /data/hospital.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/data/hospital.rda -------------------------------------------------------------------------------- /data/mu284.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/data/mu284.rda -------------------------------------------------------------------------------- /data/myco.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/data/myco.rda -------------------------------------------------------------------------------- /data/nhanes.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/data/nhanes.rda -------------------------------------------------------------------------------- /data/salamander.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/data/salamander.rda -------------------------------------------------------------------------------- /data/scd.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/data/scd.rda -------------------------------------------------------------------------------- /data/yrbs.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/data/yrbs.rda -------------------------------------------------------------------------------- /inst/BUGS: -------------------------------------------------------------------------------- 1 | Known bug: 2 | 3 | 1. calibrate and postStratify do not recompute the 4 | finite population correction. This matters only 5 | when the sampling fraction is very close to one 6 | 7 | 2. svydesign should check that `weights` is the right length 8 | 9 | 3. options(survey.lonely.psu="adjust") does not do what it says in the 10 | case of svytotal(). Not yet clear whether it does the right thing, though. 11 | 12 | 13 | 4. Should drop unused factor levels from strata, but don't. -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite the survey package in publications use one or more of:") 2 | 3 | bibentry(bibtype="misc", 4 | author="Thomas Lumley", 5 | year=2024, 6 | title="survey: analysis of complex survey samples", 7 | note="R package version 4.4", 8 | textVersion="T. Lumley (2024) \"survey: analysis of complex survey samples\". R package version 4.4." ) 9 | 10 | 11 | 12 | bibentry(bibtype="article", 13 | year=2004, 14 | author="Thomas Lumley", 15 | title = "Analysis of Complex Survey Samples", 16 | journal="Journal of Statistical Software", 17 | volume="9",number=1,pages="1-19", 18 | note="R package verson 2.2", 19 | textVersion="T. Lumley (2004) Analysis of complex survey samples. Journal of Statistical Software 9(1): 1-19" 20 | ) 21 | 22 | 23 | bibentry(bibtype="book", 24 | year=2010, 25 | author="Thomas Lumley", 26 | title = "Complex Surveys: A Guide to Analysis Using R: A Guide to Analysis Using R", 27 | publisher="John Wiley and Sons", 28 | textVersion="T. Lumley (2010) Complex Surveys: A Guide to Analysis Using R. John Wiley and Sons." 29 | ) 30 | 31 | -------------------------------------------------------------------------------- /inst/COPYING: -------------------------------------------------------------------------------- 1 | Except as otherwise stated, the code is copyright 2002-2014 Thomas Lumley 2 | 3 | svyolr() and many of its methods are closely based on polr() from the 4 | MASS package, copyright Brian Ripley and Bill Venables. 5 | 6 | -------------------------------------------------------------------------------- /inst/api.db: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/inst/api.db -------------------------------------------------------------------------------- /inst/disclaimer: -------------------------------------------------------------------------------- 1 | This software comes with NO WARRANTY WHATSOEVER. This product has not 2 | been evaluated by the Food and Drug Administration and is not intended 3 | to diagnose, treat, cure, or prevent any disease. If it breaks you get 4 | to keep both pieces. Not tested on animals. Your mileage may vary. 5 | Keep out of reach of babies and small children. For external use only. 6 | Times are approximate. Batteries not included. 7 | Product of more than one country. 8 | May contain nuts. 9 | -------------------------------------------------------------------------------- /inst/doc/domain.R: -------------------------------------------------------------------------------- 1 | ### R code from vignette source 'domain.Rnw' 2 | 3 | ################################################### 4 | ### code chunk number 1: domain.Rnw:29-34 5 | ################################################### 6 | library(survey) 7 | data(fpc) 8 | dfpc<-svydesign(id=~psuid,strat=~stratid,weight=~weight,data=fpc,nest=TRUE) 9 | dsub<-subset(dfpc,x>4) 10 | svymean(~x,design=dsub) 11 | 12 | 13 | ################################################### 14 | ### code chunk number 2: domain.Rnw:41-42 15 | ################################################### 16 | svyby(~x,~I(x>4),design=dfpc, svymean) 17 | 18 | 19 | ################################################### 20 | ### code chunk number 3: domain.Rnw:49-50 21 | ################################################### 22 | summary(svyglm(x~I(x>4)+0,design=dfpc)) 23 | 24 | 25 | ################################################### 26 | ### code chunk number 4: domain.Rnw:57-58 27 | ################################################### 28 | svyratio(~I(x*(x>4)),~as.numeric(x>4), dfpc) 29 | 30 | 31 | ################################################### 32 | ### code chunk number 5: domain.Rnw:76-84 33 | ################################################### 34 | data(api) 35 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 36 | pop.totals<-c(`(Intercept)`=6194, stypeH=755, stypeM=1018) 37 | gclus1 <- calibrate(dclus1, ~stype+api99, c(pop.totals, api99=3914069)) 38 | 39 | svymean(~api00, subset(gclus1, comp.imp=="Yes")) 40 | svyratio(~I(api00*(comp.imp=="Yes")), ~as.numeric(comp.imp=="Yes"), gclus1) 41 | summary(svyglm(api00~comp.imp-1, gclus1)) 42 | 43 | 44 | ################################################### 45 | ### code chunk number 6: domain.Rnw:88-94 46 | ################################################### 47 | data(mu284) 48 | dmu284<-svydesign(id=~id1+id2,fpc=~n1+n2, data=mu284) 49 | 50 | svymean(~y1, subset(dmu284,y1>40)) 51 | svyratio(~I(y1*(y1>40)),~as.numeric(y1>40),dmu284) 52 | summary(svyglm(y1~I(y1>40)+0,dmu284)) 53 | 54 | 55 | ################################################### 56 | ### code chunk number 7: domain.Rnw:100-108 57 | ################################################### 58 | library("survival") 59 | data(nwtco) 60 | nwtco$incc2<-as.logical(with(nwtco, ifelse(rel | instit==2,1,rbinom(nrow(nwtco),1,.1)))) 61 | dccs8<-twophase(id=list(~seqno,~seqno), strata=list(NULL,~interaction(rel,stage,instit)), 62 | data=nwtco, subset=~incc2) 63 | svymean(~rel, subset(dccs8,age>36)) 64 | svyratio(~I(rel*as.numeric(age>36)), ~as.numeric(age>36), dccs8) 65 | summary(svyglm(rel~I(age>36)+0, dccs8)) 66 | 67 | 68 | -------------------------------------------------------------------------------- /inst/doc/domain.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/inst/doc/domain.pdf -------------------------------------------------------------------------------- /inst/doc/epi.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/inst/doc/epi.pdf -------------------------------------------------------------------------------- /inst/doc/nwtco-subcohort.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/inst/doc/nwtco-subcohort.rda -------------------------------------------------------------------------------- /inst/doc/nwts.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/inst/doc/nwts.rda -------------------------------------------------------------------------------- /inst/doc/phase1.R: -------------------------------------------------------------------------------- 1 | ### R code from vignette source 'phase1.Rnw' 2 | 3 | ################################################### 4 | ### code chunk number 1: phase1.Rnw:82-105 5 | ################################################### 6 | rei<-read.table(textConnection( 7 | " id N n.a h n.ah n.h sub y 8 | 1 1 300 20 1 12 5 TRUE 1 9 | 2 2 300 20 1 12 5 TRUE 2 10 | 3 3 300 20 1 12 5 TRUE 3 11 | 4 4 300 20 1 12 5 TRUE 4 12 | 5 5 300 20 1 12 5 TRUE 5 13 | 6 6 300 20 1 12 5 FALSE NA 14 | 7 7 300 20 1 12 5 FALSE NA 15 | 8 8 300 20 1 12 5 FALSE NA 16 | 9 9 300 20 1 12 5 FALSE NA 17 | 10 10 300 20 1 12 5 FALSE NA 18 | 11 11 300 20 1 12 5 FALSE NA 19 | 12 12 300 20 1 12 5 FALSE NA 20 | 13 13 300 20 2 8 3 TRUE 6 21 | 14 14 300 20 2 8 3 TRUE 7 22 | 15 15 300 20 2 8 3 TRUE 8 23 | 16 16 300 20 2 8 3 FALSE NA 24 | 17 17 300 20 2 8 3 FALSE NA 25 | 18 18 300 20 2 8 3 FALSE NA 26 | 19 19 300 20 2 8 3 FALSE NA 27 | 20 20 300 20 2 8 3 FALSE NA 28 | "), header=TRUE) 29 | 30 | 31 | ################################################### 32 | ### code chunk number 2: phase1.Rnw:109-113 33 | ################################################### 34 | library(survey) 35 | des.rei <- twophase(id=list(~id,~id), strata=list(NULL,~h), 36 | fpc=list(~N,NULL), subset=~sub, data=rei) 37 | tot<- svytotal(~y, des.rei) 38 | 39 | 40 | ################################################### 41 | ### code chunk number 3: phase1.Rnw:117-124 42 | ################################################### 43 | rei$w.ah <- rei$n.ah / rei$n.a 44 | a.rei <- aggregate(rei, by=list(rei$h), mean, na.rm=TRUE) 45 | a.rei$S.ysh <- tapply(rei$y, rei$h, var, na.rm=TRUE) 46 | a.rei$y.u <- sum(a.rei$w.ah * a.rei$y) 47 | a.rei$f<-with(a.rei, n.a/N) 48 | a.rei$delta.h<-with(a.rei, (1/n.h)*(n.a-n.ah)/(n.a-1)) 49 | Vphase1<-with(a.rei, sum(N*N*((1-f)/n.a)*( w.ah*(1-delta.h)*S.ysh+ ((n.a)/(n.a-1))*w.ah*(y-y.u)^2))) 50 | 51 | 52 | ################################################### 53 | ### code chunk number 4: phase1.Rnw:128-130 54 | ################################################### 55 | Vphase1 56 | attr(vcov(tot),"phases")$phase1 57 | 58 | 59 | -------------------------------------------------------------------------------- /inst/doc/phase1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/inst/doc/phase1.pdf -------------------------------------------------------------------------------- /inst/doc/pps.R: -------------------------------------------------------------------------------- 1 | ### R code from vignette source 'pps.Rnw' 2 | 3 | ################################################### 4 | ### code chunk number 1: pps.Rnw:57-61 5 | ################################################### 6 | library(survey) 7 | data(election) 8 | summary(election$p) 9 | summary(election_pps$p) 10 | 11 | 12 | ################################################### 13 | ### code chunk number 2: pps.Rnw:65-77 14 | ################################################### 15 | ## Hajek type 16 | dpps_br<- svydesign(id=~1, fpc=~p, data=election_pps, pps="brewer") 17 | ## Horvitz-Thompson type 18 | dpps_ov<- svydesign(id=~1, fpc=~p, data=election_pps, pps="overton") 19 | dpps_hr<- svydesign(id=~1, fpc=~p, data=election_pps, pps=HR(sum(election$p^2)/40)) 20 | dpps_hr1<- svydesign(id=~1, fpc=~p, data=election_pps, pps=HR()) 21 | dpps_ht<- svydesign(id=~1, fpc=~p, data=election_pps, pps=ppsmat(election_jointprob)) 22 | ## Yates-Grundy type 23 | dpps_yg<- svydesign(id=~1, fpc=~p, data=election_pps, pps=ppsmat(election_jointprob),variance="YG") 24 | dpps_hryg<- svydesign(id=~1, fpc=~p, data=election_pps, pps=HR(sum(election$p^2)/40),variance="YG") 25 | ## The with-replacement approximation 26 | dppswr <-svydesign(id=~1, probs=~p, data=election_pps) 27 | 28 | 29 | ################################################### 30 | ### code chunk number 3: pps.Rnw:81-82 31 | ################################################### 32 | show(image(dpps_ht)) 33 | 34 | 35 | ################################################### 36 | ### code chunk number 4: pps.Rnw:84-85 37 | ################################################### 38 | show(image(dpps_ov)) 39 | 40 | 41 | ################################################### 42 | ### code chunk number 5: pps.Rnw:91-99 43 | ################################################### 44 | svytotal(~Bush+Kerry+Nader, dpps_ht) 45 | svytotal(~Bush+Kerry+Nader, dpps_yg) 46 | svytotal(~Bush+Kerry+Nader, dpps_hr) 47 | svytotal(~Bush+Kerry+Nader, dpps_hryg) 48 | svytotal(~Bush+Kerry+Nader, dpps_hr1) 49 | svytotal(~Bush+Kerry+Nader, dpps_br) 50 | svytotal(~Bush+Kerry+Nader, dpps_ov) 51 | svytotal(~Bush+Kerry+Nader, dppswr) 52 | 53 | 54 | -------------------------------------------------------------------------------- /inst/doc/pps.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/inst/doc/pps.pdf -------------------------------------------------------------------------------- /inst/doc/precalibrated.R: -------------------------------------------------------------------------------- 1 | ### R code from vignette source 'precalibrated.Rnw' 2 | 3 | ################################################### 4 | ### code chunk number 1: precalibrated.Rnw:16-19 5 | ################################################### 6 | library(survey) 7 | data(api) 8 | dclus1 <- svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) 9 | 10 | 11 | ################################################### 12 | ### code chunk number 2: precalibrated.Rnw:24-28 13 | ################################################### 14 | sum(weights(dclus1)) 15 | dim(apipop) 16 | dclus1<-update(dclus1, one=rep(1,nrow(dclus1))) 17 | svytotal(~one,dclus1) 18 | 19 | 20 | ################################################### 21 | ### code chunk number 3: precalibrated.Rnw:34-36 22 | ################################################### 23 | cal_dclus1<-calibrate(dclus1, formula=~1, population=sum(weights(dclus1))) 24 | svytotal(~one,cal_dclus1) 25 | 26 | 27 | ################################################### 28 | ### code chunk number 4: precalibrated.Rnw:40-41 29 | ################################################### 30 | summary(weights(cal_dclus1)/weights(dclus1)) 31 | 32 | 33 | ################################################### 34 | ### code chunk number 5: precalibrated.Rnw:45-50 35 | ################################################### 36 | precal_dclus1<-svydesign(id = ~dnum, weights = ~pw, data = apiclus1, 37 | fpc = ~fpc, calibrate.formula=~1) 38 | precal_dclus1<-update(precal_dclus1, one=rep(1,nrow(dclus1))) 39 | 40 | svytotal(~one,precal_dclus1) 41 | 42 | 43 | ################################################### 44 | ### code chunk number 6: precalibrated.Rnw:55-64 45 | ################################################### 46 | (enroll_t<-svytotal(~enroll, dclus1)) 47 | (enroll_m<-svymean(~enroll, dclus1)) 48 | SE(enroll_m) 49 | SE(enroll_t)/6194 50 | 51 | (cenroll_t<-svytotal(~enroll, precal_dclus1)) 52 | (cenroll_m<-svymean(~enroll, precal_dclus1)) 53 | SE(cenroll_m) 54 | SE(cenroll_t)/6194 55 | 56 | 57 | -------------------------------------------------------------------------------- /inst/doc/precalibrated.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/inst/doc/precalibrated.pdf -------------------------------------------------------------------------------- /inst/doc/qrule.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/inst/doc/qrule.pdf -------------------------------------------------------------------------------- /inst/doc/survey-sae.html.asis: -------------------------------------------------------------------------------- 1 | %\VignetteIndexEntry{Small area estimation} 2 | %\VignetteEngine{R.rsp::asis} 3 | -------------------------------------------------------------------------------- /inst/doc/survey.R: -------------------------------------------------------------------------------- 1 | ### R code from vignette source 'survey.Rnw' 2 | 3 | ################################################### 4 | ### code chunk number 1: survey.Rnw:26-29 5 | ################################################### 6 | library(survey) 7 | data(api) 8 | dclus1 <- svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) 9 | 10 | 11 | ################################################### 12 | ### code chunk number 2: survey.Rnw:33-34 13 | ################################################### 14 | summary(dclus1) 15 | 16 | 17 | ################################################### 18 | ### code chunk number 3: survey.Rnw:43-48 19 | ################################################### 20 | svymean(~api00, dclus1) 21 | svyquantile(~api00, dclus1, quantile=c(0.25,0.5,0.75), ci=TRUE) 22 | svytotal(~stype, dclus1) 23 | svytotal(~enroll, dclus1) 24 | svyratio(~api.stu,~enroll, dclus1) 25 | 26 | 27 | ################################################### 28 | ### code chunk number 4: survey.Rnw:55-56 29 | ################################################### 30 | svyratio(~api.stu, ~enroll, design=subset(dclus1, stype=="H")) 31 | 32 | 33 | ################################################### 34 | ### code chunk number 5: survey.Rnw:64-66 35 | ################################################### 36 | vars<-names(apiclus1)[c(12:13,16:23,27:37)] 37 | svymean(make.formula(vars),dclus1,na.rm=TRUE) 38 | 39 | 40 | ################################################### 41 | ### code chunk number 6: survey.Rnw:73-74 42 | ################################################### 43 | svyby(~ell+meals, ~stype, design=dclus1, svymean) 44 | 45 | 46 | ################################################### 47 | ### code chunk number 7: survey.Rnw:79-83 48 | ################################################### 49 | regmodel <- svyglm(api00~ell+meals,design=dclus1) 50 | logitmodel <- svyglm(I(sch.wide=="Yes")~ell+meals, design=dclus1, family=quasibinomial()) 51 | summary(regmodel) 52 | summary(logitmodel) 53 | 54 | 55 | ################################################### 56 | ### code chunk number 8: survey.Rnw:87-88 57 | ################################################### 58 | gclus1 <- calibrate(dclus1, formula=~api99, population=c(6194, 3914069)) 59 | 60 | 61 | ################################################### 62 | ### code chunk number 9: survey.Rnw:91-96 63 | ################################################### 64 | svymean(~api00, gclus1) 65 | svyquantile(~api00, gclus1, quantile=c(0.25,0.5,0.75), ci=TRUE) 66 | svytotal(~stype, gclus1) 67 | svytotal(~enroll, gclus1) 68 | svyratio(~api.stu,~enroll, gclus1) 69 | 70 | 71 | -------------------------------------------------------------------------------- /inst/doc/survey.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/inst/doc/survey.pdf -------------------------------------------------------------------------------- /inst/porting.to.S: -------------------------------------------------------------------------------- 1 | Version 3.6-12 is available for S-PLUS 8.0, ported by Patrick Aboyoun, 2 | who was then at what was then Insightful. Comparing this to the R version 3 | 3.6-12 should help if you want to port more recent versions. 4 | 5 | -------------------------------------------------------------------------------- /inst/twostage.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/inst/twostage.pdf -------------------------------------------------------------------------------- /inst/ucla-examples.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/inst/ucla-examples.pdf -------------------------------------------------------------------------------- /man/HR.Rd: -------------------------------------------------------------------------------- 1 | \name{HR} 2 | \Rdversion{1.1} 3 | \alias{HR} 4 | \alias{ppsmat} 5 | \alias{ppscov} 6 | %- Also NEED an '\alias' for EACH other topic documented here. 7 | \title{Wrappers for specifying PPS designs} 8 | \description{ 9 | The Horvitz-Thompson estimator and the Hartley-Rao approximation require information in addition to the sampling probabilities for sampled individuals. These functions allow this information to be supplied. 10 | } 11 | \usage{ 12 | HR(psum=NULL, strata = NULL) 13 | ppsmat(jointprob, tolerance = 1e-04) 14 | ppscov(probcov, weighted=FALSE) 15 | } 16 | %- maybe also 'usage' for other objects documented here. 17 | \arguments{ 18 | \item{psum}{ The sum of squared sampling probabilities for the population, divided by the sample size, as a single number or as a vector for stratified sampling 19 | } 20 | \item{strata}{ 21 | Stratum labels, of the same length as \code{psum}, if \code{psum} is a vector 22 | } 23 | \item{jointprob}{Matrix of pairwise sampling probabilities for the sampled individuals} 24 | \item{tolerance}{Tolerance for deciding that the covariance of sampling indicators is zero} 25 | \item{probcov}{Covariance of the sampling indicators (often written 'Delta'), or weighted covariance if \code{weighted=TRUE}} 26 | \item{weighted}{If \code{TRUE}, the \code{probcov} argument is the covariance divided by pairwise sampling probabilities} 27 | } 28 | \value{ 29 | An object of class \code{HR},\code{ppsmat}, \code{ppsdelta}, or \code{ppsdcheck} suitable for supplying as the \code{pps} argument to \code{\link{svydesign}}. 30 | } 31 | 32 | \seealso{ 33 | \link{election} for examples of PPS designs 34 | } 35 | \examples{ 36 | HR(0.1) 37 | } 38 | % Add one or more standard keywords, see file 'KEYWORDS' in the 39 | % R documentation directory. 40 | \keyword{survey} 41 | 42 | -------------------------------------------------------------------------------- /man/SE.Rd: -------------------------------------------------------------------------------- 1 | \name{SE} 2 | \alias{SE} 3 | \alias{SE.default} 4 | \alias{SE.svrepstat} 5 | %- Also NEED an '\alias' for EACH other topic documented here. 6 | \title{Extract standard errors } 7 | \description{ 8 | Extracts standard errors from an object. The default method is for 9 | objects with a \code{\link{vcov}} method. 10 | } 11 | \usage{ 12 | SE(object, ...) 13 | \method{SE}{default}(object,...) 14 | \method{SE}{svrepstat}(object,...) 15 | } 16 | %- maybe also 'usage' for other objects documented here. 17 | \arguments{ 18 | \item{object}{An object} 19 | \item{\dots}{Arguments for future expansion } 20 | } 21 | \value{ 22 | Vector of standard errors. 23 | } 24 | \seealso{ \code{\link{vcov}}} 25 | 26 | \keyword{models}% at least one, from doc/KEYWORDS 27 | 28 | -------------------------------------------------------------------------------- /man/as.fpc.Rd: -------------------------------------------------------------------------------- 1 | \name{as.fpc} 2 | \alias{as.fpc} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ Package sample and population size data} 5 | \description{ 6 | This function creates an object to store the number of clusters sampled 7 | within each stratum (at each stage of multistage sampling) and the 8 | number of clusters available in the population. It is called by 9 | \code{svydesign}, not directly by the user. 10 | } 11 | \usage{ 12 | as.fpc(df, strata, ids,pps=FALSE) 13 | } 14 | %- maybe also 'usage' for other objects documented here. 15 | \arguments{ 16 | \item{df}{A data frame or matrix with population size information} 17 | \item{strata}{A data frame giving strata at each stage} 18 | \item{ids}{A data frame giving cluster ids at each stage} 19 | \item{pps}{if \code{TRUE}, fpc information may vary within a stratum 20 | and must be specified as a proportion rather than a population sizes} 21 | } 22 | \details{ 23 | The population size information may be specified as the number of 24 | clusters in the population or as the proportion of clusters sampled. 25 | 26 | } 27 | \value{ 28 | An object of class \code{survey_fpc} 29 | } 30 | 31 | 32 | \seealso{\code{\link{svydesign}},\code{\link{svyrecvar}}} 33 | 34 | \keyword{survey}% at least one, from doc/KEYWORDS 35 | \keyword{manip}% __ONLY ONE__ keyword per line 36 | -------------------------------------------------------------------------------- /man/as.svydesign2.Rd: -------------------------------------------------------------------------------- 1 | \name{as.svydesign2} 2 | \alias{as.svydesign2} 3 | \alias{.svycheck} 4 | %- Also NEED an '\alias' for EACH other topic documented here. 5 | \title{Update to the new survey design format} 6 | \description{ 7 | The structure of survey design objects changed in version 2.9, to allow 8 | standard errors based on multistage sampling. \code{as.svydesign} converts an 9 | object to the new structure and \code{.svycheck} warns if an object 10 | does not have the new structure. 11 | 12 | You can set \code{options(survey.want.obsolete=TRUE)} to suppress the 13 | warnings produced by \code{.svycheck} and 14 | \code{options(survey.ultimate.cluster=TRUE)} to always compute 15 | variances based on just the first stage of sampling. 16 | } 17 | \usage{ 18 | as.svydesign2(object) 19 | .svycheck(object) 20 | } 21 | %- maybe also 'usage' for other objects documented here. 22 | \arguments{ 23 | \item{object}{produced by \code{svydesign}} 24 | } 25 | 26 | \value{ 27 | Object of class \code{survey.design2} 28 | } 29 | 30 | \seealso{\code{\link{svydesign}}, \code{\link{svyrecvar}}} 31 | 32 | \keyword{survey}% at least one, from doc/KEYWORDS 33 | \keyword{manip}% __ONLY ONE__ keyword per line 34 | -------------------------------------------------------------------------------- /man/barplot.svystat.Rd: -------------------------------------------------------------------------------- 1 | \name{barplot.svystat} 2 | \alias{barplot.svystat} 3 | \alias{barplot.svrepstat} 4 | \alias{barplot.svyby} 5 | \alias{dotchart} 6 | \alias{dotchart.svystat} 7 | \alias{dotchart.svrepstat} 8 | \alias{dotchart.svyby} 9 | %- Also NEED an '\alias' for EACH other topic documented here. 10 | \title{ Barplots and Dotplots } 11 | \description{ 12 | Draws a barplot or dotplot based on results from a survey analysis. The default 13 | barplot method already works for results from \code{\link{svytable}}. 14 | } 15 | \usage{ 16 | \method{barplot}{svystat}(height, ...) 17 | \method{barplot}{svrepstat}(height, ...) 18 | \method{barplot}{svyby}(height,beside=TRUE, ...) 19 | 20 | \method{dotchart}{svystat}(x,...,pch=19) 21 | \method{dotchart}{svrepstat}(x,...,pch=19) 22 | \method{dotchart}{svyby}(x,...,pch=19) 23 | } 24 | %- maybe also 'usage' for other objects documented here. 25 | \arguments{ 26 | \item{height,x}{Analysis result } 27 | \item{beside}{Grouped, rather than stacked, bars} 28 | \item{\dots}{ Arguments to \code{\link{barplot}} or \code{dotchart} } 29 | \item{pch}{Overrides the default in \code{dotchart.default}} 30 | } 31 | 32 | 33 | \examples{ 34 | 35 | data(api) 36 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 37 | 38 | a<-svymean(~stype, dclus1) 39 | barplot(a) 40 | barplot(a, names.arg=c("Elementary","High","Middle"), col="purple", 41 | main="Proportions of school level") 42 | 43 | b<-svyby(~enroll+api.stu, ~stype, dclus1, svymean) 44 | barplot(b,beside=TRUE,legend=TRUE) 45 | dotchart(b) 46 | 47 | } 48 | % Add one or more standard keywords, see file 'KEYWORDS' in the 49 | % R documentation directory. 50 | \keyword{survey} 51 | \keyword{hplot}% __ONLY ONE__ keyword per line 52 | -------------------------------------------------------------------------------- /man/compressWeights.Rd: -------------------------------------------------------------------------------- 1 | \name{compressWeights} 2 | \alias{compressWeights} 3 | \alias{compressWeights.default} 4 | \alias{compressWeights.repweights_compressed} 5 | \alias{[.repweights_compressed} 6 | \alias{dim.repweights_compressed} 7 | \alias{dimnames.repweights_compressed} 8 | \alias{as.matrix.repweights_compressed} 9 | \alias{as.matrix.repweights} 10 | \alias{as.vector.repweights_compressed} 11 | \alias{compressWeights.svyrep.design} 12 | %- Also NEED an '\alias' for EACH other topic documented here. 13 | \title{Compress replicate weight matrix} 14 | \description{ 15 | Many replicate weight matrices have redundant rows, such as when 16 | weights are the same for all observations in a PSU. This function 17 | produces a compressed form. Methods for \code{as.matrix} and 18 | \code{as.vector} extract and expand the weights. 19 | } 20 | \usage{ 21 | compressWeights(rw, ...) 22 | \method{compressWeights}{svyrep.design}(rw,...) 23 | \method{as.matrix}{repweights_compressed}(x,...) 24 | \method{as.vector}{repweights_compressed}(x,...) 25 | } 26 | %- maybe also 'usage' for other objects documented here. 27 | \arguments{ 28 | \item{rw}{A set of replicate weights or a \code{svyrep.design} object} 29 | \item{x}{A compressed set of replicate weights} 30 | \item{\dots}{For future expansion} 31 | } 32 | 33 | \value{ 34 | An object of class \code{repweights_compressed} or a 35 | \code{svyrep.design} object with \code{repweights} element of class \code{repweights_compressed} 36 | } 37 | \seealso{\code{\link{jknweights}},\code{\link{as.svrepdesign}}} 38 | \examples{ 39 | data(api) 40 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 41 | rclus1c<-as.svrepdesign(dclus1,compress=TRUE) 42 | rclus1<-as.svrepdesign(dclus1,compress=FALSE) 43 | } 44 | \keyword{survey}% at least one, from doc/KEYWORDS 45 | \keyword{manip}% __ONLY ONE__ keyword per line 46 | -------------------------------------------------------------------------------- /man/confint.svyglm.Rd: -------------------------------------------------------------------------------- 1 | \name{confint.svyglm} 2 | \alias{confint.svyglm} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{Confidence intervals for regression parameters } 5 | \description{ 6 | Computes confidence intervals for regression parameters in 7 | \code{\link{svyglm}} objects. The default is a Wald-type confidence 8 | interval, adding and subtracting a multiple of the standard error. The 9 | \code{method="likelihood"} is an interval based on inverting the Rao-Scott 10 | likelihood ratio test. That is, it is an interval where the working 11 | model deviance is lower than the threshold for the Rao-Scott test at the 12 | specified level. 13 | } 14 | \usage{ 15 | \method{confint}{svyglm}(object, parm, level = 0.95, method = c("Wald", "likelihood"), ddf = NULL, ...) 16 | } 17 | %- maybe also 'usage' for other objects documented here. 18 | \arguments{ 19 | \item{object}{\code{svyglm} object} 20 | \item{parm}{numeric or character vector indicating which parameters to 21 | construct intervals for.} 22 | \item{level}{desired coverage} 23 | \item{method}{See description above } 24 | \item{ddf}{Denominator degrees of freedom for \code{"likelihood"} 25 | method, to use a t distribution rather than norma. If \code{NULL}, 26 | use \code{object$df.residual}} 27 | \item{\dots}{for future expansion} 28 | } 29 | 30 | \value{ 31 | A matrix of confidence intervals 32 | } 33 | \references{ 34 | J. N. K. Rao and Alistair J. Scott (1984) On Chi-squared Tests For 35 | Multiway Contigency Tables with Proportions Estimated From Survey 36 | Data. Annals of Statistics 12:46-60 37 | } 38 | 39 | \seealso{\code{\link{confint}} } 40 | \examples{ 41 | data(api) 42 | dclus2<-svydesign(id=~dnum+snum, fpc=~fpc1+fpc2, data=apiclus2) 43 | 44 | m<-svyglm(I(comp.imp=="Yes")~stype*emer+ell, design=dclus2, family=quasibinomial) 45 | confint(m) 46 | confint(m, method="like",ddf=NULL, parm=c("ell","emer")) 47 | 48 | } 49 | % Add one or more standard keywords, see file 'KEYWORDS' in the 50 | % R documentation directory. 51 | \keyword{survey} 52 | 53 | -------------------------------------------------------------------------------- /man/crowd.Rd: -------------------------------------------------------------------------------- 1 | \name{crowd} 2 | \alias{crowd} 3 | \docType{data} 4 | \title{Household crowding} 5 | \description{ 6 | A tiny dataset from the VPLX manual. 7 | } 8 | \usage{data(crowd)} 9 | \format{ 10 | A data frame with 6 observations on the following 5 variables. 11 | \describe{ 12 | \item{rooms}{Number of rooms in the house} 13 | \item{person}{Number of people in the household} 14 | \item{weight}{Sampling weight} 15 | \item{cluster}{Cluster number} 16 | \item{stratum}{Stratum number} 17 | } 18 | } 19 | \source{ 20 | Manual for VPLX, Census Bureau. 21 | } 22 | \examples{ 23 | data(crowd) 24 | 25 | ## Example 1-1 26 | i1.1<-as.svrepdesign(svydesign(id=~cluster, weight=~weight,data=crowd)) 27 | i1.1<-update(i1.1, room.ratio=rooms/person, 28 | overcrowded=factor(person>rooms)) 29 | svymean(~rooms+person+room.ratio,i1.1) 30 | svytotal(~rooms+person+room.ratio,i1.1) 31 | svymean(~rooms+person+room.ratio,subset(i1.1,overcrowded==TRUE)) 32 | svytotal(~rooms+person+room.ratio,subset(i1.1,overcrowded==TRUE)) 33 | 34 | ## Example 1-2 35 | i1.2<-as.svrepdesign(svydesign(id=~cluster,weight=~weight,strata=~stratum, data=crowd)) 36 | svymean(~rooms+person,i1.2) 37 | svytotal(~rooms+person,i1.2) 38 | 39 | } 40 | \keyword{datasets} 41 | -------------------------------------------------------------------------------- /man/dimnames.DBIsvydesign.Rd: -------------------------------------------------------------------------------- 1 | \name{dimnames.DBIsvydesign} 2 | \alias{dimnames.DBIsvydesign} 3 | \alias{dimnames.survey.design} 4 | \alias{dimnames.svyrep.design} 5 | \alias{dimnames.twophase} 6 | \alias{dimnames.svyimputationList} 7 | \alias{dim.DBIsvydesign} 8 | \alias{dim.survey.design} 9 | \alias{dim.twophase} 10 | \alias{dim.svyimputationList} 11 | \alias{dim.svyrep.design} 12 | 13 | %- Also NEED an '\alias' for EACH other topic documented here. 14 | \title{Dimensions of survey designs} 15 | \description{ 16 | \code{dimnames} returns variable names and row names for the data 17 | variables in a design object and \code{dim} returns dimensions. 18 | For multiple imputation designs there is a third dimension giving the 19 | number of imputations. For database-backed designs the second dimension 20 | includes variables defined by \code{update}. The first dimension 21 | excludes observations with zero weight. 22 | } 23 | \usage{ 24 | \method{dim}{survey.design}(x) 25 | \method{dim}{svyimputationList}(x) 26 | \method{dimnames}{survey.design}(x) 27 | \method{dimnames}{DBIsvydesign}(x) 28 | \method{dimnames}{svyimputationList}(x) 29 | } 30 | %- maybe also 'usage' for other objects documented here. 31 | \arguments{ 32 | \item{x}{Design object} 33 | 34 | } 35 | 36 | \value{ 37 | A vector of numbers for \code{dim}, a list of vectors of strings for \code{dimnames}. 38 | } 39 | 40 | \seealso{ \code{\link{update.DBIsvydesign}}, \code{\link{with.svyimputationList}}} 41 | \examples{ 42 | data(api) 43 | dclus1 <- svydesign(ids=~dnum,weights=~pw,data=apiclus1,fpc=~fpc) 44 | dim(dclus1) 45 | dimnames(dclus1) 46 | colnames(dclus1) 47 | } 48 | % Add one or more standard keywords, see file 'KEYWORDS' in the 49 | % R documentation directory. 50 | \keyword{survey} 51 | \keyword{manip}% __ONLY ONE__ keyword per line 52 | -------------------------------------------------------------------------------- /man/fpc.Rd: -------------------------------------------------------------------------------- 1 | \name{fpc} 2 | \alias{fpc} 3 | \non_function{} 4 | \title{Small survey example} 5 | \usage{data(fpc)} 6 | \description{ 7 | The \code{fpc} data frame has 8 rows and 6 columns. It is artificial 8 | data to illustrate survey sampling estimators. 9 | } 10 | \format{ 11 | This data frame contains the following columns: 12 | \describe{ 13 | \item{stratid}{Stratum ids} 14 | \item{psuid}{Sampling unit ids} 15 | \item{weight}{Sampling weights} 16 | \item{nh}{number sampled per stratum} 17 | \item{Nh}{population size per stratum} 18 | \item{x}{data} 19 | } 20 | } 21 | 22 | \source{ 23 | \verb{https://www.stata-press.com/data/r7/fpc.dta} 24 | } 25 | 26 | \examples{ 27 | data(fpc) 28 | fpc 29 | 30 | 31 | withoutfpc<-svydesign(weights=~weight, ids=~psuid, strata=~stratid, variables=~x, 32 | data=fpc, nest=TRUE) 33 | 34 | withoutfpc 35 | svymean(~x, withoutfpc) 36 | 37 | withfpc<-svydesign(weights=~weight, ids=~psuid, strata=~stratid, 38 | fpc=~Nh, variables=~x, data=fpc, nest=TRUE) 39 | 40 | withfpc 41 | svymean(~x, withfpc) 42 | 43 | ## Other equivalent forms 44 | withfpc<-svydesign(prob=~I(1/weight), ids=~psuid, strata=~stratid, 45 | fpc=~Nh, variables=~x, data=fpc, nest=TRUE) 46 | 47 | svymean(~x, withfpc) 48 | 49 | withfpc<-svydesign(weights=~weight, ids=~psuid, strata=~stratid, 50 | fpc=~I(nh/Nh), variables=~x, data=fpc, nest=TRUE) 51 | 52 | svymean(~x, withfpc) 53 | 54 | withfpc<-svydesign(weights=~weight, ids=~interaction(stratid,psuid), 55 | strata=~stratid, fpc=~I(nh/Nh), variables=~x, data=fpc) 56 | 57 | svymean(~x, withfpc) 58 | 59 | withfpc<-svydesign(ids=~psuid, strata=~stratid, fpc=~Nh, 60 | variables=~x,data=fpc,nest=TRUE) 61 | 62 | svymean(~x, withfpc) 63 | 64 | withfpc<-svydesign(ids=~psuid, strata=~stratid, 65 | fpc=~I(nh/Nh), variables=~x, data=fpc, nest=TRUE) 66 | 67 | svymean(~x, withfpc) 68 | 69 | 70 | 71 | } 72 | \keyword{datasets} 73 | -------------------------------------------------------------------------------- /man/ftable.svystat.Rd: -------------------------------------------------------------------------------- 1 | \name{ftable.svystat} 2 | \alias{ftable.svystat} 3 | \alias{ftable.svrepstat} 4 | \alias{ftable.svyby} 5 | %- Also NEED an '\alias' for EACH other topic documented here. 6 | \title{Lay out tables of survey statistics} 7 | \description{ 8 | Reformat the output of survey computations to a table. 9 | } 10 | \usage{ 11 | \method{ftable}{svystat}(x, rownames,...) 12 | \method{ftable}{svrepstat}(x, rownames,...) 13 | \method{ftable}{svyby}(x,...) 14 | } 15 | %- maybe also 'usage' for other objects documented here. 16 | \arguments{ 17 | \item{x}{Output of functions such as \code{svymean},\code{svrepmean}, \code{svyby}} 18 | \item{rownames}{List of vectors of strings giving dimension names for 19 | the resulting table (see examples)} 20 | \item{...}{Arguments for future expansion} 21 | } 22 | \value{ 23 | An object of class \code{"ftable"} 24 | } 25 | 26 | \seealso{ \code{\link{ftable}}} 27 | \examples{ 28 | data(api) 29 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 30 | 31 | a<-svymean(~interaction(stype,comp.imp), design=dclus1) 32 | b<-ftable(a, rownames=list(stype=c("E","H","M"),comp.imp=c("No","Yes"))) 33 | b 34 | 35 | a<-svymean(~interaction(stype,comp.imp), design=dclus1, deff=TRUE) 36 | b<-ftable(a, rownames=list(stype=c("E","H","M"),comp.imp=c("No","Yes"))) 37 | round(100*b,1) 38 | 39 | rclus1<-as.svrepdesign(dclus1) 40 | a<-svytotal(~interaction(stype,comp.imp), design=rclus1) 41 | b<-ftable(a, rownames=list(stype=c("E","H","M"),comp.imp=c("No","Yes"))) 42 | b 43 | round(b) 44 | 45 | a<-svyby(~api99 + api00, ~stype + sch.wide, rclus1, svymean, keep.var=TRUE) 46 | ftable(a) 47 | print(ftable(a),digits=2) 48 | 49 | b<-svyby(~api99 + api00, ~stype + sch.wide, rclus1, svymean, keep.var=TRUE, deff=TRUE) 50 | print(ftable(b),digits=2) 51 | 52 | d<-svyby(~api99 + api00, ~stype + sch.wide, rclus1, svymean, keep.var=TRUE, vartype=c("se","cvpct")) 53 | round(ftable(d),1) 54 | 55 | } 56 | \keyword{survey}% at least one, from doc/KEYWORDS 57 | \keyword{manip}% __ONLY ONE__ keyword per line 58 | -------------------------------------------------------------------------------- /man/hadamard.Rd: -------------------------------------------------------------------------------- 1 | \name{hadamard} 2 | \alias{hadamard} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{Hadamard matrices } 5 | \description{ 6 | Returns a Hadamard matrix of dimension larger than the argument. 7 | } 8 | \usage{ 9 | hadamard(n) 10 | } 11 | %- maybe also 'usage' for other objects documented here. 12 | \arguments{ 13 | \item{n}{lower bound for size } 14 | } 15 | 16 | \value{ 17 | A Hadamard matrix 18 | } 19 | \details{ 20 | For most \code{n} the matrix comes from \code{\link{paley}}. The 21 | \eqn{36\times 36}{36x36} matrix is from Plackett and Burman (1946) 22 | and the \eqn{28\times 28}{28x28} is from Sloane's library of Hadamard 23 | matrices. 24 | 25 | Matrices of dimension every multiple of 4 are thought to exist, but 26 | this function doesn't know about all of them, so it will sometimes 27 | return matrices that are larger than necessary. The excess is at most 28 | 4 for \eqn{n<180}{n<180} and at most 5\% for \eqn{n>100}{n>100}. 29 | 30 | } 31 | \note{Strictly speaking, a Hadamard matrix has entries +1 and -1 rather 32 | than 1 and 0, so \code{2*hadamard(n)-1} is a Hadamard matrix} 33 | \references{ 34 | Sloane NJA. A Library of Hadamard Matrices \url{http://neilsloane.com/hadamard/} 35 | 36 | 37 | Plackett RL, Burman JP. (1946) The Design of Optimum Multifactorial Experiments 38 | Biometrika, Vol. 33, No. 4 pp. 305-325 39 | 40 | Cameron PJ (2005) Hadamard Matrices 41 | \url{http://designtheory.org/library/encyc/topics/had.pdf}. In: The 42 | Encyclopedia of Design Theory \url{http://designtheory.org/library/encyc/} 43 | } 44 | \seealso{\code{\link{brrweights}}, \code{\link{paley}}} 45 | \examples{ 46 | 47 | par(mfrow=c(2,2)) 48 | ## Sylvester-type 49 | image(hadamard(63),main=quote("Sylvester: "*64==2^6)) 50 | ## Paley-type 51 | image(hadamard(59),main=quote("Paley: "*60==59+1)) 52 | ## from NJ Sloane's library 53 | image(hadamard(27),main=quote("Stored: "*28)) 54 | ## For n=90 we get 96 rather than the minimum possible size, 92. 55 | image(hadamard(90),main=quote("Constructed: "*96==2^3\%*\%(11+1))) 56 | 57 | par(mfrow=c(1,1)) 58 | plot(2:150,sapply(2:150,function(i) ncol(hadamard(i))),type="S", 59 | ylab="Matrix size",xlab="n",xlim=c(1,150),ylim=c(1,150)) 60 | abline(0,1,lty=3) 61 | lines(2:150, 2:150-(2:150 \%\% 4)+4,col="purple",type="S",lty=2) 62 | legend(c(x=10,y=140),legend=c("Actual size","Minimum possible size"), 63 | col=c("black","purple"),bty="n",lty=c(1,2)) 64 | 65 | } 66 | \keyword{survey} 67 | 68 | -------------------------------------------------------------------------------- /man/hospital.Rd: -------------------------------------------------------------------------------- 1 | \name{hospital} 2 | \alias{hospital} 3 | \non_function{} 4 | \title{Sample of obstetric hospitals } 5 | \usage{data(hospital)} 6 | \description{ 7 | The \code{hospital} data frame has 15 rows and 5 columns. 8 | } 9 | \format{ 10 | This data frame contains the following columns: 11 | \describe{ 12 | \item{hospno}{Hospital id} 13 | \item{oblevel}{level of obstetric care} 14 | \item{weighta}{Weights, as given by the original reference} 15 | \item{tothosp}{total hospitalisations} 16 | \item{births}{births} 17 | \item{weightats}{Weights, as given in the source} 18 | } 19 | } 20 | \source{ 21 | Previously at \verb{http://www.ats.ucla.edu/stat/books/sop/hospsamp.dta} 22 | } 23 | \references{ 24 | Levy and Lemeshow. "Sampling of Populations" (3rd edition). Wiley. 25 | } 26 | \examples{ 27 | data(hospital) 28 | hospdes<-svydesign(strata=~oblevel, id=~hospno, weights=~weighta, 29 | fpc=~tothosp, data=hospital) 30 | hosprep<-as.svrepdesign(hospdes) 31 | 32 | svytotal(~births, design=hospdes) 33 | svytotal(~births, design=hosprep) 34 | 35 | } 36 | \keyword{datasets} 37 | -------------------------------------------------------------------------------- /man/make.calfun.Rd: -------------------------------------------------------------------------------- 1 | \name{make.calfun} 2 | \alias{make.calfun} 3 | \alias{cal.linear} 4 | \alias{cal.raking} 5 | \alias{cal.logit} 6 | \alias{cal.sinh} 7 | %- Also NEED an '\alias' for EACH other topic documented here. 8 | \title{Calibration metrics} 9 | \description{ 10 | Create calibration metric for use in \code{\link{calibrate}}. The 11 | function \code{F} is the link function described in section 2 of 12 | Deville et al. To create a new calibration metric, specify \eqn{F-1}{F-1} and its 13 | derivative. The package provides \code{cal.linear}, \code{cal.raking}, 14 | \code{cal.logit}, which are standard, and \code{cal.sinh} from the 15 | \code{CALMAR2} macro, for which \code{F} is the derivative of the inverse hyperbolic 16 | sine. 17 | } 18 | \usage{ 19 | make.calfun(Fm1, dF, name) 20 | } 21 | %- maybe also 'usage' for other objects documented here. 22 | \arguments{ 23 | \item{Fm1}{Function \eqn{F-1}{F-1} taking a vector \code{u} and a 24 | vector of length 2, \code{bounds}.} 25 | \item{dF}{Derivative of \code{Fm1} wrt \code{u}: arguments \code{u} 26 | and \code{bounds} } 27 | \item{name}{Character string to use as name } 28 | } 29 | \value{ 30 | An object of class \code{"calfun"} 31 | } 32 | 33 | \references{ 34 | Deville J-C, Sarndal C-E, Sautory O (1993) Generalized Raking 35 | Procedures in Survey Sampling. JASA 88:1013-1020 36 | 37 | Deville J-C, Sarndal C-E (1992) Calibration Estimators in Survey 38 | Sampling. JASA 87: 376-382 39 | } 40 | 41 | \seealso{\code{\link{calibrate}} } 42 | \examples{ 43 | str(cal.linear) 44 | cal.linear$Fm1 45 | cal.linear$dF 46 | 47 | hellinger <- make.calfun(Fm1=function(u, bounds) ((1-u/2)^-2)-1, 48 | dF= function(u, bounds) (1-u/2)^-3 , 49 | name="hellinger distance") 50 | 51 | hellinger 52 | 53 | data(api) 54 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 55 | 56 | svymean(~api00,calibrate(dclus1, ~api99, pop=c(6194, 3914069), 57 | calfun=hellinger)) 58 | 59 | svymean(~api00,calibrate(dclus1, ~api99, pop=c(6194, 3914069), 60 | calfun=cal.linear)) 61 | 62 | svymean(~api00,calibrate(dclus1, ~api99, pop=c(6194,3914069), 63 | calfun=cal.raking)) 64 | } 65 | % Add one or more standard keywords, see file 'KEYWORDS' in the 66 | % R documentation directory. 67 | \keyword{survey} 68 | 69 | -------------------------------------------------------------------------------- /man/mu284.Rd: -------------------------------------------------------------------------------- 1 | \name{mu284} 2 | \alias{mu284} 3 | \docType{data} 4 | \title{Two-stage sample from MU284} 5 | \description{ 6 | The MU284 population comes from Sarndal et al, and the complete data are 7 | available from Statlib. These data are a two-stage sample from the 8 | population, analyzed on page 143 of the book. 9 | } 10 | \usage{data(mu284)} 11 | \format{ 12 | A data frame with 15 observations on the following 5 variables. 13 | \describe{ 14 | \item{\code{id1}}{identifier for PSU} 15 | \item{\code{n1}}{number of PSUs in population} 16 | \item{\code{id2}}{identifier for second-stage unit} 17 | \item{\code{y1}}{variable to be analysed} 18 | \item{\code{n2}}{number of second-stage units in this PSU} 19 | } 20 | } 21 | \source{ 22 | Carl Erik Sarndal, Bengt Swensson, Jan Wretman. (1991) "Model Assisted 23 | Survey Sampling" Springer. 24 | 25 | (downloaded from StatLib, which is no longer active) 26 | } 27 | \examples{ 28 | data(mu284) 29 | (dmu284<-svydesign(id=~id1+id2,fpc=~n1+n2, data=mu284)) 30 | (ytotal<-svytotal(~y1, dmu284)) 31 | vcov(ytotal) 32 | } 33 | \keyword{datasets} 34 | -------------------------------------------------------------------------------- /man/myco.Rd: -------------------------------------------------------------------------------- 1 | \name{myco} 2 | \alias{myco} 3 | \docType{data} 4 | \title{ 5 | Association between leprosy and BCG vaccination 6 | } 7 | \description{ 8 | These data are in a paper by JNK Rao and colleagues, on score tests 9 | for complex survey data. External information (not further specified) suggests 10 | the functional form for the \code{Age} variable. 11 | } 12 | \usage{data("myco")} 13 | \format{ 14 | A data frame with 516 observations on the following 6 variables. 15 | \describe{ 16 | \item{\code{Age}}{Age in years at the midpoint of six age strata} 17 | \item{\code{Scar}}{Presence of a BCG vaccination scar} 18 | \item{\code{n}}{Sampled number of cases (and thus controls) in the age stratum} 19 | \item{\code{Ncontrol}}{Number of non-cases in the population} 20 | \item{\code{wt}}{Sampling weight} 21 | \item{\code{leprosy}}{case status 0/1} 22 | } 23 | } 24 | \details{ 25 | The data are a simulated stratified case-control study drawn from a 26 | population study conducted in a region of Malawi (Clayton and Hills, 27 | 1993, Table 18.1). The goal was to examine whether BCG vaccination against 28 | tuberculosis protects against leprosy (the causative agents are both species of 29 | _Mycobacterium_). Rao et al have a typographical error: the number of 30 | non-cases in the population in the 25-30 age stratum is given as 4981 31 | but 5981 matches both the computational output and the data as given by Clayton 32 | and Hills. 33 | } 34 | 35 | \source{ 36 | JNK Rao, AJ Scott, and Skinner, C. (1998). QUASI-SCORE TESTS WITH SURVEY 37 | DATA. Statistica Sinica, 8(4), 1059-1070. 38 | 39 | Clayton, D., & Hills, M. (1993). Statistical Models in Epidemiology. OUP 40 | } 41 | 42 | \examples{ 43 | data(myco) 44 | dmyco<-svydesign(id=~1, strata=~interaction(Age,leprosy),weights=~wt,data=myco) 45 | 46 | m_full<-svyglm(leprosy~I((Age+7.5)^-2)+Scar, family=quasibinomial, design=dmyco) 47 | m_age<-svyglm(leprosy~I((Age+7.5)^-2), family=quasibinomial, design=dmyco) 48 | anova(m_full,m_age) 49 | 50 | ## unweighted model does not match 51 | m_full 52 | glm(leprosy~I((Age+7.5)^-2)+Scar, family=binomial, data=myco) 53 | 54 | } 55 | \keyword{datasets} 56 | -------------------------------------------------------------------------------- /man/nhanes.Rd: -------------------------------------------------------------------------------- 1 | \name{nhanes} 2 | \alias{nhanes} 3 | \docType{data} 4 | \title{ 5 | Cholesterol data from a US survey 6 | } 7 | \description{ 8 | Data extracted from NHANES 2009-2010 on high cholesterol. 9 | } 10 | \usage{data(nhanes)} 11 | \format{ 12 | A data frame with 8591 observations on the following 7 variables. 13 | \describe{ 14 | \item{\code{SDMVPSU}}{Primary sampling units} 15 | \item{\code{SDMVSTRA}}{Sampling strata} 16 | \item{\code{WTMEC2YR}}{Sampling weights} 17 | \item{\code{HI_CHOL}}{Numeric vector: 1 for total cholesterol over 18 | 240mg/dl, 0 under 240mg/dl} 19 | \item{\code{race}}{1=Hispanic, 2=non-Hispanic white, 3=non-Hispanic 20 | black, 4=other} 21 | \item{\code{agecat}}{Age group \code{(0,19]} \code{(19,39]} \code{(39,59]} \code{(59,Inf]}} 22 | \item{\code{RIAGENDR}}{Gender: 1=male, 2=female} 23 | } 24 | } 25 | \source{ 26 | Previously at \verb{https://wwwn.cdc.gov/nchs/nhanes/search/datapage.aspx?Component=laboratory&CycleBeginYear=2009} 27 | } 28 | \examples{ 29 | data(nhanes) 30 | design <- svydesign(id=~SDMVPSU, strata=~SDMVSTRA, weights=~WTMEC2YR, nest=TRUE,data=nhanes) 31 | design 32 | } 33 | \keyword{datasets} 34 | -------------------------------------------------------------------------------- /man/open.DBIsvydesign.Rd: -------------------------------------------------------------------------------- 1 | \name{open.DBIsvydesign} 2 | \alias{open.DBIsvydesign} 3 | \alias{close.DBIsvydesign} 4 | %- Also NEED an '\alias' for EACH other topic documented here. 5 | \title{Open and close DBI connections } 6 | \description{ 7 | A database-backed survey design object contains a connection to a 8 | database. This connection will be broken if the object is saved and 9 | reloaded, and the connection should ideally be closed with \code{close} 10 | before quitting R (although it doesn't matter for SQLite 11 | connections). The connection can be reopened with \code{open}. 12 | } 13 | \usage{ 14 | \method{open}{DBIsvydesign}(con, ...) 15 | \method{close}{DBIsvydesign}(con, ...) 16 | } 17 | %- maybe also 'usage' for other objects documented here. 18 | \arguments{ 19 | \item{con}{Object of class \code{DBIsvydesign} } 20 | \item{\dots}{Other options, to be passed to \code{dbConnect} or 21 | \code{dbDisconnect}.} 22 | } 23 | \value{ 24 | The same survey design object with the connection opened or closed. 25 | } 26 | 27 | \seealso{\code{\link{svydesign}} 28 | 29 | DBI package } 30 | \examples{ 31 | \dontrun{ 32 | library(RSQLite) 33 | dbclus1<-svydesign(id=~dnum, weights=~pw, fpc=~fpc, 34 | data="apiclus1",dbtype="SQLite", 35 | dbname=system.file("api.db",package="survey")) 36 | 37 | dbclus1 38 | close(dbclus1) 39 | dbclus1 40 | try(svymean(~api00, dbclus1)) 41 | 42 | dbclus1<-open(dbclus1) 43 | open(dbclus1) 44 | svymean(~api00, dbclus1) 45 | } 46 | } 47 | % Add one or more standard keywords, see file 'KEYWORDS' in the 48 | % R documentation directory. 49 | \keyword{survey} 50 | 51 | -------------------------------------------------------------------------------- /man/paley.Rd: -------------------------------------------------------------------------------- 1 | \name{paley} 2 | \alias{paley} 3 | \alias{is.hadamard} 4 | %- Also NEED an '\alias' for EACH other topic documented here. 5 | \title{Paley-type Hadamard matrices} 6 | \description{ 7 | Computes a Hadamard matrix of dimension \eqn{(p+1)\times 2^k}{(p+1)*2^k}, where p is a prime, 8 | and p+1 is a multiple of 4, using the Paley construction. Used by \code{\link{hadamard}}. 9 | } 10 | \usage{ 11 | paley(n, nmax = 2 * n, prime=NULL, check=!is.null(prime)) 12 | 13 | is.hadamard(H, style=c("0/1","+-"), full.orthogonal.balance=TRUE) 14 | } 15 | %- maybe also 'usage' for other objects documented here. 16 | \arguments{ 17 | \item{n}{Minimum size for matrix} 18 | \item{nmax}{Maximum size for matrix. Ignored if \code{prime} is specified.} 19 | \item{prime}{Optional. A prime at least as large as 20 | \code{n}, such that \code{prime+1} is divisible by 4.} 21 | \item{check}{Check that the resulting matrix is of Hadamard type} 22 | \item{H}{Matrix} 23 | \item{style}{\code{"0/1"} for a matrix of 0s and 1s, \code{"+-"} for a 24 | matrix of \eqn{\pm 1}{+/-1}.} 25 | \item{full.orthogonal.balance}{Require full orthogonal balance?} 26 | } 27 | 28 | \value{ 29 | For \code{paley}, a matrix of zeros and ones, or \code{NULL} if no matrix smaller than 30 | \code{nmax} can be found. 31 | 32 | For \code{is.hadamard}, \code{TRUE} if \code{H} is a Hadamard matrix. 33 | } 34 | \details{ 35 | The Paley construction gives a Hadamard matrix of order p+1 if p is 36 | prime and p+1 is a multiple of 4. This is then expanded to order 37 | \eqn{(p+1)\times 2^k}{(p+1)*2^k} using the Sylvester construction. 38 | 39 | \code{paley} knows primes up to 7919. The user can specify a prime 40 | with the \code{prime} argument, in which case a matrix of order 41 | \eqn{p+1}{p+1} is constructed. 42 | 43 | If \code{check=TRUE} the code uses \code{is.hadamard} to check that 44 | the resulting matrix really is of Hadamard type, in the same way as in 45 | the example below. As this test takes \eqn{n^3}{n^3} time it is 46 | preferable to just be sure that \code{prime} really is prime. 47 | 48 | A Hadamard matrix including a row of 1s gives BRR designs where the 49 | average of the replicates for a linear statistic is exactly the full 50 | sample estimate. This property is called full orthogonal balance. 51 | } 52 | \references{ 53 | Cameron PJ (2005) Hadamard Matrices. In: The 54 | Encyclopedia of Design Theory 55 | } 56 | \seealso{ \code{\link{hadamard}}} 57 | \examples{ 58 | 59 | M<-paley(11) 60 | 61 | is.hadamard(M) 62 | ## internals of is.hadamard(M) 63 | H<-2*M-1 64 | ## HH^T is diagonal for any Hadamard matrix 65 | H\%*\%t(H) 66 | 67 | } 68 | \keyword{survey}% at least one, from doc/KEYWORDS 69 | \keyword{algebra} 70 | 71 | -------------------------------------------------------------------------------- /man/poisson_sampling.Rd: -------------------------------------------------------------------------------- 1 | \name{poisson_sampling} 2 | \alias{poisson_sampling} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Specify Poisson sampling design 6 | } 7 | \description{ 8 | Specify a design where units are sampled independently from the population, with known probabilities. This design is often used theoretically, but is rarely used in practice because the sample size is variable. This function calls \code{\link{ppscov}} to specify a sparse sampling covariance matrix. 9 | } 10 | \usage{ 11 | poisson_sampling(p) 12 | } 13 | %- maybe also 'usage' for other objects documented here. 14 | \arguments{ 15 | \item{p}{ 16 | Vector of sampling probabilities 17 | } 18 | } 19 | 20 | \value{ 21 | Object of class \code{ppsdcheck} 22 | } 23 | 24 | \seealso{ 25 | \code{\link{ppscov}}, \code{\link{svydesign}} 26 | } 27 | \examples{ 28 | data(api) 29 | apipop$prob<-with(apipop, 200*api00/sum(api00)) 30 | insample<-as.logical(rbinom(nrow(apipop),1,apipop$prob)) 31 | apipois<-apipop[insample,] 32 | despois<-svydesign(id=~1, prob=~prob, pps=poisson_sampling(apipois$prob), data=apipois) 33 | 34 | svytotal(~api00, despois) 35 | 36 | ## SE formula 37 | sqrt(sum( (apipois$api00*weights(despois))^2*(1-apipois$prob))) 38 | } 39 | % Add one or more standard keywords, see file 'KEYWORDS' in the 40 | % R documentation directory (show via RShowDoc("KEYWORDS")): 41 | % \keyword{survey } 42 | -------------------------------------------------------------------------------- /man/psrsq.Rd: -------------------------------------------------------------------------------- 1 | \name{psrsq} 2 | \alias{psrsq} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Pseudo-Rsquareds 6 | } 7 | \description{ 8 | Compute the Nagelkerke and Cox--Snell pseudo-rsquared statistics, primarily for logistic regression. A generic function with methods for \code{glm} and \code{\link{svyglm}}. The method for \code{svyglm} objects uses the design-based estimators described by Lumley (2017) 9 | } 10 | \usage{ 11 | psrsq(object, method = c("Cox-Snell", "Nagelkerke"), ...) 12 | } 13 | %- maybe also 'usage' for other objects documented here. 14 | \arguments{ 15 | \item{object}{ 16 | A regression model (\code{glm} or \code{svyglm}) 17 | } 18 | \item{method}{ 19 | Which statistic to compute 20 | } 21 | \item{\dots}{ 22 | For future expansion 23 | } 24 | } 25 | 26 | \value{ 27 | Numeric value 28 | } 29 | \references{ 30 | Lumley T (2017) "Pseudo-R2 statistics under complex sampling" Australian and New Zealand Journal of Statistics DOI: 10.1111/anzs.12187 (preprint: \url{https://arxiv.org/abs/1701.07745}) 31 | } 32 | 33 | \seealso{ 34 | \code{\link{AIC.svyglm}} 35 | } 36 | \examples{ 37 | data(api) 38 | dclus2<-svydesign(id=~dnum+snum, weights=~pw, data=apiclus2) 39 | 40 | model1<-svyglm(I(sch.wide=="Yes")~ell+meals+mobility+as.numeric(stype), 41 | design=dclus2, family=quasibinomial()) 42 | 43 | psrsq(model1, type="Nagelkerke") 44 | 45 | } 46 | % Add one or more standard keywords, see file 'KEYWORDS' in the 47 | % R documentation directory. 48 | \keyword{survey }% use one of RShowDoc("KEYWORDS") 49 | \keyword{regression }% __ONLY ONE__ keyword per line 50 | -------------------------------------------------------------------------------- /man/salamander.Rd: -------------------------------------------------------------------------------- 1 | \name{salamander} 2 | \docType{data} 3 | \alias{salamander} 4 | \concept{generalized linear mixed model} 5 | \title{Salamander mating data set from McCullagh and Nelder (1989)} 6 | \description{This data set presents the outcome of three experiments 7 | conducted at the University of Chicago in 1986 to study interbreeding 8 | between populations of mountain dusky salamanders (McCullagh and 9 | Nelder, 1989, Section 14.5). The analysis here is from Lumley (1998, 10 | section 5.3)} 11 | 12 | \usage{data(salamander)} 13 | \format{ 14 | A data frame with the following columns: 15 | 16 | \describe{ 17 | \item{Mate}{Whether the salamanders mated (1) or did not mate (0).} 18 | \item{Cross}{Cross between female and male type. A factor with four levels: \code{R/R},\code{R/W},\code{W/R}, and \code{W/W}. The type of the female salamander is listed first and the male is listed second. Rough Butt is represented by R and White Side is represented by W. For example, \code{Cross=W/R} indicates a White Side female was crossed with a Rough Butt male.} 19 | \item{Male}{Identification number of the male salamander. A factor.} 20 | \item{Female}{Identification number of the female salamander. A factor.} 21 | 22 | } 23 | } 24 | 25 | 26 | \references{McCullagh P. and Nelder, J. A. (1989) \emph{Generalized 27 | Linear Models}. Chapman and Hall/CRC. 28 | Lumley T (1998) PhD thesis, University of Washington 29 | 30 | } 31 | 32 | 33 | \examples{ 34 | data(salamander) 35 | salamander$mixed<-with(salamander, Cross=="W/R" | Cross=="R/W") 36 | salamander$RWvsWR<-with(salamander, ifelse(mixed, 37 | ((Cross=="R/W")-(Cross=="W/R"))/2, 38 | 0)) 39 | xsalamander<-xdesign(id=list(~Male, ~Female), data=salamander, 40 | overlap="unbiased") 41 | 42 | ## Adjacency matrix 43 | ## Blocks 1 and 2 are actually the same salamanders, but 44 | ## it's traditional to pretend they are independent. 45 | image(xsalamander$adjacency) 46 | 47 | ## R doesn't allow family=binomial(identity) 48 | success <- svyglm(Mate~mixed+RWvsWR, design=xsalamander, 49 | family=quasi(link="identity", variance="mu(1-mu)")) 50 | summary(success) 51 | } 52 | \keyword{datasets} 53 | 54 | -------------------------------------------------------------------------------- /man/scd.Rd: -------------------------------------------------------------------------------- 1 | \name{scd} 2 | \alias{scd} 3 | \non_function{} 4 | \title{Survival in cardiac arrest} 5 | \usage{data(scd)} 6 | \description{ 7 | These data are from Section 12.2 of Levy and Lemeshow. They describe 8 | (a possibly apocryphal) study of survival in out-of-hospital cardiac 9 | arrest. Two out of five ambulance stations were sampled from each of 10 | three emergency service areas. 11 | } 12 | \format{ 13 | This data frame contains the following columns: 14 | \describe{ 15 | \item{ESA}{Emergency Service Area (strata)} 16 | \item{ambulance}{Ambulance station (PSU)} 17 | \item{arrests}{estimated number of cardiac arrests} 18 | \item{alive}{number reaching hospital alive} 19 | } 20 | } 21 | 22 | \source{ 23 | Levy and Lemeshow. "Sampling of Populations" (3rd edition). Wiley. 24 | } 25 | \examples{ 26 | data(scd) 27 | 28 | ## survey design objects 29 | scddes<-svydesign(data=scd, prob=~1, id=~ambulance, strata=~ESA, 30 | nest=TRUE, fpc=rep(5,6)) 31 | scdnofpc<-svydesign(data=scd, prob=~1, id=~ambulance, strata=~ESA, 32 | nest=TRUE) 33 | 34 | # convert to BRR replicate weights 35 | scd2brr <- as.svrepdesign(scdnofpc, type="BRR") 36 | # or to Rao-Wu bootstrap 37 | scd2boot <- as.svrepdesign(scdnofpc, type="subboot") 38 | 39 | # use BRR replicate weights from Levy and Lemeshow 40 | repweights<-2*cbind(c(1,0,1,0,1,0), c(1,0,0,1,0,1), c(0,1,1,0,0,1), 41 | c(0,1,0,1,1,0)) 42 | scdrep<-svrepdesign(data=scd, type="BRR", repweights=repweights) 43 | 44 | # ratio estimates 45 | svyratio(~alive, ~arrests, design=scddes) 46 | svyratio(~alive, ~arrests, design=scdnofpc) 47 | svyratio(~alive, ~arrests, design=scd2brr) 48 | svyratio(~alive, ~arrests, design=scd2boot) 49 | svyratio(~alive, ~arrests, design=scdrep) 50 | 51 | # or a logistic regression 52 | summary(svyglm(cbind(alive,arrests-alive)~1, family=quasibinomial, design=scdnofpc)) 53 | summary(svyglm(cbind(alive,arrests-alive)~1, family=quasibinomial, design=scdrep)) 54 | 55 | # Because no sampling weights are given, can't compute design effects 56 | # without replacement: use deff="replace" 57 | 58 | svymean(~alive+arrests, scddes, deff=TRUE) 59 | svymean(~alive+arrests, scddes, deff="replace") 60 | 61 | } 62 | \keyword{datasets} 63 | -------------------------------------------------------------------------------- /man/stratsample.Rd: -------------------------------------------------------------------------------- 1 | \name{stratsample} 2 | \Rdversion{1.1} 3 | \alias{stratsample} 4 | %- Also NEED an '\alias' for EACH other topic documented here. 5 | \title{ 6 | Take a stratified sample 7 | } 8 | \description{ 9 | This function takes a stratified sample without replacement from a data set. 10 | } 11 | \usage{ 12 | stratsample(strata, counts) 13 | } 14 | %- maybe also 'usage' for other objects documented here. 15 | \arguments{ 16 | \item{strata}{ 17 | Vector of stratum identifiers; will be coerced to character 18 | } 19 | \item{counts}{ 20 | named vector of stratum sample sizes, with names corresponding to the values of \code{as.character(strata)} 21 | } 22 | } 23 | 24 | \value{ 25 | vector of indices into \code{strata} giving the sample 26 | } 27 | 28 | 29 | \seealso{ 30 | \code{\link{sample}} 31 | 32 | The "sampling" package has many more sampling algorithms. 33 | } 34 | \examples{ 35 | data(api) 36 | s<-stratsample(apipop$stype, c("E"=5,"H"=4,"M"=2)) 37 | table(apipop$stype[s]) 38 | } 39 | % Add one or more standard keywords, see file 'KEYWORDS' in the 40 | % R documentation directory. 41 | \keyword{survey} 42 | 43 | -------------------------------------------------------------------------------- /man/subset.survey.design.Rd: -------------------------------------------------------------------------------- 1 | \name{subset.survey.design} 2 | \alias{subset.survey.design} 3 | \alias{subset.svyrep.design} 4 | \alias{[.survey.design} 5 | %- Also NEED an `\alias' for EACH other topic documented here. 6 | \title{Subset of survey} 7 | \description{ 8 | Restrict a survey design to a subpopulation, keeping the original design 9 | information about number of clusters, strata. If the design has no 10 | post-stratification or calibration data the subset will use 11 | proportionately less memory. 12 | } 13 | \usage{ 14 | \method{subset}{survey.design}(x, subset, ...) 15 | \method{subset}{svyrep.design}(x, subset, ...) 16 | } 17 | %- maybe also `usage' for other objects documented here. 18 | \arguments{ 19 | \item{x}{A survey design object} 20 | \item{subset}{An expression specifying the subpopulation} 21 | \item{\dots}{Arguments not used by this method} 22 | } 23 | \value{ 24 | A new survey design object 25 | } 26 | 27 | \seealso{\code{\link{svydesign}}} 28 | 29 | \examples{ 30 | data(fpc) 31 | dfpc<-svydesign(id=~psuid,strat=~stratid,weight=~weight,data=fpc,nest=TRUE) 32 | dsub<-subset(dfpc,x>4) 33 | summary(dsub) 34 | svymean(~x,design=dsub) 35 | 36 | ## These should give the same domain estimates and standard errors 37 | svyby(~x,~I(x>4),design=dfpc, svymean) 38 | summary(svyglm(x~I(x>4)+0,design=dfpc)) 39 | 40 | data(api) 41 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 42 | rclus1<-as.svrepdesign(dclus1) 43 | svymean(~enroll, subset(dclus1, sch.wide=="Yes" & comp.imp=="Yes")) 44 | svymean(~enroll, subset(rclus1, sch.wide=="Yes" & comp.imp=="Yes")) 45 | 46 | } 47 | \keyword{survey}% at least one, from doc/KEYWORDS 48 | \keyword{manip}% __ONLY ONE__ keyword per line 49 | -------------------------------------------------------------------------------- /man/svrVar.Rd: -------------------------------------------------------------------------------- 1 | \name{svrVar} 2 | \alias{svrVar} 3 | %- Also NEED an `\alias' for EACH other topic documented here. 4 | \title{Compute variance from replicates } 5 | \description{ 6 | Compute an appropriately scaled empirical variance estimate from 7 | replicates. The \code{mse} argument specifies whether the sums of 8 | squares should be centered at the point estimate (\code{mse=TRUE}) or 9 | the mean of the replicates. It is usually taken from the \code{mse} 10 | component of the design object. 11 | } 12 | \usage{ 13 | svrVar(thetas, scale, rscales, na.action=getOption("na.action"), 14 | mse=getOption("survey.replicates.mse"),coef) 15 | } 16 | %- maybe also `usage' for other objects documented here. 17 | \arguments{ 18 | \item{thetas}{matrix whose rows are replicates (or a vector of replicates)} 19 | \item{scale}{Overall scaling factor} 20 | \item{rscales}{Scaling factor for each squared deviation } 21 | \item{na.action}{How to handle replicates where the statistic could 22 | not be estimated} 23 | \item{mse}{if \code{TRUE}, center at the point estimated, if 24 | \code{FALSE} center at the mean of the replicates} 25 | \item{coef}{The point estimate, required only if \code{mse==TRUE}} 26 | } 27 | \value{ 28 | covariance matrix. 29 | } 30 | \seealso{\code{\link{svrepdesign}}, \code{\link{as.svrepdesign}}, 31 | \code{\link{brrweights}}, 32 | \code{\link{jk1weights}}, \code{\link{jknweights}}} 33 | 34 | \keyword{survey}% at least one, from doc/KEYWORDS 35 | 36 | -------------------------------------------------------------------------------- /man/svy.varcoef.Rd: -------------------------------------------------------------------------------- 1 | \name{svy.varcoef} 2 | \alias{svy.varcoef} 3 | %- Also NEED an `\alias' for EACH other topic documented here. 4 | \title{Sandwich variance estimator for glms} 5 | \description{ 6 | Computes the sandwich variance estimator for a generalised linear model fitted to data from a complex sample survey. Designed to be used internally by \code{\link{svyglm}}. 7 | } 8 | \usage{ 9 | svy.varcoef(glm.object, design) 10 | } 11 | \arguments{ 12 | \item{glm.object}{A \code{\link{glm}} object} 13 | \item{design}{A \code{survey.design} object } 14 | } 15 | \value{ 16 | A variance matrix 17 | } 18 | \author{ Thomas Lumley} 19 | 20 | 21 | \seealso{\code{\link{svyglm}},\code{\link{svydesign}}, \code{\link{svyCprod}} } 22 | 23 | 24 | \keyword{regression}% at least one, from doc/KEYWORDS 25 | \keyword{survey}% __ONLY ONE__ keyword per line 26 | -------------------------------------------------------------------------------- /man/svycdf.Rd: -------------------------------------------------------------------------------- 1 | \name{svycdf} 2 | \alias{svycdf} 3 | \alias{print.svycdf} 4 | \alias{plot.svycdf} 5 | %- Also NEED an '\alias' for EACH other topic documented here. 6 | \title{Cumulative Distribution Function} 7 | \description{ 8 | Estimates the population cumulative distribution function for specified 9 | variables. In contrast to \code{\link{svyquantile}}, this does not do 10 | any interpolation: the result is a right-continuous step function. 11 | } 12 | \usage{ 13 | svycdf(formula, design, na.rm = TRUE,...) 14 | \method{print}{svycdf}(x,...) 15 | \method{plot}{svycdf}(x,xlab=NULL,...) 16 | } 17 | %- maybe also 'usage' for other objects documented here. 18 | \arguments{ 19 | \item{formula}{one-sided formula giving variables from the design object } 20 | \item{design}{survey design object } 21 | \item{na.rm}{remove missing data (case-wise deletion)?} 22 | \item{...}{other arguments to \code{\link{plot.stepfun}}} 23 | \item{x}{object of class \code{svycdf}} 24 | \item{xlab}{a vector of x-axis labels or \code{NULL} for the default labels} 25 | } 26 | 27 | \value{ 28 | An object of class \code{svycdf}, which is a list of step functions (of 29 | class \code{\link{stepfun}}) 30 | } 31 | 32 | 33 | \seealso{ \code{\link{svyquantile}}, \code{\link{svyhist}}, \code{\link{plot.stepfun}}} 34 | \examples{ 35 | data(api) 36 | dstrat <- svydesign(id = ~1, strata = ~stype, weights = ~pw, data = apistrat, 37 | fpc = ~fpc) 38 | cdf.est<-svycdf(~enroll+api00+api99, dstrat) 39 | cdf.est 40 | ## function 41 | cdf.est[[1]] 42 | ## evaluate the function 43 | cdf.est[[1]](800) 44 | cdf.est[[2]](800) 45 | 46 | ## compare to population and sample CDFs. 47 | opar<-par(mfrow=c(2,1)) 48 | cdf.pop<-ecdf(apipop$enroll) 49 | cdf.samp<-ecdf(apistrat$enroll) 50 | plot(cdf.pop,main="Population vs sample", xlab="Enrollment") 51 | lines(cdf.samp,col.points="red") 52 | 53 | plot(cdf.pop, main="Population vs estimate", xlab="Enrollment") 54 | lines(cdf.est[[1]],col.points="red") 55 | 56 | par(opar) 57 | } 58 | % Add one or more standard keywords, see file 'KEYWORDS' in the 59 | % R documentation directory. 60 | \keyword{survey} 61 | \keyword{hplot}% __ONLY ONE__ keyword per line 62 | -------------------------------------------------------------------------------- /man/svycoplot.Rd: -------------------------------------------------------------------------------- 1 | \name{svycoplot} 2 | \alias{svycoplot} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{Conditioning plots of survey data } 5 | \description{ 6 | Draws conditioned scatterplots ('Trellis' plots) of survey data using 7 | hexagonal binning or transparency. 8 | } 9 | \usage{ 10 | svycoplot(formula, design, style = c("hexbin", "transparent"), basecol = 11 | "black", alpha = c(0, 0.8),hexscale=c("relative","absolute"), ...) 12 | } 13 | %- maybe also 'usage' for other objects documented here. 14 | \arguments{ 15 | \item{formula}{A graph formula suitable for \code{\link{xyplot}}} 16 | \item{design}{A survey design object } 17 | \item{style}{Hexagonal binning or transparent color?} 18 | \item{basecol}{The fully opaque 'base' color for creating transparent 19 | colors. This may also be a function; see \code{\link{svyplot}} for details} 20 | \item{alpha}{Minimum and maximum opacity } 21 | \item{hexscale}{Scale hexagons separate for each panel (relative) or 22 | across all panels (absolute)} 23 | \item{\dots}{Other arguments passed to \code{grid.hexagons} or \code{\link{xyplot}} } 24 | } 25 | 26 | \value{ 27 | An object of class \code{trellis} 28 | } 29 | \note{ 30 | As with all 'Trellis' graphs, this function creates an object but does 31 | not draw the graph. When used inside a function or non-interactively 32 | you need to \code{print()} the result to create the graph. 33 | } 34 | \seealso{\code{\link{svyplot}}} 35 | \examples{ 36 | data(api) 37 | dclus2<-svydesign(id=~dnum+snum, weights=~pw, 38 | data=apiclus2, fpc=~fpc1+fpc2) 39 | 40 | svycoplot(api00~api99|sch.wide*comp.imp, design=dclus2, style="hexbin") 41 | svycoplot(api00~api99|sch.wide*comp.imp, design=dclus2, style="hexbin", hexscale="absolute") 42 | 43 | svycoplot(api00~api99|sch.wide, design=dclus2, style="trans") 44 | 45 | svycoplot(api00~meals|stype,design=dclus2, 46 | style="transparent", 47 | basecol=function(d) c("darkred","purple","forestgreen")[as.numeric(d$stype)], 48 | alpha=c(0,1)) 49 | } 50 | % Add one or more standard keywords, see file 'KEYWORDS' in the 51 | % R documentation directory. 52 | \keyword{survey} 53 | \keyword{hplot}% __ONLY ONE__ keyword per line 54 | -------------------------------------------------------------------------------- /man/svycralpha.Rd: -------------------------------------------------------------------------------- 1 | \name{svycralpha} 2 | \alias{svycralpha} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Cronbach's alpha 6 | } 7 | \description{ 8 | Compute Cronbach's alpha coefficient of reliability from survey data. The formula is equation (2) of Cronbach (1951) only with design-based estimates of the variances. 9 | } 10 | \usage{ 11 | svycralpha(formula, design, na.rm = FALSE) 12 | } 13 | %- maybe also 'usage' for other objects documented here. 14 | \arguments{ 15 | \item{formula}{ 16 | One-sided formula giving the variables that make up the total score 17 | } 18 | \item{design}{ 19 | survey design object 20 | } 21 | \item{na.rm}{ 22 | \code{TRUE} to remove missing values 23 | } 24 | } 25 | 26 | \value{ 27 | A number 28 | } 29 | \references{ 30 | Cronbach LJ (1951). "Coefficient alpha and the internal structure of tests". Psychometrika. 16 (3): 297-334. doi:10.1007/bf02310555. 31 | } 32 | 33 | \examples{ 34 | data(api) 35 | dstrat<-svydesign(id = ~1, strata = ~stype, weights = ~pw, data = apistrat, 36 | fpc = ~fpc) 37 | svycralpha(~ell+mobility+avg.ed+emer+meals, dstrat) 38 | } 39 | % Add one or more standard keywords, see file 'KEYWORDS' in the 40 | % R documentation directory. 41 | \keyword{survey}% use one of RShowDoc("KEYWORDS") 42 | 43 | -------------------------------------------------------------------------------- /man/svyfactanal.Rd: -------------------------------------------------------------------------------- 1 | \name{svyfactanal} 2 | \Rdversion{1.1} 3 | \alias{svyfactanal} 4 | %- Also NEED an '\alias' for EACH other topic documented here. 5 | \title{ 6 | Factor analysis in complex surveys (experimental). 7 | } 8 | \description{ 9 | This function fits a factor analysis model or SEM, by maximum weighted likelihood. 10 | } 11 | \usage{ 12 | svyfactanal(formula, design, factors, 13 | n = c("none", "sample", "degf","effective", "min.effective"), ...) 14 | } 15 | %- maybe also 'usage' for other objects documented here. 16 | \arguments{ 17 | \item{formula}{ 18 | Model formula specifying the variables to use 19 | } 20 | \item{design}{ 21 | Survey design object 22 | } 23 | \item{factors}{ 24 | Number of factors to estimate 25 | } 26 | \item{n}{ 27 | Sample size to be used for testing: see below} 28 | \item{\dots}{ 29 | Other arguments to pass to \code{\link{factanal}}. 30 | } 31 | } 32 | 33 | \details{ 34 | The population covariance matrix is estimated by \code{\link{svyvar}} 35 | and passed to \code{\link{factanal}} 36 | 37 | Although fitting these models requires only the estimated covariance 38 | matrix, inference requires a sample size. With \code{n="sample"}, the sample size is taken to be 39 | the number of observations; with \code{n="degf"}, the survey degrees of 40 | freedom as returned by \code{\link{degf}}. Using \code{"sample"} 41 | corresponds to standardizing weights to have mean 1, and is known to 42 | result in anti-conservative tests. 43 | 44 | The other two methods estimate an effective sample size for each 45 | variable as the sample size where the standard error of a variance of a 46 | Normal distribution would match the design-based standard error 47 | estimated by \code{\link{svyvar}}. With \code{n="min.effective"} the 48 | minimum sample size across the variables is used; with 49 | \code{n="effective"} the harmonic mean is used. For \code{svyfactanal} 50 | the test of model adequacy is optional, and the default choice, 51 | \code{n="none"}, does not do the test. 52 | 53 | } 54 | \value{ 55 | An object of class \code{factanal} 56 | } 57 | \references{ 58 | . 59 | } 60 | 61 | 62 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 63 | 64 | \seealso{ 65 | \code{\link{factanal}} 66 | 67 | The \code{lavaan.survey} package fits structural equation models to complex samples using similar techniques. 68 | } 69 | \examples{ 70 | data(api) 71 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 72 | 73 | svyfactanal(~api99+api00+hsg+meals+ell+emer, design=dclus1, factors=2) 74 | 75 | svyfactanal(~api99+api00+hsg+meals+ell+emer, design=dclus1, factors=2, n="effective") 76 | 77 | ##Population dat for comparison 78 | factanal(~api99+api00+hsg+meals+ell+emer, data=apipop, factors=2) 79 | 80 | } 81 | % Add one or more standard keywords, see file 'KEYWORDS' in the 82 | % R documentation directory. 83 | \keyword{survey} 84 | \keyword{multivariate}% __ONLY ONE__ keyword per line 85 | -------------------------------------------------------------------------------- /man/svygofchisq.Rd: -------------------------------------------------------------------------------- 1 | \name{svygofchisq} 2 | \alias{svygofchisq} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Test of fit to known probabilities 6 | } 7 | \description{ 8 | A Rao-Scott-type version of the chi-squared test for goodness of fit to prespecified proportions. The test statistic is the chi-squared statistic applied to the estimated population table, and the reference distribution is a Satterthwaite approximation: the test statistic divided by the estimated scale is compared to a chi-squared distribution with the estimated df. 9 | } 10 | \usage{ 11 | svygofchisq(formula, p, design, ...) 12 | } 13 | %- maybe also 'usage' for other objects documented here. 14 | \arguments{ 15 | \item{formula}{ 16 | Formula specifying a single factor variable 17 | } 18 | \item{p}{ 19 | Vector of probabilities for the categories of the factor, in the correct order (will be rescaled to sum to 1) 20 | } 21 | \item{design}{ 22 | Survey design object 23 | } 24 | \item{\dots}{ 25 | Other arguments to pass to \code{\link{svytotal}}, such as \code{na.rm} 26 | } 27 | } 28 | 29 | \value{ 30 | An object of class \code{htest} 31 | } 32 | 33 | \seealso{ 34 | \code{\link{chisq.test}}, \code{\link{svychisq}}, \code{\link{pchisqsum}} 35 | } 36 | \examples{ 37 | data(api) 38 | dclus2<-svydesign(id=~dnum+snum, fpc=~fpc1+fpc2, data=apiclus2) 39 | 40 | true_p <- table(apipop$stype) 41 | 42 | svygofchisq(~stype,dclus2,p=true_p) 43 | svygofchisq(~stype,dclus2,p=c(1/3,1/3,1/3)) 44 | 45 | } 46 | -------------------------------------------------------------------------------- /man/svyhist.Rd: -------------------------------------------------------------------------------- 1 | \name{svyhist} 2 | \alias{svyhist} 3 | \alias{svyboxplot} 4 | %- Also NEED an '\alias' for EACH other topic documented here. 5 | \title{Histograms and boxplots} 6 | \description{ 7 | Histograms and boxplots weighted by the sampling weights. 8 | } 9 | \usage{ 10 | svyhist(formula, design, breaks = "Sturges", 11 | include.lowest = TRUE, right = TRUE, xlab = NULL, 12 | main = NULL, probability = TRUE, freq = !probability, ...) 13 | svyboxplot(formula, design, all.outliers=FALSE,...) 14 | } 15 | %- maybe also 'usage' for other objects documented here. 16 | \arguments{ 17 | \item{formula}{One-sided formula for \code{svyhist}, two-sided for \code{svyboxplot}} 18 | \item{design}{A survey design object} 19 | \item{xlab}{x-axis label} 20 | \item{main}{Main title} 21 | \item{probability,freq}{Y-axis is probability density or frequency} 22 | \item{all.outliers}{Show all outliers in the boxplot, not just extremes} 23 | \item{breaks, include.lowest, right}{As for \code{\link{hist}}} 24 | \item{\dots}{Other arguments to \code{\link{hist}} or \code{\link{bxp}}} 25 | } 26 | 27 | \details{ 28 | The histogram breakpoints are computed as if the sample were a 29 | simple random sample of the same size. 30 | 31 | The grouping variable in \code{svyboxplot}, if present, must be a factor. 32 | 33 | The boxplot whiskers go to the maximum and minimum observations or to 34 | 1.5 interquartile ranges beyond the end of the box, whichever is 35 | closer. The maximum and minimum are plotted as outliers if they are 36 | beyond the ends of the whiskers, but other outlying points are not 37 | plotted unless \code{all.outliers=TRUE}. \code{svyboxplot} 38 | requires a two-sided formula; use \code{variable~1} for a single boxplot. 39 | } 40 | 41 | \value{ 42 | 43 | As for \code{hist}, except that when \code{probability=FALSE}, the return value includes a component 44 | \code{count_scale} giving a scale factor between density and 45 | counts, assuming equal bin widths. 46 | 47 | } 48 | 49 | \seealso{ \code{\link{svyplot}}} 50 | \examples{ 51 | data(api) 52 | dstrat <- svydesign(id = ~1, strata = ~stype, weights = ~pw, data = apistrat, 53 | fpc = ~fpc) 54 | opar<-par(mfrow=c(1,3)) 55 | svyhist(~enroll, dstrat, main="Survey weighted",col="purple",ylim=c(0,1.3e-3)) 56 | hist(apistrat$enroll, main="Sample unweighted",col="purple",prob=TRUE,ylim=c(0,1.3e-3)) 57 | hist(apipop$enroll, main="Population",col="purple",prob=TRUE,ylim=c(0,1.3e-3)) 58 | 59 | par(mfrow=c(1,1)) 60 | svyboxplot(enroll~stype,dstrat,all.outliers=TRUE) 61 | svyboxplot(enroll~1,dstrat) 62 | par(opar) 63 | } 64 | \keyword{survey}% at least one, from doc/KEYWORDS 65 | \keyword{hplot}% __ONLY ONE__ keyword per line 66 | -------------------------------------------------------------------------------- /man/svyivreg.Rd: -------------------------------------------------------------------------------- 1 | \name{svyivreg} 2 | \alias{svyivreg} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Two-stage least-squares for instrumental variable regression 6 | } 7 | \description{ 8 | Estimates regressions with endogenous covariates using two-stage least squares. The function uses \code{ivreg} from the \code{AER} package for the main computations, and follows the syntax of that function. 9 | 10 | } 11 | \usage{ 12 | svyivreg(formula, design, ...) 13 | } 14 | %- maybe also 'usage' for other objects documented here. 15 | \arguments{ 16 | \item{formula}{formula specification(s) of the regression 17 | relationship and the instruments. See Details for details} 18 | \item{design}{ 19 | A survey design object 20 | } 21 | \item{\dots}{ 22 | For future expansion 23 | } 24 | } 25 | \details{ 26 | Regressors and instruments for \code{svyivreg} are specified 27 | in a formula with two parts on the right-hand side, e.g., \code{y ~ x1 28 | + x2 | z1 + z2 + z3}, where \code{x1} and \code{x2} are the regressors and 29 | \code{z1}, \code{z2}, and \code{z3} are the instruments. Note that exogenous 30 | regressors have to be included as instruments for themselves. For 31 | example, if there is one exogenous regressor \code{ex} and one 32 | endogenous regressor \code{en} with instrument \code{in}, the appropriate 33 | formula would be \code{y ~ ex + en | ex + in}. Equivalently, this can 34 | be specified as \code{y ~ ex + en | . - en + in}, i.e., by providing an 35 | update formula with a \code{.} in the second part of the formula. } 36 | \value{ 37 | An object of class \code{svyivreg} 38 | } 39 | \references{ 40 | \url{https://notstatschat.rbind.io/2019/07/16/adding-new-functions-to-the-survey-package/} 41 | } 42 | 43 | 44 | \seealso{ 45 | \code{\link[AER]{ivreg}}} 46 | 47 | % Add one or more standard keywords, see file 'KEYWORDS' in the 48 | % R documentation directory. 49 | \keyword{survey }% use one of RShowDoc("KEYWORDS") 50 | -------------------------------------------------------------------------------- /man/svykappa.Rd: -------------------------------------------------------------------------------- 1 | \name{svykappa} 2 | \alias{svykappa} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{Cohen's kappa for agreement} 5 | \description{ 6 | Computes the unweighted kappa measure of agreement between two raters 7 | and the standard error. The measurements must both be factor variables 8 | in the survey design object. 9 | } 10 | \usage{ 11 | svykappa(formula, design, ...) 12 | } 13 | %- maybe also 'usage' for other objects documented here. 14 | \arguments{ 15 | \item{formula}{one-sided formula giving two measurements} 16 | \item{design}{survey design object} 17 | \item{\dots}{passed to \code{svymean} internally 18 | (such as \code{return.replicates} or \code{influence})} 19 | } 20 | \value{ 21 | Object of class \code{svystat} 22 | } 23 | 24 | \seealso{ \code{\link{svycontrast}}} 25 | \examples{ 26 | data(api) 27 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 28 | svykappa(~comp.imp+sch.wide, dclus1) 29 | 30 | dclus1<-update(dclus1, stypecopy=stype) 31 | svykappa(~stype+stypecopy,dclus1) 32 | 33 | 34 | (kappas<-svyby(~comp.imp+sch.wide,~stype,design=dclus1, svykappa, covmat=TRUE)) 35 | svycontrast(kappas, quote(E/H)) 36 | 37 | } 38 | % Add one or more standard keywords, see file 'KEYWORDS' in the 39 | % R documentation directory. 40 | \keyword{survey} 41 | 42 | -------------------------------------------------------------------------------- /man/svynls.Rd: -------------------------------------------------------------------------------- 1 | \name{svynls} 2 | \alias{svynls} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Probability-weighted nonlinear least squares 6 | } 7 | \description{ 8 | Fits a nonlinear model by probability-weighted least squares. Uses 9 | \code{nls} to do the fitting, but estimates design-based standard errors with either 10 | linearisation or replicate weights. See \code{\link{nls}} for 11 | documentation of model specification and fitting. 12 | } 13 | \usage{ 14 | svynls(formula, design, start, weights=NULL, ...) 15 | } 16 | %- maybe also 'usage' for other objects documented here. 17 | \arguments{ 18 | \item{formula}{ 19 | Nonlinear model specified as a formula; see \code{\link{nls}} 20 | } 21 | \item{design}{ 22 | Survey design object 23 | } 24 | \item{start}{starting values, passed to \code{\link{nls}}} 25 | 26 | \item{weights}{ 27 | Non-sampling weights, eg precision weights to give more efficient estimation in the presence of heteroscedasticity. 28 | } 29 | \item{\dots}{ 30 | Other arguments to \code{nls} (especially, \code{start}). Also 31 | supports \code{return.replicates} for replicate-weight designs and 32 | \code{influence} for other designs. 33 | } 34 | } 35 | 36 | \value{ 37 | Object of class \code{svynls}. The fitted \code{nls} object is 38 | included as the \code{fit} element. 39 | } 40 | 41 | \seealso{ 42 | \code{\link{svymle}} for maximum likelihood with linear predictors on 43 | one or more parameters 44 | } 45 | \examples{ 46 | set.seed(2020-4-3) 47 | x<-rep(seq(0,50,1),10) 48 | y<-((runif(1,10,20)*x)/(runif(1,0,10)+x))+rnorm(510,0,1) 49 | 50 | pop_model<-nls(y~a*x/(b+x), start=c(a=15,b=5)) 51 | 52 | df<-data.frame(x=x,y=y) 53 | df$p<-ifelse((y-fitted(pop_model))*(x-mean(x))>0, .4,.1) 54 | 55 | df$strata<-ifelse(df$p==.4,"a","b") 56 | 57 | in_sample<-stratsample(df$strata, round(table(df$strat)*c(0.4,0.1))) 58 | 59 | sdf<-df[in_sample,] 60 | des<-svydesign(id=~1, strata=~strata, prob=~p, data=sdf) 61 | pop_model 62 | (biased_sample<-nls(y~a*x/(b+x),data=sdf, start=c(a=15,b=5))) 63 | (corrected <- svynls(y~a*x/(b+x), design=des, start=c(a=15,b=5))) 64 | } 65 | % Add one or more standard keywords, see file 'KEYWORDS' in the 66 | % R documentation directory. 67 | \keyword{survey }% use one of RShowDoc("KEYWORDS") 68 | -------------------------------------------------------------------------------- /man/svyolr.Rd: -------------------------------------------------------------------------------- 1 | \name{svyolr} 2 | \alias{svyolr} 3 | \alias{svyolr.survey.design2} 4 | \alias{svyolr.svyrep.design} 5 | \alias{predict.svyolr} 6 | %- Also NEED an '\alias' for EACH other topic documented here. 7 | \title{Proportional odds and related models } 8 | \description{ 9 | Fits cumulative link models: proportional odds, probit, complementary 10 | log-log, and cauchit. 11 | } 12 | \usage{ 13 | svyolr(formula, design, ...) 14 | \method{svyolr}{survey.design2}(formula, design, start, subset=NULL,..., 15 | na.action = na.omit,method = c("logistic", "probit", "cloglog", "cauchit")) 16 | \method{svyolr}{svyrep.design}(formula,design,subset=NULL,...,return.replicates=FALSE, 17 | multicore=getOption("survey.multicore")) 18 | \method{predict}{svyolr}(object, newdata, type = c("class", "probs"), ...) 19 | } 20 | %- maybe also 'usage' for other objects documented here. 21 | \arguments{ 22 | \item{formula}{Formula: the response must be a factor with at least 23 | three levels} 24 | \item{design}{survey design object } 25 | \item{subset}{subset of the design to use; \code{NULL} for all of it} 26 | \item{\dots}{dots} 27 | \item{start}{Optional starting values for optimization} 28 | \item{na.action}{handling of missing values} 29 | \item{multicore}{Use \code{multicore} package to distribute computation of replicates across multiple 30 | processors?} 31 | \item{method}{Link function} 32 | \item{return.replicates}{return the individual replicate-weight 33 | estimates} 34 | \item{object}{object of class \code{svyolr}} 35 | \item{newdata}{new data for predictions} 36 | \item{type}{return vector of most likely class or matrix of probabilities} 37 | } 38 | \value{ 39 | An object of class \code{svyolr} 40 | } 41 | 42 | \author{The code is based closely on polr() from the MASS package of 43 | Venables and Ripley.} 44 | 45 | \seealso{\code{\link{svyglm}}, \code{\link{regTermTest}} } 46 | \examples{ 47 | data(api) 48 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 49 | dclus1<-update(dclus1, mealcat=cut(meals,c(0,25,50,75,100))) 50 | 51 | m<-svyolr(mealcat~avg.ed+mobility+stype, design=dclus1) 52 | m 53 | 54 | ## Use regTermTest for testing multiple parameters 55 | regTermTest(m, ~avg.ed+stype, method="LRT") 56 | 57 | ## predictions 58 | summary(predict(m, newdata=apiclus2)) 59 | summary(predict(m, newdata=apiclus2, type="probs")) 60 | } 61 | % Add one or more standard keywords, see file 'KEYWORDS' in the 62 | % R documentation directory. 63 | \keyword{survey} 64 | 65 | -------------------------------------------------------------------------------- /man/svyprcomp.Rd: -------------------------------------------------------------------------------- 1 | \name{svyprcomp} 2 | \Rdversion{1.1} 3 | \alias{svyprcomp} 4 | \alias{biplot.svyprcomp} 5 | %- Also NEED an '\alias' for EACH other topic documented here. 6 | \title{ 7 | Sampling-weighted principal component analysis 8 | } 9 | \description{ 10 | Computes principal components using the sampling weights. 11 | } 12 | \usage{ 13 | svyprcomp(formula, design, center = TRUE, scale. = FALSE, tol = NULL, scores = FALSE, ...) 14 | \method{biplot}{svyprcomp}(x, cols=c("black","darkred"),xlabs=NULL, 15 | weight=c("transparent","scaled","none"), 16 | max.alpha=0.5,max.cex=0.5,xlim=NULL,ylim=NULL,pc.biplot=FALSE, 17 | expand=1,xlab=NULL,ylab=NULL, arrow.len=0.1, ...) 18 | } 19 | \arguments{ 20 | \item{formula}{ 21 | model formula describing variables to be used 22 | } 23 | \item{design}{ 24 | survey design object. 25 | } 26 | \item{center}{ 27 | Center data before analysis? 28 | } 29 | \item{scale.}{ 30 | Scale to unit variance before analysis? 31 | } 32 | \item{tol}{ 33 | Tolerance for omitting components from the results; a proportion of the standard deviation of the first component. The default is to keep all components. 34 | } 35 | \item{scores}{ 36 | Return scores on each component? These are needed for \code{biplot}. 37 | } 38 | \item{x}{ 39 | A \code{svyprcomp} object 40 | } 41 | \item{cols}{ 42 | Base colors for observations and variables respectively 43 | } 44 | \item{xlabs}{ 45 | Formula, or character vector, giving labels for each observation 46 | } 47 | \item{weight}{ 48 | How to display the sampling weights: \code{"scaled"} changes the size of the point label, \code{"transparent"} uses opacity proportional to sampling weight, \code{"none"} changes neither. 49 | } 50 | \item{max.alpha}{ 51 | Opacity for the largest sampling weight, or for all points if \code{weight!="transparent"} 52 | } 53 | \item{max.cex}{ 54 | Character size (as a multiple of \code{par("cex")}) for the largest sampling weight, or for all points if \code{weight!="scaled"} 55 | } 56 | \item{xlim,ylim,xlab,ylab}{Graphical parameters} 57 | \item{expand,arrow.len}{See \code{\link{biplot}}} 58 | \item{pc.biplot}{See \code{link{biplot.prcomp}}} 59 | \item{\dots}{ 60 | Other arguments to \code{\link{prcomp}}, or graphical parameters for \code{biplot} 61 | } 62 | 63 | } 64 | 65 | \value{ 66 | \code{svyprcomp} returns an object of class \code{svyprcomp}, similar to 67 | class \code{prcomp} but including design information 68 | 69 | } 70 | 71 | \seealso{ 72 | \code{\link{prcomp}}, \code{\link{biplot.prcomp}} 73 | } 74 | \examples{ 75 | data(api) 76 | dclus2<-svydesign(id=~dnum+snum, fpc=~fpc1+fpc2, data=apiclus2) 77 | 78 | pc <- svyprcomp(~api99+api00+ell+hsg+meals+emer, design=dclus2,scale=TRUE,scores=TRUE) 79 | pc 80 | biplot(pc, xlabs=~dnum, weight="none") 81 | 82 | biplot(pc, xlabs=~dnum,max.alpha=1) 83 | 84 | biplot(pc, weight="scaled",max.cex=1.5, xlabs=~dnum) 85 | 86 | } 87 | % Add one or more standard keywords, see file 'KEYWORDS' in the 88 | % R documentation directory. 89 | \keyword{survey} 90 | \keyword{hplot}% __ONLY ONE__ keyword per line 91 | \keyword{multivariate} -------------------------------------------------------------------------------- /man/svyqqplot.Rd: -------------------------------------------------------------------------------- 1 | \name{svyqqplot} 2 | \alias{svyqqplot} 3 | \alias{svyqqmath} 4 | %- Also NEED an '\alias' for EACH other topic documented here. 5 | \title{ 6 | Quantile-quantile plots for survey data 7 | } 8 | \description{ 9 | Quantile-quantile plots either against a specified distribution function or comparing two variables from the same or different designs. 10 | } 11 | \usage{ 12 | svyqqplot(formula, design, designx = NULL, na.rm = TRUE, qrule = "hf8", 13 | xlab = NULL, ylab = NULL, ...) 14 | svyqqmath(x, design, null=qnorm, na.rm=TRUE, xlab="Expected",ylab="Observed",...) 15 | } 16 | %- maybe also 'usage' for other objects documented here. 17 | \arguments{ 18 | \item{x,formula}{ 19 | A one-sided formula for \code{svyqqmath} or a two-sided formula for \code{svyqqplot} 20 | } 21 | \item{design}{ 22 | Survey design object to look up variables 23 | } 24 | \item{designx}{ 25 | Survey design object to look up the RHS variable in \code{svyqqplot}, if 26 | different from the LHS variable 27 | } 28 | \item{null}{Quantile function to compare the data quantiles to} 29 | \item{na.rm}{ 30 | Remove missing values 31 | } 32 | \item{qrule}{ 33 | How to define quantiles for \code{svyqqplot} -- see 34 | \code{\link{svyquantile}} for possible values 35 | } 36 | \item{xlab,ylab}{ 37 | Passed to \code{plot}. For \code{svyqqplot}, if these are \code{NULL} 38 | they are replaced by the variable names 39 | } 40 | 41 | \item{\dots}{ 42 | Graphical options to be passed to \code{plot} 43 | } 44 | } 45 | 46 | \value{ 47 | None 48 | } 49 | 50 | 51 | 52 | \seealso{ 53 | \code{\link{quantile}} 54 | \code{\link{qqnorm}} 55 | \code{\link{qqplot}} 56 | } 57 | \examples{ 58 | data(api) 59 | 60 | dstrat<-svydesign(id=~1,strata=~stype, weights=~pw, data=apistrat, 61 | fpc=~fpc) 62 | 63 | svyqqmath(~api99, design=dstrat) 64 | svyqqplot(api00~api99, design=dstrat) 65 | 66 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 67 | opar<-par(mfrow=c(1,2)) 68 | 69 | ## sample distributions very different 70 | qqplot(apiclus1$enroll, apistrat$enroll); abline(0,1) 71 | 72 | ## estimated population distributions much more similar 73 | svyqqplot(enroll~enroll, design=dstrat,designx=dclus1,qrule=survey:::qrule_hf8); abline(0,1) 74 | par(opar) 75 | 76 | } 77 | % Add one or more standard keywords, see file 'KEYWORDS' in the 78 | % R documentation directory. 79 | \keyword{survey }% use one of RShowDoc("KEYWORDS") 80 | -------------------------------------------------------------------------------- /man/svysurvreg.Rd: -------------------------------------------------------------------------------- 1 | \name{svysurvreg} 2 | \alias{svysurvreg} 3 | \alias{svysurvreg.survey.design} 4 | %- Also NEED an '\alias' for EACH other topic documented here. 5 | \title{ 6 | Fit accelerated failure models to survey data 7 | } 8 | \description{ 9 | This function calls \code{survreg} from the 'survival' package to fit accelerated failure (accelerated life) models to complex survey data, and then computes correct standard errors by linearisation. It has the same arguments as \code{survreg}, except that the second argument is \code{design} rather than \code{data}. 10 | } 11 | \usage{ 12 | \method{svysurvreg}{survey.design}(formula, design, weights=NULL, subset=NULL, ...) 13 | } 14 | %- maybe also 'usage' for other objects documented here. 15 | \arguments{ 16 | \item{formula}{ 17 | Model formula 18 | } 19 | \item{design}{ 20 | Survey design object, including two-phase designs 21 | } 22 | \item{weights}{ 23 | Additional weights to multiply by the sampling weights. No, I don't know why you'd want to do that. 24 | } 25 | \item{subset}{ 26 | subset to use in fitting (if needed) 27 | } 28 | 29 | \item{\dots}{ 30 | Other arguments of \code{survreg} 31 | } 32 | } 33 | \value{ 34 | Object of class \code{svysurvreg}, with the same structure as a \code{survreg} object but with \code{NA} for the loglikelihood. 35 | } 36 | 37 | \note{ 38 | The \code{residuals} method is identical to that for \code{survreg} objects except the \code{weighted} option defaults to \code{TRUE} 39 | } 40 | 41 | 42 | \examples{ 43 | 44 | data(pbc, package="survival") 45 | pbc$randomized <- with(pbc, !is.na(trt) & trt>0) 46 | biasmodel<-glm(randomized~age*edema,data=pbc) 47 | pbc$randprob<-fitted(biasmodel) 48 | dpbc<-svydesign(id=~1, prob=~randprob, strata=~edema, 49 | data=subset(pbc,randomized)) 50 | 51 | model <- svysurvreg(Surv(time, status>0)~bili+protime+albumin, design=dpbc, dist="weibull") 52 | summary(model) 53 | 54 | } 55 | % Add one or more standard keywords, see file 'KEYWORDS' in the 56 | % R documentation directory. 57 | \keyword{survey}% use one of RShowDoc("KEYWORDS") 58 | \keyword{survival}% __ONLY ONE__ keyword per line 59 | -------------------------------------------------------------------------------- /man/svyttest.Rd: -------------------------------------------------------------------------------- 1 | \name{svyttest} 2 | \alias{svyttest} 3 | \alias{confint.svyttest} 4 | %- Also NEED an '\alias' for EACH other topic documented here. 5 | \title{Design-based t-test} 6 | \description{ 7 | One-sample or two-sample t-test. This function is a wrapper for 8 | \code{\link{svymean}} in the one-sample case and for 9 | \code{\link{svyglm}} in the two-sample case. Degrees of freedom are 10 | \code{degf(design)-1} for the one-sample test and \code{degf(design)-2} 11 | for the two-sample case. 12 | } 13 | \usage{ 14 | svyttest(formula, design, ...) 15 | } 16 | %- maybe also 'usage' for other objects documented here. 17 | \arguments{ 18 | \item{formula}{Formula, \code{outcome~group} for two-sample, 19 | \code{outcome~0} or \code{outcome~1} for one-sample. The \code{group} variable 20 | must be a factor or character with two levels, or be coded 0/1 or 1/2} 21 | \item{design}{survey design object} 22 | \item{\dots}{for methods } 23 | } 24 | \value{ 25 | Object of class \code{htest} 26 | } 27 | 28 | \seealso{ \code{\link{t.test}}} 29 | \examples{ 30 | data(api) 31 | dclus2<-svydesign(id=~dnum+snum, fpc=~fpc1+fpc2, data=apiclus2) 32 | tt<-svyttest(enroll~comp.imp, dclus2) 33 | tt 34 | confint(tt, level=0.9) 35 | 36 | svyttest(enroll~I(stype=="E"),dclus2) 37 | 38 | svyttest(I(api00-api99)~0, dclus2) 39 | 40 | } 41 | % Add one or more standard keywords, see file 'KEYWORDS' in the 42 | % R documentation directory. 43 | \keyword{survey} 44 | \keyword{htest}% __ONLY ONE__ keyword per line 45 | -------------------------------------------------------------------------------- /man/trimWeights.Rd: -------------------------------------------------------------------------------- 1 | \name{trimWeights} 2 | \Rdversion{1.1} 3 | \alias{trimWeights} 4 | \alias{trimWeights.svyrep.design} 5 | \alias{trimWeights.survey.design2} 6 | %- Also NEED an '\alias' for EACH other topic documented here. 7 | \title{ 8 | Trim sampling weights 9 | } 10 | \description{ 11 | Trims very high or very low sampling weights to reduce the influence of outlying observations. In a replicate-weight design object, the replicate weights are also trimmed. The total amount trimmed is divided among the observations that were not trimmed, so that the total weight remains the same. 12 | } 13 | \usage{ 14 | trimWeights(design, upper = Inf, lower = -Inf, ...) 15 | \method{trimWeights}{survey.design2}(design, upper = Inf, lower = -Inf, strict=FALSE,...) 16 | \method{trimWeights}{svyrep.design}(design, upper = Inf, lower = -Inf, 17 | strict=FALSE, compress=FALSE,...) 18 | } 19 | %- maybe also 'usage' for other objects documented here. 20 | \arguments{ 21 | \item{design}{ 22 | A survey design object 23 | } 24 | \item{upper}{ 25 | Upper bound for weights 26 | } 27 | \item{lower}{ 28 | Lower bound for weights 29 | } 30 | \item{strict}{ 31 | The reapportionment of the `trimmings' from the weights can push 32 | other weights over the limits. If \code{trim=TRUE} the function 33 | repeats the trimming iteratively to prevent this. For 34 | replicate-weight designs \code{strict} applies only to the trimming of the sampling weights. 35 | } 36 | \item{compress}{ 37 | Compress the replicate weights after trimming. 38 | } 39 | \item{\dots}{ 40 | Other arguments for future expansion 41 | } 42 | } 43 | 44 | \value{ 45 | A new survey design object with trimmed weights. 46 | } 47 | 48 | 49 | %% ~Make other sections like Warning with \section{Warning }{....} ~ 50 | 51 | \seealso{ 52 | \code{\link{calibrate}} has a \code{trim} option for trimming the 53 | calibration adjustments. 54 | } 55 | \examples{ 56 | data(api) 57 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 58 | 59 | pop.totals<-c(`(Intercept)`=6194, stypeH=755, stypeM=1018, 60 | api99=3914069) 61 | dclus1g<-calibrate(dclus1, ~stype+api99, pop.totals) 62 | 63 | summary(weights(dclus1g)) 64 | dclus1t<-trimWeights(dclus1g,lower=20, upper=45) 65 | summary(weights(dclus1t)) 66 | dclus1tt<-trimWeights(dclus1g, lower=20, upper=45,strict=TRUE) 67 | summary(weights(dclus1tt)) 68 | 69 | 70 | svymean(~api99+api00+stype, dclus1g) 71 | svymean(~api99+api00+stype, dclus1t) 72 | svymean(~api99+api00+stype, dclus1tt) 73 | } 74 | % Add one or more standard keywords, see file 'KEYWORDS' in the 75 | % R documentation directory. 76 | \keyword{survey} 77 | 78 | -------------------------------------------------------------------------------- /man/update.survey.design.Rd: -------------------------------------------------------------------------------- 1 | \name{update.survey.design} 2 | \alias{update.survey.design} 3 | \alias{update.twophase} 4 | \alias{update.svyrep.design} 5 | \alias{update.DBIsvydesign} 6 | %- Also NEED an `\alias' for EACH other topic documented here. 7 | \title{ Add variables to a survey design} 8 | \description{ 9 | Update the data variables in a survey design, either with a formula for a new set of variables or with an expression for variables to be added. 10 | } 11 | \usage{ 12 | \method{update}{survey.design}(object, ...) 13 | \method{update}{twophase}(object, ...) 14 | \method{update}{svyrep.design}(object, ...) 15 | \method{update}{DBIsvydesign}(object, ...) 16 | } 17 | %- maybe also `usage' for other objects documented here. 18 | \arguments{ 19 | \item{object}{a survey design object} 20 | \item{\dots}{Arguments \code{tag=expr} add a new variable \code{tag} 21 | computed by evaluating \code{expr} in the survey data.} 22 | } 23 | \details{ 24 | Database-backed objects may not have write access to the database and so 25 | \code{update} does not attempt to modify the database. The expressions 26 | are stored and are evaluated when the data is loaded. 27 | 28 | If a set of new variables will be used extensively it may be more efficient to 29 | modify the database, either with SQL queries from the R interface or 30 | separately. One useful intermediate approach is to create a table with 31 | the new variables and a view that joins this table to the table of 32 | existing variables. 33 | 34 | There is now a base-R function \code{\link{transform}} for adding new 35 | variables to a data frame, so I have added \code{transform} as a synonym for 36 | \code{update} for survey objects. 37 | } 38 | \value{ 39 | A survey design object 40 | } 41 | 42 | \seealso{\code{\link{svydesign}}, \code{\link{svrepdesign}}, \code{\link{twophase}}} 43 | 44 | \examples{ 45 | data(api) 46 | dstrat<-svydesign(id=~1,strata=~stype, weights=~pw, data=apistrat, 47 | fpc=~fpc) 48 | dstrat<-update(dstrat, apidiff=api00-api99) 49 | svymean(~api99+api00+apidiff, dstrat) 50 | } 51 | \keyword{survey}% at least one, from doc/KEYWORDS 52 | \keyword{manip}% __ONLY ONE__ keyword per line 53 | -------------------------------------------------------------------------------- /man/weights.survey.design.Rd: -------------------------------------------------------------------------------- 1 | \name{weights.survey.design} 2 | \alias{weights.survey.design} 3 | \alias{weights.svyrep.design} 4 | \alias{weights.survey_fpc} 5 | %- Also NEED an `\alias' for EACH other topic documented here. 6 | \title{Survey design weights} 7 | \description{ 8 | Extract weights from a survey design object. 9 | } 10 | \usage{ 11 | \method{weights}{survey.design}(object, ...) 12 | \method{weights}{svyrep.design}(object, 13 | type=c("replication","sampling","analysis"), ...) 14 | \method{weights}{survey_fpc}(object,final=TRUE,...) 15 | } 16 | %- maybe also `usage' for other objects documented here. 17 | \arguments{ 18 | \item{object}{Survey design object} 19 | \item{type}{Type of weights: \code{"analysis"} combines sampling and 20 | replication weights.} 21 | \item{final}{If \code{FALSE} return a data frame with sampling 22 | weights at each stage of sampling.} 23 | \item{\dots}{Other arguments ignored } 24 | } 25 | 26 | \value{ 27 | vector or matrix of weights 28 | } 29 | 30 | \seealso{\code{\link{svydesign}}, \code{\link{svrepdesign}}, 31 | \code{\link{as.fpc}} } 32 | 33 | \examples{ 34 | data(scd) 35 | 36 | 37 | scddes<-svydesign(data=scd, prob=~1, id=~ambulance, strata=~ESA, 38 | nest=TRUE, fpc=rep(5,6)) 39 | repweights<-2*cbind(c(1,0,1,0,1,0), c(1,0,0,1,0,1), c(0,1,1,0,0,1), c(0,1,0,1,1,0)) 40 | scdrep<-svrepdesign(data=scd, type="BRR", repweights=repweights) 41 | 42 | weights(scdrep) 43 | weights(scdrep, type="sampling") 44 | weights(scdrep, type="analysis") 45 | weights(scddes) 46 | 47 | } 48 | \keyword{survey}% at least one, from doc/KEYWORDS 49 | 50 | -------------------------------------------------------------------------------- /man/with.svyimputationList.Rd: -------------------------------------------------------------------------------- 1 | \name{with.svyimputationList} 2 | \alias{with.svyimputationList} 3 | \alias{subset.svyimputationList} 4 | %- Also NEED an '\alias' for EACH other topic documented here. 5 | \title{Analyse multiple imputations} 6 | \description{ 7 | Performs a survey analysis on each of the designs in a 8 | \code{svyimputationList} objects and returns a list of results suitable 9 | for \code{MIcombine}. The analysis may be specified as an expression or 10 | as a function. 11 | } 12 | \usage{ 13 | \method{with}{svyimputationList}(data, expr, fun, ...,multicore=getOption("survey.multicore")) 14 | \method{subset}{svyimputationList}(x, subset,...) 15 | } 16 | %- maybe also 'usage' for other objects documented here. 17 | \arguments{ 18 | \item{data,x}{A \code{svyimputationList} object } 19 | \item{expr}{An expression giving a survey analysis} 20 | \item{fun}{A function taking a survey design object as its argument } 21 | \item{\dots}{for future expansion } 22 | \item{multicore}{Use \code{multicore} package to distribute imputed data sets over multiple processors?} 23 | \item{subset}{An logical expression specifying the subset} 24 | 25 | } 26 | 27 | \value{ 28 | A list of the results from applying the analysis to each design object. 29 | } 30 | 31 | \seealso{\code{MIcombine}, in the \code{mitools} package } 32 | \examples{ 33 | library(mitools) 34 | data.dir<-system.file("dta",package="mitools") 35 | files.men<-list.files(data.dir,pattern="m.\\\\.dta$",full=TRUE) 36 | men<-imputationList(lapply(files.men, foreign::read.dta, 37 | warn.missing.labels=FALSE)) 38 | files.women<-list.files(data.dir,pattern="f.\\\\.dta$",full=TRUE) 39 | women<-imputationList(lapply(files.women, foreign::read.dta, 40 | warn.missing.labels=FALSE)) 41 | men<-update(men, sex=1) 42 | women<-update(women,sex=0) 43 | all<-rbind(men,women) 44 | 45 | designs<-svydesign(id=~id, strata=~sex, data=all) 46 | designs 47 | 48 | results<-with(designs, svymean(~drkfre)) 49 | 50 | MIcombine(results) 51 | 52 | summary(MIcombine(results)) 53 | 54 | repdesigns<-as.svrepdesign(designs, type="boot", replicates=50) 55 | MIcombine(with(repdesigns, svymean(~drkfre))) 56 | 57 | } 58 | % Add one or more standard keywords, see file 'KEYWORDS' in the 59 | % R documentation directory. 60 | \keyword{survey }% __ONLY ONE__ keyword per line 61 | -------------------------------------------------------------------------------- /man/withPV.survey.design.Rd: -------------------------------------------------------------------------------- 1 | \name{withPV.survey.design} 2 | \alias{withPV.survey.design} 3 | %- Also NEED an '\alias' for EACH other topic documented here. 4 | \title{ 5 | Analyse plausible values in surveys 6 | } 7 | \description{ 8 | Repeats an analysis for each of a set of 'plausible values' in a survey data set, returning a list suitable for \code{mitools::MIcombine}. The default method works for both standard and replicate-weight designs but not for two-phase designs. 9 | } 10 | \usage{ 11 | \S3method{withPV}{survey.design}(mapping, data, action, rewrite=TRUE, ...) 12 | } 13 | %- maybe also 'usage' for other objects documented here. 14 | \arguments{ 15 | \item{mapping}{ 16 | A formula or list of formulas describing each variable in the analysis that has plausible values. The left-hand side of the formula is the name to use in the analysis; the right-hand side gives the names in the dataset. 17 | } 18 | \item{data}{ 19 | A survey design object, as created by \code{svydesign} or \code{svrepdesign} 20 | } 21 | \item{action}{ 22 | With \code{rewrite=TRUE}, a function taking a survey design object as 23 | its only argument, or a quoted expression. With \code{rewrite=TRUE} 24 | a function taking a survey design object as its only argument, or a 25 | quoted expression with \code{.DESIGN} referring to the survey design object to be used. 26 | } 27 | \item{rewrite}{ 28 | Rewrite \code{action} before evaluating it (versus constructing new data 29 | sets) 30 | } 31 | \item{\dots}{ 32 | For methods 33 | } 34 | } 35 | \value{ 36 | A list of the results returned by each evaluation of \code{action}, with the call as an attribute. 37 | } 38 | 39 | 40 | \seealso{ 41 | \code{\link{with.svyimputationList}} 42 | } 43 | \examples{ 44 | if(require(mitools)){ 45 | data(pisamaths, package="mitools") 46 | des<-svydesign(id=~SCHOOLID+STIDSTD, strata=~STRATUM, nest=TRUE, 47 | weights=~W_FSCHWT+condwt, data=pisamaths) 48 | 49 | oo<-options(survey.lonely.psu="remove") 50 | 51 | results<-withPV(list(maths~PV1MATH+PV2MATH+PV3MATH+PV4MATH+PV5MATH), 52 | data=des, 53 | action=quote(svyglm(maths~ST04Q01*(PCGIRLS+SMRATIO)+MATHEFF+OPENPS, design=des)), 54 | rewrite=TRUE) 55 | 56 | summary(MIcombine(results)) 57 | options(oo) 58 | } 59 | } 60 | % Add one or more standard keywords, see file 'KEYWORDS' in the 61 | % R documentation directory. 62 | \keyword{survey}% use one of RShowDoc("KEYWORDS") -------------------------------------------------------------------------------- /man/yrbs.Rd: -------------------------------------------------------------------------------- 1 | \name{yrbs} 2 | \alias{yrbs} 3 | \docType{data} 4 | \title{ 5 | One variable from the Youth Risk Behaviors Survey, 2015. 6 | } 7 | \description{ 8 | Design information from the Youth Risk Behaviors Survey (YRBS), together 9 | with the single variable `Never/Rarely wore bike helmet'. Used as an 10 | analysis example by CDC. 11 | } 12 | \usage{data("yrbs")} 13 | \format{ 14 | A data frame with 15624 observations on the following 4 variables. 15 | \describe{ 16 | \item{\code{weight}}{sampling weights} 17 | \item{\code{stratum}}{sampling strata} 18 | \item{\code{psu}}{primary sampling units} 19 | \item{\code{qn8}}{1=Yes, 2=No} 20 | } 21 | } 22 | 23 | \source{ 24 | \url{https://ftp.cdc.gov/pub/Data/YRBS/2015smy/} for files 25 | 26 | } 27 | \references{ 28 | Centers for Disease Control and Prevention (2016) Software for Analysis 29 | of YRBS Data. [CRAN doesn't believe the URL is valid] 30 | } 31 | \examples{ 32 | data(yrbs) 33 | 34 | yrbs_design <- svydesign(id=~psu, weight=~weight, strata=~stratum, 35 | data=yrbs) 36 | yrbs_design <- update(yrbs_design, qn8yes=2-qn8) 37 | 38 | ci <- svyciprop(~qn8yes, yrbs_design, na.rm=TRUE, method="xlogit") 39 | ci 40 | 41 | ## to print more digits: matches SUDAAN and SPSS exactly, per table 3 of reference 42 | coef(ci) 43 | SE(ci) 44 | attr(ci,"ci") 45 | } 46 | \keyword{datasets} 47 | -------------------------------------------------------------------------------- /src/Makevars.makefile: -------------------------------------------------------------------------------- 1 | 2 | PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) -------------------------------------------------------------------------------- /src/Makevars.win: -------------------------------------------------------------------------------- 1 | 2 | PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) 3 | -------------------------------------------------------------------------------- /tests/3stage2phase.R: -------------------------------------------------------------------------------- 1 | ## simulated data with three-stage sample at phase 1, SRS at phase 2 2 | ## motivated by dietary biomarker substudy in HCHS 3 | 4 | library(survey) 5 | 6 | load("simdata1.RData") 7 | 8 | twophase.full = twophase(id=list(~block+house+ind,~1), 9 | strata=list(~strat,NULL), 10 | probs=list(~P.block+P.house+P.ind,NULL), 11 | subset=~phase2, 12 | data=simdata1,method='full') 13 | 14 | twophase.approx = twophase(id=list(~block+house+ind,~1), 15 | strata=list(~strat,NULL), 16 | probs=list(~P.block+P.house+P.ind,NULL), 17 | subset=~phase2, 18 | data=simdata1,method='approx') 19 | 20 | twophase.rep = twophase(id=list(~block,~1), 21 | strata=list(~strat,NULL), 22 | probs=list(~I(P.block*P.house*P.ind),NULL), 23 | subset=~phase2, 24 | data=simdata1,method='full') 25 | 26 | 27 | twophase.repapprox = twophase(id=list(~block,~1), 28 | strata=list(~strat,NULL), 29 | probs=list(~I(P.block*P.house*P.ind),NULL), 30 | subset=~phase2, 31 | data=simdata1,method='approx') 32 | 33 | 34 | svymean(~age, twophase.full) 35 | svymean(~age, twophase.approx) 36 | svymean(~age, twophase.rep) 37 | svymean(~age, twophase.repapprox) 38 | -------------------------------------------------------------------------------- /tests/DBIcheck.R: -------------------------------------------------------------------------------- 1 | 2 | library(survey) 3 | library(RSQLite) 4 | 5 | data(api) 6 | apiclus1$api_stu<-apiclus1$api.stu 7 | apiclus1$comp_imp<-apiclus1$comp.imp 8 | dclus1<-svydesign(id=~dnum, weights=~pw, fpc=~fpc,data=apiclus1) 9 | dbclus1<-svydesign(id=~dnum, weights=~pw, fpc=~fpc, 10 | data="apiclus1",dbtype="SQLite", dbname=system.file("api.db",package="survey")) 11 | 12 | m<-svymean(~api00+stype,dclus1) 13 | m.db<-svymean(~api00+stype, dbclus1) 14 | all.equal(coef(m),coef(m.db)) 15 | all.equal(vcov(m), vcov(m.db)) 16 | 17 | r<-svyratio(~api_stu, ~enroll, design=dclus1) 18 | r.db<-svyratio(~api_stu, ~enroll, design=dbclus1) 19 | all.equal(coef(r), coef(r.db)) 20 | all.equal(SE(r), SE(r.db)) 21 | 22 | b<-svyby(~api99+api00,~stype, design=dclus1, svymean, deff=TRUE) 23 | b.db<-svyby(~api99+api00,~stype, design=dbclus1,svymean, deff=TRUE) 24 | all.equal(coef(b), coef(b.db)) 25 | all.equal(SE(b), SE(b.db)) 26 | all.equal(deff(b), deff(b.db)) 27 | 28 | l<-svyglm(api00~api99+mobility, design=dclus1) 29 | l.db<-svyglm(api00~api99+mobility, design=dbclus1) 30 | all.equal(coef(l),coef(l.db)) 31 | all.equal(vcov(l), vcov(l.db)) 32 | 33 | dclus1<-update(dclus1, apidiff=api00-api99) 34 | dclus1<-update(dclus1, apipct= apidiff/api99) 35 | dbclus1<-update(dbclus1, apidiff=api00-api99) 36 | dbclus1<-update(dbclus1, apipct= apidiff/api99) 37 | 38 | u<-svymean(~api00+apidiff+apipct, dclus1) 39 | u.db<-svymean(~api00+apidiff+apipct, dbclus1) 40 | all.equal(u, u.db) 41 | 42 | all.equal(nrow(dclus1),nrow(dbclus1)) 43 | all.equal(nrow(subset(dclus1,stype=="E")), 44 | nrow(subset(dbclus1,stype=="E"))) 45 | 46 | ## replicate weights 47 | rclus1<-as.svrepdesign(dclus1) 48 | db_rclus1<-svrepdesign(weights=~pw, repweights="wt[1-9]+", type="JK1", scale=(1-15/757)*14/15, 49 | data="apiclus1rep",dbtype="SQLite", dbname=system.file("api.db",package="survey"),combined.weights=FALSE) 50 | m<-svymean(~api00+api99,rclus1) 51 | m.db<-svymean(~api00+api99,db_rclus1) 52 | all.equal(m,m.db) 53 | 54 | summary(db_rclus1) 55 | 56 | s<-svymean(~api00, subset(rclus1, comp_imp=="Yes")) 57 | s.db<-svymean(~api00, subset(db_rclus1, comp_imp=="Yes")) 58 | all.equal(s,s.db) 59 | -------------------------------------------------------------------------------- /tests/README: -------------------------------------------------------------------------------- 1 | 3stage2phase.R: twophase designs with three-stage sample at phase 1 2 | 3 | api.R: Run example(api) to check that results haven't changed 4 | 5 | bycovmat.R: Check that svyby(,covmat=TRUE) is getting the ordering 6 | of estimates correct. 7 | 8 | caleg.R: Calibration examples 9 | - calibration to information on PSUs rather than population 10 | - check that bounded weights really are bounded 11 | - check that linear calibration with error proportional to 12 | x agrees with ratio estimators 13 | 14 | check.R: Many combinations of options for svydesign 15 | 16 | deff.R: Regression test on design effects, especially for totals 17 | 18 | degf-svrepdesign: check specifying degf to svrepdesign rather than computing it 19 | 20 | DBIcheck.R: Check that we get the same results for SQLite-backed and 21 | in-memory versions of the API data. 22 | 23 | domain.R: Check that domain estimators of means and their standard 24 | errors agree with derivations as ratio and regression 25 | estimators. Repeat for calibrated and raked designs 26 | 27 | fpc.R: Many ways to specify fpc 28 | 29 | kalton.R: Calibration examples from Kalton & Flore-Cervantes, 30 | J Off Stat, 19(2) 81-97 31 | 32 | lonely.psu.R: All the lonely PSU options 33 | 34 | multistage.R: Check that a two-stage cluster sample analysis agrees with 35 | the hand-calcuated result in Sarndal et al. 36 | 37 | nwts.R: Compare results from twophase() to published two-phase 38 | case-control example 39 | 40 | nwts-cch.R: Compare results from twophase() to case-cohort analyses in 41 | survival package. 42 | 43 | pps.R: Brewer's approximation for pps without replacement 44 | 45 | quantile.R: quantile estimation on a lognormal sample 46 | 47 | rakecheck.R: check that raking by iterative post-stratification agrees with 48 | raking using calibrate() 49 | 50 | regpredict.R: ratio and regression estimation of a total. 51 | 52 | rss_scores.R: Score test example from Rao, Scott, and Skinner (1998) 53 | 54 | scoping.R: check that svyglm and svycoxph work inside functions. 55 | 56 | survcurve.R: check that svykm and predict.coxph give the same result 57 | when a data set is doubled and the two replicates of each 58 | observation are treated as a cluster. 59 | 60 | twophase.R: separately verifiable examples of twophase studies 61 | 62 | quantile-chile.R: example of interpolating for quantiles, from Chilean 63 | stats agency 64 | 65 | na_action.R: check that svyglm works with na.action=na.exclude 66 | 67 | svyivreg-var.R: check that summary.svyivreg is finding the right variances 68 | 69 | svyolr-rake-subset.R: make sure subsets of calibrated designs get handled correctly 70 | 71 | anova-svycoxph.R: check that symbolically nested and linear-algebra versions of anova.svycoxph agree 72 | 73 | -------------------------------------------------------------------------------- /tests/anova-svycoxph.R: -------------------------------------------------------------------------------- 1 | 2 | library(survey) 3 | example(svycoxph, ask=FALSE) 4 | m<-update(model, .~.+I(protime^2)) 5 | a<-anova(m,model) 6 | b<-anova(m, model,force=TRUE) 7 | stopifnot(isTRUE(all.equal(b[2:6],a[c(3,4,6,7,8)]))) 8 | -------------------------------------------------------------------------------- /tests/api.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | options(survey.replicates.mse=TRUE) 3 | example(api) 4 | 5 | options(survey.replicates.mse=FALSE) 6 | example(api) 7 | -------------------------------------------------------------------------------- /tests/badcal.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Calibration with badly-scaled initial weights (bug report by Takahiro Tsuchiya) 3 | ## 4 | library(survey) 5 | data <- data.frame(x=c(1,1,1,1,2,2,2,2,2,2), w=rep(10,10)) 6 | des <- svydesign(ids=~1, weights=~w, data=data) 7 | des.c <- calibrate(des, ~factor(x), c(10000, 5000)) 8 | des.r <- calibrate(des, ~factor(x), c(10000, 5000), calfun='raking') 9 | stopifnot(all.equal(svytotal(~factor(x), des.c), svytotal(~factor(x), des.r))) 10 | -------------------------------------------------------------------------------- /tests/badcal.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 3.1.0 (2014-04-10) -- "Spring Dance" 3 | Copyright (C) 2014 The R Foundation for Statistical Computing 4 | Platform: x86_64-apple-darwin13.1.0 (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > ## 19 | > ## Calibration with badly-scaled initial weights (bug report by Takahiro Tsuchiya) 20 | > ## 21 | > library(survey) 22 | 23 | Attaching package: 'survey' 24 | 25 | The following object is masked from 'package:graphics': 26 | 27 | dotchart 28 | 29 | > data <- data.frame(x=c(1,1,1,1,2,2,2,2,2,2), w=rep(10,10)) 30 | > des <- svydesign(ids=~1, weights=~w, data=data) 31 | > des.c <- calibrate(des, ~factor(x), c(10000, 5000)) 32 | > des.r <- calibrate(des, ~factor(x), c(10000, 5000), calfun='raking') 33 | Loading required package: MASS 34 | > stopifnot(all.equal(svytotal(~factor(x), des.c), svytotal(~factor(x), des.r))) 35 | > 36 | > proc.time() 37 | user system elapsed 38 | 0.162 0.025 0.194 39 | -------------------------------------------------------------------------------- /tests/brewer_cpp.R: -------------------------------------------------------------------------------- 1 | ## pps="brewer" can't use rcpp 2 | ## this checks that it doesn't 3 | library(survey) 4 | data(election) 5 | 6 | dpps_br<- svydesign(id=~1, fpc=~p, data=election_pps, pps="brewer") 7 | options(survey.use_rcpp=TRUE) 8 | a<-svytotal(~Bush+Kerry+Nader, dpps_br) 9 | options(survey.use_rcpp=FALSE) 10 | b<-svytotal(~Bush+Kerry+Nader, dpps_br) 11 | 12 | stopifnot(identical(a,b)) 13 | -------------------------------------------------------------------------------- /tests/check.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | data(fpc) 3 | ## test various possibilities for svydesign 4 | a<-svydesign(weights=~weight, ids=~psuid, strata=~stratid, variables=~x, data=fpc, nest=TRUE) 5 | a 6 | svymean(~x,a) 7 | a<-svydesign(weights=~weight, ids=~0, strata=~stratid, variables=~x, data=fpc, nest=TRUE) 8 | a 9 | svymean(~x,a) 10 | a<-svydesign(weights=1, ids=~0, strata=~stratid, variables=~x, data=fpc, nest=TRUE) 11 | a 12 | svymean(~x,a) 13 | a<-svydesign(ids=~0, strata=~stratid, variables=~x, data=fpc, nest=TRUE) 14 | a 15 | svymean(~x,a) 16 | a<-svydesign(ids=~0, strata=~stratid, prob=~I(1/weight),variables=~x, data=fpc, nest=TRUE) 17 | a 18 | svymean(~x,a) 19 | a<-svydesign(ids=~psuid, strata=~stratid, variables=~x, data=fpc, nest=TRUE) 20 | a 21 | svymean(~x,a) 22 | a<-svydesign(ids=~psuid, variables=~x, data=fpc, nest=TRUE) 23 | a 24 | svymean(~x,a) 25 | a<-svydesign(ids=~psuid, weights=~weight, variables=~x, data=fpc, nest=TRUE) 26 | a 27 | svymean(~x,a) 28 | a<-svydesign(ids=~stratid+psuid, weights=~weight, variables=~x, data=fpc) 29 | a 30 | svymean(~x,a) 31 | a<-svydesign(ids=~stratid+psuid, variables=~x, data=fpc) 32 | a 33 | svymean(~x,a) 34 | a<-svydesign(weights=fpc$weight, ids=fpc$psuid, strata=fpc$stratid, variables=fpc[,"x",drop=FALSE], nest=TRUE) 35 | a 36 | svymean(~x,a) 37 | a<-svydesign(weights=fpc$weight, ids=fpc$psuid, strata=fpc$stratid, variables=fpc[,4:6], nest=TRUE) 38 | a 39 | svymean(~x,a) 40 | 41 | a<-svydesign(weights=fpc$weight, ids=fpc$psuid, variables=fpc[,4:6], fpc=rep(27,8)) 42 | a 43 | svymean(~x,a) 44 | 45 | a<-svydesign(weights=fpc$weight, ids=fpc$psuid, strata=fpc$stratid, nest=TRUE, variables=fpc[,4:6], fpc=fpc$Nh) 46 | a 47 | svymean(~x,a) 48 | -------------------------------------------------------------------------------- /tests/cigsw.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/tests/cigsw.rda -------------------------------------------------------------------------------- /tests/confintrep.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | data(api) 3 | dclus2<-svydesign(id=~dnum+snum, fpc=~fpc1+fpc2, data=apiclus2) 4 | rclus2<-as.svrepdesign(dclus2) 5 | 6 | m<-svyglm(I(comp.imp=="Yes")~1, design=dclus2, family=quasibinomial) 7 | if(anyNA(confint(m, method="likelihood"))) stop("NA in confint") 8 | mrep<-svyglm(I(comp.imp=="Yes")~1, design=rclus2, family=quasibinomial) 9 | if(anyNA(confint(mrep))) stop("NA in confint") 10 | if(anyNA(confint(mrep, method="likelihood"))) stop("NA in confint") -------------------------------------------------------------------------------- /tests/contrast-replicates.R: -------------------------------------------------------------------------------- 1 | ## test use of replicates in svyby, svycontrast 2 | library(survey) 3 | 4 | data(api) 5 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 6 | rclus1<-as.svrepdesign(dclus1) 7 | 8 | meanlogs_without<-svyby(~log(enroll),~stype,svymean, design=rclus1,covmat=TRUE) 9 | c_without<-svycontrast(meanlogs_without, quote(exp(E-H))) 10 | vcov(c_without) 11 | 12 | meanlogs_with<-svyby(~log(enroll),~stype,svymean, design=rclus1,covmat=TRUE,return.replicates=TRUE) 13 | 14 | c_with<-svycontrast(meanlogs_with, quote(exp(E-H))) 15 | 16 | v_with<- vcov(rclus1, c_with$replicates) 17 | 18 | r<- attr(meanlogs_with, "replicates") 19 | vr_with<-vcov(rclus1,exp(r[,1]-r[,2])) 20 | 21 | stopifnot(all.equal(as.numeric(v_with),as.numeric(vr_with))) 22 | stopifnot(all.equal(as.numeric(v_with),as.numeric(vcov(c_with)))) 23 | -------------------------------------------------------------------------------- /tests/coxph-termtest.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | library(survival) 3 | set.seed(2021-6-25) 4 | test1 <- list(time=c(4,3,1,1,2,2,3), 5 | status=c(1,1,1,0,1,1,0), 6 | x1=as.factor(rbinom(7, 2, 0.5)), 7 | x=c(0,2,1,1,1,0,0)) 8 | # Fit a stratified model 9 | mod_c <- coxph(Surv(time, status) ~ x1 + x, test1) 10 | mod_d <- coxph(Surv(time, status) ~ x + x1, test1) 11 | stopifnot(all.equal(regTermTest(mod_c, ~x1, df = Inf)[c("chisq","df","test.terms","p")], 12 | regTermTest(mod_d, ~x1, df = Inf)[c("chisq","df","test.terms","p")])) 13 | 14 | data(pbc, package="survival") 15 | 16 | pbc$randomized<-with(pbc, !is.na(trt) & trt>0) 17 | biasmodel<-glm(randomized~age*edema,data=pbc,family=binomial) 18 | pbc$randprob<-fitted(biasmodel) 19 | if (is.null(pbc$albumin)) pbc$albumin<-pbc$alb ##pre2.9.0 20 | 21 | dpbc<-svydesign(id=~1, prob=~randprob, strata=~edema, data=subset(pbc,randomized)) 22 | library(splines) 23 | model<-svycoxph(formula = Surv(time, status > 0) ~ bili + protime + albumin+ns(bili,4)[,1:3], design = dpbc) 24 | test<-regTermTest(model, ~ns(bili,4)[,1:3],method="LRT") 25 | stopifnot(all.equal(test$chisq, 47.314, tolerance=1e-4)) 26 | stopifnot(all.equal(test$lambda, c(1.4764260, 1.0109836, 0.6923415),tolerance=1e-4)) 27 | -------------------------------------------------------------------------------- /tests/datos_ejemplo.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/tests/datos_ejemplo.rds -------------------------------------------------------------------------------- /tests/deff.R: -------------------------------------------------------------------------------- 1 | ## from Takahiro Tsuchiya 2 | library(survey) 3 | kigyo<-read.table(tmp<-textConnection(" obs uriage srs.w pps.w 4 | 1 1 15 100 20 5 | 2 2 143 100 200 6 | 3 3 21 100 11 7 | 4 4 51 100 25 8 | 5 5 337 100 550 9 | 6 6 50 100 30 10 | 7 7 274 100 250 11 | 8 8 145 100 100 12 | 9 9 15 100 10 13 | 10 10 86 100 55 14 | ",open="r"),header=TRUE) 15 | close(tmp) 16 | des.srs <- svydesign(ids=~1, weights=~srs.w, data=kigyo) 17 | (res.srs <- svymean(~uriage, des.srs, deff=TRUE)) 18 | (SE(res.srs)^2) / ((1-10/1000) * coef(svyvar(~uriage, des.srs)) / 10) 19 | 20 | (tres.srs <- svytotal(~uriage, des.srs, deff=TRUE)) 21 | (SE(tres.srs)^2) / (1000^2 * (1-10/1000) * coef(svyvar(~uriage, des.srs)) / 10) 22 | 23 | 24 | des.pps <- svydesign(ids=~1, weights=~pps.w, data=kigyo) 25 | (res.pps <- svymean(~uriage, des.pps, deff='replace')) 26 | (SE(res.pps)^2) / (coef(svyvar(~uriage, des.pps)) / 10) 27 | (tres.pps <- svytotal(~uriage, des.pps, deff='replace')) 28 | (N.hat <- sum(weights(des.pps))) 29 | (SE(tres.pps)^2) / (N.hat^2 * coef(svyvar(~uriage, des.pps)) / 10) 30 | -------------------------------------------------------------------------------- /tests/deff.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 3.1.0 (2014-04-10) -- "Spring Dance" 3 | Copyright (C) 2014 The R Foundation for Statistical Computing 4 | Platform: x86_64-apple-darwin13.1.0 (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > ## from Takahiro Tsuchiya 19 | > library(survey) 20 | 21 | Attaching package: 'survey' 22 | 23 | The following object is masked from 'package:graphics': 24 | 25 | dotchart 26 | 27 | > kigyo<-read.table(tmp<-textConnection(" obs uriage srs.w pps.w 28 | + 1 1 15 100 20 29 | + 2 2 143 100 200 30 | + 3 3 21 100 11 31 | + 4 4 51 100 25 32 | + 5 5 337 100 550 33 | + 6 6 50 100 30 34 | + 7 7 274 100 250 35 | + 8 8 145 100 100 36 | + 9 9 15 100 10 37 | + 10 10 86 100 55 38 | + ",open="r"),header=TRUE) 39 | > close(tmp) 40 | > des.srs <- svydesign(ids=~1, weights=~srs.w, data=kigyo) 41 | > (res.srs <- svymean(~uriage, des.srs, deff=TRUE)) 42 | mean SE DEff 43 | uriage 113.700 35.626 1.0101 44 | > (SE(res.srs)^2) / ((1-10/1000) * coef(svyvar(~uriage, des.srs)) / 10) 45 | uriage 46 | uriage 1.010101 47 | > 48 | > (tres.srs <- svytotal(~uriage, des.srs, deff=TRUE)) 49 | total SE DEff 50 | uriage 113700 35626 1.0101 51 | > (SE(tres.srs)^2) / (1000^2 * (1-10/1000) * coef(svyvar(~uriage, des.srs)) / 10) 52 | uriage 53 | uriage 1.010101 54 | > 55 | > 56 | > des.pps <- svydesign(ids=~1, weights=~pps.w, data=kigyo) 57 | > (res.pps <- svymean(~uriage, des.pps, deff='replace')) 58 | mean SE DEff 59 | uriage 243.914 48.752 1.9741 60 | > (SE(res.pps)^2) / (coef(svyvar(~uriage, des.pps)) / 10) 61 | uriage 62 | uriage 1.974067 63 | > (tres.pps <- svytotal(~uriage, des.pps, deff='replace')) 64 | total SE DEff 65 | uriage 305136 184965 18.157 66 | > (N.hat <- sum(weights(des.pps))) 67 | [1] 1251 68 | > (SE(tres.pps)^2) / (N.hat^2 * coef(svyvar(~uriage, des.pps)) / 10) 69 | uriage 70 | uriage 18.15669 71 | > 72 | > proc.time() 73 | user system elapsed 74 | 0.163 0.021 0.189 75 | -------------------------------------------------------------------------------- /tests/defftest.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | 3 | data(api) 4 | 5 | ## one-stage cluster sample 6 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 7 | 8 | # svyglm model 9 | mod <- svyglm(api99 ~ enroll + api.stu, design = dclus1, deff = TRUE) 10 | 11 | #deffs returned from svyglm model - implausibly high 12 | deff(mod) 13 | #> (Intercept) enroll api.stu 14 | #> 351.3500 457.6799 491.5567 15 | 16 | # run mod with same data and glm() 17 | srs_mod <- glm(api99 ~ enroll + api.stu, data = apiclus1) 18 | 19 | # manually calculate deffs 20 | 21 | clust_se <- summary(mod)$coefficients[,2] 22 | srs_se <- summary(srs_mod)$coefficients[,2] 23 | 24 | deffs <- clust_se^2 / srs_se^2 25 | stopifnot(all.equal(deffs, deff(mod))) 26 | 27 | -------------------------------------------------------------------------------- /tests/degf-svrepdesign.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | data(scd) 3 | 4 | repweights<-2*cbind(c(1,0,1,0,1,0), c(1,0,0,1,0,1), c(0,1,1,0,0,1), 5 | c(0,1,0,1,1,0)) 6 | scdrep<-svrepdesign(data=scd, type="BRR", repweights=repweights) 7 | 8 | stopifnot(degf(scdrep)==3) 9 | 10 | scdrep<-svrepdesign(data=scd, type="BRR", repweights=repweights, degf=4) 11 | stopifnot(degf(scdrep)==4) 12 | 13 | scdrep<-svrepdesign(data=scd, type="BRR", repweights=repweights, degf=2) 14 | stopifnot(degf(scdrep)==2) 15 | 16 | msg<-tryCatch(scdrep<-svrepdesign(data=scd, type="BRR",weights=~I(1000+0*ESA), repweights=repweights, combined.weights=FALSE,degf=10), 17 | warning=function(w) w) 18 | 19 | stopifnot(inherits(msg,"warning")) 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /tests/fpc.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | ## check many permutations of fpc specification 3 | example(fpc) 4 | 5 | -------------------------------------------------------------------------------- /tests/glm-scoping.R: -------------------------------------------------------------------------------- 1 | ## bug report from Thomas Leeper, fixed in version 3.32-3 2 | 3 | library("survey") 4 | data(api) 5 | dstrat<-svydesign(id=~1,strata=~stype, weights=~pw, data=apistrat, fpc=~fpc) 6 | 7 | # pass `family` directly (WORKS!) 8 | svyglm(api00~ell+meals+mobility, design=dstrat, family = gaussian()) 9 | 10 | # passing `family` via ... (WORKS!) 11 | myfun1 <- function(formula, design, ...) { 12 | svyglm(formula, design = design, ...) 13 | } 14 | myfun1(api00~ell+meals+mobility, design=dstrat, family = gaussian()) 15 | 16 | # passing `family` via default argument (DOES NOT WORK!) 17 | myfun2 <- function(formula, design, family = gaussian()) { 18 | svyglm(formula, design = design, family = family) 19 | } 20 | myfun2(api00~ell+meals+mobility, design=dstrat, family = gaussian()) 21 | -------------------------------------------------------------------------------- /tests/kalton.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | 3 | ab<-expand.grid(a=factor(1:4),b=factor(1:3)) 4 | 5 | kaltonsample<-ab[rep(1:12,c(20,50,100,30,40,140,50,100,40,310,50,70)),] 6 | 7 | kaltonpop<-ab[rep(1:12,c(80,60,170,55,40,150,60,165,55,340,200,125)),] 8 | 9 | jointpop<-colSums(model.matrix(~a*b,kaltonpop)) 10 | marginalpop<-colSums(model.matrix(~a+b,kaltonpop)) 11 | gregpop<-colSums(model.matrix(~as.numeric(a)+as.numeric(b),kaltonpop)) 12 | 13 | dkalton<-svydesign(id=~1,data=kaltonsample) 14 | 15 | dps<-postStratify(dkalton,~a+b,xtabs(~a+b,kaltonpop)) 16 | 17 | drake<-rake(dkalton, list(~a,~b),list(xtabs(~a,kaltonpop),xtabs(~b,kaltonpop)),control=list(epsilon=0.0001)) 18 | 19 | dcalps<-calibrate(dkalton, ~a*b, jointpop) 20 | dcalrake<-calibrate(dkalton,~a+b, marginalpop, calfun="raking") 21 | dlinear<-calibrate(dkalton, ~a+b, marginalpop) 22 | 23 | dtrunclinear<-calibrate(dkalton, ~a+b, marginalpop,bounds=c(0.5,2.2)) 24 | 25 | dlogit<-calibrate(dkalton, ~a+b, marginalpop,bounds=c(0.5,2.2),calfun="logit") 26 | 27 | dgreg<-calibrate(dkalton,~as.numeric(a)+as.numeric(b), gregpop) 28 | 29 | 30 | #table A 31 | round(svytable(~a+b,dps)/xtabs(~a+b,kaltonsample),2) 32 | round(svytable(~a+b,dcalps)/xtabs(~a+b,kaltonsample),2) 33 | 34 | #table B 35 | round(svytable(~a+b,drake)/xtabs(~a+b,kaltonsample),2) 36 | round(svytable(~a+b,dcalrake)/xtabs(~a+b,kaltonsample),2) 37 | 38 | #table C 39 | round(svytable(~a+b,dlinear)/xtabs(~a+b,kaltonsample),2) 40 | 41 | #table D 42 | round(svytable(~a+b,dgreg)/xtabs(~a+b,kaltonsample),2) 43 | 44 | #table G 45 | round(svytable(~a+b,dlogit)/xtabs(~a+b,kaltonsample),2) 46 | 47 | #table G 48 | round(svytable(~a+b,dtrunclinear)/xtabs(~a+b,kaltonsample),2) 49 | -------------------------------------------------------------------------------- /tests/mtcars-var.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | 3 | # don't throw an error on domains of size 1, just return NA 4 | input <- mtcars 5 | input$carb <- factor(input$carb) 6 | design <- svydesign(ids = ~0, weights = NULL, data = input) 7 | svyby( 8 | ~mpg, 9 | ~carb, 10 | design, 11 | svyvar 12 | ) 13 | 14 | 15 | ## same n with na.rm=TRUE as subset(, !is.na) 16 | input$mpg[1]<-NA 17 | design <- svydesign(ids = ~0, weights = NULL, data = input) 18 | stopifnot(all.equal(svyvar(~mpg, design, na.rm=TRUE), 19 | svyvar(~mpg, subset(design, !is.na(mpg))))) 20 | -------------------------------------------------------------------------------- /tests/multistage.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Check that multistage samples still work 3 | ## 4 | library(survey) 5 | example(mu284) 6 | 7 | -------------------------------------------------------------------------------- /tests/na_action.R: -------------------------------------------------------------------------------- 1 | ## from Terry Therneau 2 | library(survey) 3 | load("naa.rda") 4 | 5 | fit1e <- svyglm( pseudo ~ age34 + ccr5 + factor(times), design= adata.s,na.action=na.exclude) 6 | fit1o <- svyglm( pseudo ~ age34 + ccr5 + factor(times), design= adata.s) 7 | all.equal(coef(fit1e),coef(fit1o)) 8 | all.equal(vcov(fit1e),vcov(fit1o)) 9 | -------------------------------------------------------------------------------- /tests/naa.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/tests/naa.rda -------------------------------------------------------------------------------- /tests/newquantile.R: -------------------------------------------------------------------------------- 1 | ## quantiles with equal weights 2 | 3 | library(survey) 4 | data(api) 5 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 6 | 7 | 8 | for(i in 1:9){ 9 | print(i) 10 | all.equal( 11 | as.vector(coef(svyquantile(~ell, dclus1, c(0.2,0.5,0.9), qrule=paste0("hf",i)))), 12 | as.vector(quantile(apiclus1$ell, c(0.2,0.5,0.9), type=i)) 13 | ) 14 | 15 | } 16 | -------------------------------------------------------------------------------- /tests/nwtco-subcohort.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/tests/nwtco-subcohort.rda -------------------------------------------------------------------------------- /tests/nwts-cch.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | library(survival) 3 | data(nwtco) 4 | 5 | ntwco<-subset(nwtco, !is.na(edrel)) 6 | 7 | load("nwtco-subcohort.rda") 8 | nwtco$subcohort<-subcohort 9 | 10 | d_BorganII <- twophase(id=list(~seqno,~seqno), 11 | strata=list(NULL,~interaction(instit,rel)), 12 | data=nwtco, subset=~I(rel |subcohort)) 13 | 14 | ##Coefficient results same as Splus with code from 15 | ## http://faculty.washington.edu/norm/software.html 16 | ## SE slightly larger due to using sandwich variance. 17 | 18 | svycoxph(Surv(edrel, rel)~factor(stage)+factor(histol)+I(age/12), design=d_BorganII) 19 | 20 | ## 21 | ## This gives higher standard errors. calibrate() does not recompute the 22 | ## finite population correction if a calibration variable happens to predict 23 | ## sampling perfectly. It probably should. 24 | ## 25 | d_BorganIIps<-calibrate(twophase(id=list(~seqno,~seqno), 26 | strata=list(NULL,~rel), 27 | data=nwtco, subset=~I(rel |subcohort)), 28 | phase=2, formula=~interaction(instit,rel), 29 | epsilon=1e-10) 30 | 31 | svycoxph(Surv(edrel, rel)~factor(stage)+factor(histol)+I(age/12), design=d_BorganIIps) 32 | -------------------------------------------------------------------------------- /tests/nwts.R: -------------------------------------------------------------------------------- 1 | 2 | ## examples from Breslow & Chatterjee: Applied Statistics 1999 No. 4, p458 3 | ## data from Norman Breslow's web page. 4 | library(survey) 5 | load("nwts.rda") 6 | nwtsnb<-nwts 7 | nwtsnb$case<-nwts$case-nwtsb$case 8 | nwtsnb$control<-nwts$control-nwtsb$control 9 | 10 | a<-rbind(nwtsb,nwtsnb) 11 | a$in.ccs<-rep(c(TRUE,FALSE),each=16) 12 | 13 | b<-rbind(a,a) 14 | b$rel<-rep(c(1,0),each=32) 15 | b$n<-ifelse(b$rel,b$case,b$control) 16 | 17 | index<-rep(1:64,b$n) 18 | 19 | nwt.exp<-b[index,c(1:3,6,7)] 20 | nwt.exp$id<-1:4088 21 | 22 | dccs2<-twophase(id=list(~id,~id),subset=~in.ccs, 23 | strata=list(NULL,~interaction(instit,rel)),data=nwt.exp) 24 | 25 | dccs8<-twophase(id=list(~id,~id),subset=~in.ccs, 26 | strata=list(NULL,~interaction(instit,stage,rel)),data=nwt.exp) 27 | 28 | gccs8<-calibrate(dccs2,phase=2,formula=~interaction(instit,stage,rel)) 29 | 30 | summary(svyglm(rel~factor(stage)*factor(histol),family=quasibinomial,design=dccs2)) 31 | summary(svyglm(rel~factor(stage)*factor(histol),family=quasibinomial,design=dccs8)) 32 | summary(svyglm(rel~factor(stage)*factor(histol),family=quasibinomial,design=gccs8)) 33 | 34 | ## check subsets of calibrated designs. 35 | summary(svyglm(rel~factor(stage), 36 | family=quasibinomial,design=subset(dccs8,histol==1))) 37 | summary(svyglm(rel~factor(stage), 38 | family=quasibinomial,design=subset(gccs8,histol==1))) 39 | 40 | -------------------------------------------------------------------------------- /tests/nwts.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/tests/nwts.rda -------------------------------------------------------------------------------- /tests/poisson.R: -------------------------------------------------------------------------------- 1 | ## check poisson sampling 2 | library(survey) 3 | data(api) 4 | set.seed(2021-7-15) 5 | apipop$prob<-apipop$api00/1000 6 | insample<-rbinom(nrow(apipop),1,apipop$prob) 7 | apipois<-apipop[insample,] 8 | des<-svydesign(id=~1, prob=~prob, pps=poisson_sampling(apipois$prob), data=apipois) 9 | 10 | stopifnot(isTRUE(all.equal( 11 | as.vector(SE(svytotal(~api00,design=des))), 12 | as.vector(sqrt(sum( (apipois$api00*weights(des))^2*(1-apipois$prob)))) 13 | ))) 14 | -------------------------------------------------------------------------------- /tests/pps.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | data(election) 3 | 4 | dpps<- svydesign(id=~1, weights=~wt, fpc=~p, data=election_pps, pps="brewer") 5 | dppswr <-svydesign(id=~1, weights=~wt, data=election_pps) 6 | svytotal(~Bush+Kerry+Nader, dpps) 7 | svytotal(~Bush+Kerry+Nader, dppswr) 8 | 9 | ##subsets 10 | svytotal(~Bush+Kerry+Nader, subset(dpps, Nader>0)) 11 | 12 | ##multistage: should agree with STRS analysis 13 | data(api) 14 | dclus2<-svydesign(id = ~dnum + snum, fpc = ~fpc1 + fpc2, data = apiclus2) 15 | dclus2pps<-svydesign(id = ~dnum + snum, fpc = ~I(40/fpc1) + I(pmin(1,5/fpc2)), data = apiclus2) 16 | 17 | all.equal(svytotal(~sch.wide,dclus2), svytotal(~sch.wide,dclus2pps)) 18 | all.equal(svymean(~sch.wide,dclus2), svymean(~sch.wide,dclus2pps)) 19 | all.equal(svytotal(~enroll,dclus2), svytotal(~enroll,dclus2pps)) 20 | 21 | ## the new without-replacement methods 22 | data(election) 23 | dpps_br<- svydesign(id=~1, fpc=~p, data=election_pps, pps="brewer") 24 | dpps_ov<- svydesign(id=~1, fpc=~p, data=election_pps, pps="overton") 25 | dpps_hr<- svydesign(id=~1, fpc=~p, data=election_pps, pps=HR(sum(election$p^2)/40)) 26 | dpps_hr1<- svydesign(id=~1, fpc=~p, data=election_pps, pps=HR()) 27 | dpps_ht<- svydesign(id=~1, fpc=~p, data=election_pps, pps=ppsmat(election_jointprob)) 28 | ## Yates-Grundy type 29 | dpps_yg<- svydesign(id=~1, fpc=~p, data=election_pps, pps=ppsmat(election_jointprob),variance="YG") 30 | dpps_hryg<- svydesign(id=~1, fpc=~p, data=election_pps, pps=HR(sum(election$p^2)/40),variance="YG") 31 | 32 | ## The with-replacement approximation 33 | svytotal(~Bush+Kerry+Nader, dpps_ht) 34 | svytotal(~Bush+Kerry+Nader, dpps_yg) 35 | svytotal(~Bush+Kerry+Nader, dpps_hr) 36 | svytotal(~Bush+Kerry+Nader, dpps_hryg) 37 | svytotal(~Bush+Kerry+Nader, dpps_hr1) 38 | svytotal(~Bush+Kerry+Nader, dpps_br) 39 | svytotal(~Bush+Kerry+Nader, dpps_ov) 40 | 41 | ## subsets 42 | svytotal(~Bush+Kerry+Nader, subset(dpps_ht, Nader>0)) 43 | svytotal(~Bush+Kerry+Nader, subset(dpps_hryg, Nader>0)) 44 | 45 | ## counts 46 | svyby(~Bush+Kerry+Nader,~I(Nader>0), unwtd.count,design=dpps_ht) 47 | -------------------------------------------------------------------------------- /tests/qrule-swiss.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | 3 | data_no_strat <- data.frame(x = 1:10, id = 1:10, fpc = 10, probs = 1) 4 | 5 | design_no_strat <- svydesign(id = ~id, 6 | probs = ~probs, 7 | data = data_no_strat, 8 | fpc = ~fpc) 9 | 10 | quantiles <- c(0.01, 0.05, 0.1, 0.15, seq(21, 81, 10)*0.01, 0.85, 0.9, 0.95, 0.99) 11 | 12 | res <- svyquantile(~x, design_no_strat, quantiles, ci = TRUE, 13 | interval.type = "mean", qrule = "hf1") 14 | 15 | stopifnot(all(diff(res$x[,"quantile"])>=0)) 16 | 17 | 18 | -------------------------------------------------------------------------------- /tests/quantile.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | set.seed(42) 3 | 4 | df<-data.frame(x=exp(rnorm(1000))) 5 | df$y<-round(df$x,1) 6 | ddf<-svydesign(id=~1,data=df) 7 | rdf<-as.svrepdesign(ddf) 8 | 9 | SE(oldsvyquantile(~x,ddf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE)) 10 | 11 | SE(oldsvyquantile(~x,rdf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE)) 12 | 13 | SE(oldsvyquantile(~x,ddf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE,df=Inf)) 14 | 15 | SE(oldsvyquantile(~x,rdf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE,df=Inf)) 16 | 17 | 18 | oldsvyquantile(~y,ddf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE,ties="rounded",interval.type="betaWald") 19 | 20 | oldsvyquantile(~y,rdf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE) 21 | 22 | oldsvyquantile(~y,ddf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE,ties="rounded",interval.type="betaWald",df=Inf) 23 | 24 | oldsvyquantile(~y,rdf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE, df=Inf) 25 | 26 | 27 | 28 | df<-data.frame(x=exp(rnorm(20))) 29 | df$y<-round(df$x,1) 30 | ddf<-svydesign(id=~1,data=df) 31 | rdf<-as.svrepdesign(ddf) 32 | SE(oldsvyquantile(~x,ddf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE)) 33 | 34 | SE(oldsvyquantile(~x,rdf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE)) 35 | 36 | SE(oldsvyquantile(~x,ddf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE,df=Inf)) 37 | 38 | SE(oldsvyquantile(~x,rdf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE,df=Inf)) 39 | 40 | 41 | oldsvyquantile(~y,ddf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE,ties="rounded",interval.type="betaWald") 42 | 43 | oldsvyquantile(~y,rdf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE) 44 | 45 | oldsvyquantile(~y,ddf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE,ties="rounded",interval.type="betaWald",df=Inf) 46 | 47 | oldsvyquantile(~y,rdf, c(0.01,0.1,0.5,0.9,0.99),ci=TRUE, df=Inf) 48 | -------------------------------------------------------------------------------- /tests/quantiles-chile.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | datos <- readRDS("datos_ejemplo.rds") 3 | 4 | design <- svydesign(id = ~id_directorio, strata = ~estrato, weights = ~f_pers, check.strata = TRUE, data = datos) 5 | set.seed(234262762) 6 | repdesign <- as.svrepdesign(design, type = "subbootstrap", replicates=20) 7 | options(survey.lonely.psu="remove") 8 | 9 | values<-datos$ing_t_p[datos$CL_GRUPO_OCU_08=="ISCO08_6"] 10 | 11 | suppressWarnings({ 12 | f0<-coef(svyquantile(~ing_t_p, subset(design,CL_GRUPO_OCU_08=="ISCO08_6"),quantiles=c(0.5), qrule="math")) 13 | f0.5<-coef(svyquantile(~ing_t_p, subset(design,CL_GRUPO_OCU_08=="ISCO08_6"),quantiles=c(0.5), qrule="school")) 14 | }) 15 | all.equal(c(values[1],mean(values)), as.vector(c(f0,f0.5))) 16 | 17 | suppressWarnings({ 18 | f0<-coef(svyquantile(~ing_t_p, subset(repdesign,CL_GRUPO_OCU_08=="ISCO08_6"),quantiles=c(0.5), qrule="math")) 19 | f0.5<-coef(svyquantile(~ing_t_p, subset(repdesign,CL_GRUPO_OCU_08=="ISCO08_6"),quantiles=c(0.5), qrule="school")) 20 | }) 21 | all.equal(c(values[1],mean(values)), as.vector(c(f0,f0.5))) 22 | -------------------------------------------------------------------------------- /tests/rakecheck.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | 3 | data(api) 4 | dclus1 <- svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 5 | rclus1 <- as.svrepdesign(dclus1) 6 | 7 | ## population marginal totals for each stratum 8 | pop.types <- data.frame(stype=c("E","H","M"), Freq=c(4421,755,1018)) 9 | pop.schwide <- data.frame(sch.wide=c("No","Yes"), Freq=c(1072,5122)) 10 | 11 | rclus1r <- rake(rclus1, list(~stype,~sch.wide), list(pop.types, pop.schwide)) 12 | 13 | svymean(~api00, rclus1r) 14 | svytotal(~enroll, rclus1r) 15 | 16 | ff<-~stype+sch.wide 17 | poptotals<-colSums(model.matrix(ff,model.frame(ff,apipop))) 18 | rclus1g<-calibrate(rclus1, ~stype+sch.wide, poptotals,calfun="raking") 19 | 20 | svymean(~api00,rclus1g) 21 | svytotal(~enroll,rclus1g) 22 | 23 | summary(weights(rclus1g)/weights(rclus1r)) 24 | 25 | 26 | ## Do it for a design without replicate weights 27 | dclus1r<-rake(dclus1, list(~stype,~sch.wide), list(pop.types, pop.schwide)) 28 | 29 | svymean(~api00, dclus1r) 30 | svytotal(~enroll, dclus1r) 31 | 32 | dclus1g<-calibrate(dclus1, ~stype+sch.wide, poptotals,calfun="raking") 33 | 34 | svymean(~api00,dclus1g) 35 | svytotal(~enroll,dclus1g) 36 | 37 | summary(weights(dclus1g)/weights(dclus1r)) 38 | 39 | 40 | 41 | ## Example of raking with partial joint distributions 42 | pop.table <- xtabs(~stype+sch.wide,apipop) 43 | pop.imp<-data.frame(comp.imp=c("No","Yes"),Freq=c(1712,4482)) 44 | dclus1r2<-rake(dclus1, list(~stype+sch.wide, ~comp.imp), 45 | list(pop.table, pop.imp)) 46 | svymean(~api00, dclus1r2) 47 | 48 | ff1 <-~stype*sch.wide+comp.imp 49 | 50 | poptotals1<-colSums(model.matrix(ff1,model.frame(ff1,apipop))) 51 | dclus1g2<-calibrate(dclus1, ~stype*sch.wide+comp.imp, poptotals1, calfun="raking") 52 | 53 | svymean(~api00, dclus1g2) 54 | 55 | summary(weights(dclus1r2)/weights(dclus1g2)) 56 | -------------------------------------------------------------------------------- /tests/raowuboot.R: -------------------------------------------------------------------------------- 1 | ## regression test for bug reported by Richard Valliant 2 | library(survey) 3 | s<-subbootweights(c(1,1),1:2, 50) 4 | stopifnot(all(s$repweights$weights %in% c(0,2))) 5 | -------------------------------------------------------------------------------- /tests/raowuboot.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 3.1.0 (2014-04-10) -- "Spring Dance" 3 | Copyright (C) 2014 The R Foundation for Statistical Computing 4 | Platform: x86_64-apple-darwin13.1.0 (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > ## regression test for bug reported by Richard Valliant 19 | > library(survey) 20 | 21 | Attaching package: 'survey' 22 | 23 | The following object is masked from 'package:graphics': 24 | 25 | dotchart 26 | 27 | > s<-subbootweights(c(1,1),1:2, 50) 28 | > stopifnot(all(s$repweights$weights %in% c(0,2))) 29 | > 30 | > proc.time() 31 | user system elapsed 32 | 0.140 0.021 0.165 33 | -------------------------------------------------------------------------------- /tests/regTermTest-missing.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | data(nhanes) 3 | design <- svydesign(id=~SDMVPSU, strata=~SDMVSTRA, weights=~WTMEC2YR, nest=TRUE,data=nhanes) 4 | 5 | a<-svyglm(formula = I(race == 1) ~ HI_CHOL + agecat + RIAGENDR, design = subset(design,!is.na(HI_CHOL)), family=quasibinomial) 6 | b<-svyglm(formula = I(race == 1) ~ HI_CHOL + agecat + RIAGENDR, design =design , family=quasibinomial) 7 | 8 | ta<-regTermTest(a, ~HI_CHOL) 9 | tb<-regTermTest(b, ~HI_CHOL) 10 | 11 | stopifnot(isTRUE(all.equal(ta$chisq, tb$chisq))) 12 | stopifnot(isTRUE(all.equal(ta$lambda, tb$lambda))) 13 | -------------------------------------------------------------------------------- /tests/regpredict.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | data(api) 3 | dstrat<-svydesign(id=~1,strata=~stype, weights=~pw, data=apistrat, fpc=~fpc) 4 | 5 | 6 | ## regression estimator of total, three ways 7 | pop<-data.frame(enroll=sum(apipop$enroll, na.rm=TRUE)) 8 | npop <- sum(!is.na(apipop$enroll)) 9 | 10 | api.reg <- svyglm(api.stu~enroll, design=dstrat) 11 | a <- predict(api.reg, newdata=pop, total=npop) 12 | b <- svytotal(~api.stu, calibrate(dstrat, ~enroll, pop=c(npop, pop$enroll))) 13 | 14 | all.equal(as.vector(coef(a)),as.vector(coef(b))) 15 | all.equal(as.vector(SE(a)), as.vector(SE(b))) 16 | if(!is.null(getOption("DEBUG"))){ ## uses 6194x6194 matrix 17 | d <- predict(api.reg, newdata=na.omit(apipop[,"enroll",drop=FALSE])) 18 | all.equal(as.vector(coef(a)), as.vector(sum(coef(d)))) 19 | all.equal(as.vector(SE(a)), as.vector(sqrt(sum(vcov(d))))) 20 | } 21 | 22 | ## classical ratio estimator, four ways. 23 | api.reg2 <- svyglm(api.stu~enroll-1, design=dstrat, 24 | family=quasi(link="identity", var="mu")) 25 | 26 | a <- predict(api.reg2, newdata=pop, total=npop) 27 | b <- svytotal(~api.stu, 28 | calibrate(dstrat, ~enroll-1, pop= pop$enroll, variance=2)) 29 | e <- predict(svyratio(~api.stu, ~enroll, dstrat),total=pop$enroll) 30 | 31 | all.equal(as.vector(coef(a)),as.vector(coef(b))) 32 | all.equal(as.vector(SE(a)), as.vector(SE(b))) 33 | all.equal(as.vector(coef(a)),as.vector(e$total)) 34 | all.equal(as.vector(SE(a)), as.vector(e$se)) 35 | if(!is.null(getOption("DEBUG"))){## uses 6194x6194 matrix 36 | d <- predict(api.reg2, newdata=na.omit(apipop[,"enroll",drop=FALSE])) 37 | all.equal(as.vector(coef(a)), as.vector(sum(coef(d)))) 38 | all.equal(as.vector(SE(a)), as.vector(sqrt(sum(vcov(d))))) 39 | } 40 | -------------------------------------------------------------------------------- /tests/regpredict.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 3.1.0 (2014-04-10) -- "Spring Dance" 3 | Copyright (C) 2014 The R Foundation for Statistical Computing 4 | Platform: x86_64-apple-darwin13.1.0 (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > library(survey) 19 | 20 | Attaching package: 'survey' 21 | 22 | The following object is masked from 'package:graphics': 23 | 24 | dotchart 25 | 26 | > data(api) 27 | > dstrat<-svydesign(id=~1,strata=~stype, weights=~pw, data=apistrat, fpc=~fpc) 28 | > 29 | > 30 | > ## regression estimator of total, three ways 31 | > pop<-data.frame(enroll=sum(apipop$enroll, na.rm=TRUE)) 32 | > npop <- sum(!is.na(apipop$enroll)) 33 | > 34 | > api.reg <- svyglm(api.stu~enroll, design=dstrat) 35 | > a <- predict(api.reg, newdata=pop, total=npop) 36 | > b <- svytotal(~api.stu, calibrate(dstrat, ~enroll, pop=c(npop, pop$enroll))) 37 | > 38 | > all.equal(as.vector(coef(a)),as.vector(coef(b))) 39 | [1] TRUE 40 | > all.equal(as.vector(SE(a)), as.vector(SE(b))) 41 | [1] TRUE 42 | > if(!is.null(getOption("DEBUG"))){ ## uses 6194x6194 matrix 43 | + d <- predict(api.reg, newdata=na.omit(apipop[,"enroll",drop=FALSE])) 44 | + all.equal(as.vector(coef(a)), as.vector(sum(coef(d)))) 45 | + all.equal(as.vector(SE(a)), as.vector(sqrt(sum(vcov(d))))) 46 | + } 47 | > 48 | > ## classical ratio estimator, four ways. 49 | > api.reg2 <- svyglm(api.stu~enroll-1, design=dstrat, 50 | + family=quasi(link="identity", var="mu")) 51 | > 52 | > a <- predict(api.reg2, newdata=pop, total=npop) 53 | > b <- svytotal(~api.stu, 54 | + calibrate(dstrat, ~enroll-1, pop= pop$enroll, variance=2)) 55 | > e <- predict(svyratio(~api.stu, ~enroll, dstrat),total=pop$enroll) 56 | > 57 | > all.equal(as.vector(coef(a)),as.vector(coef(b))) 58 | [1] TRUE 59 | > all.equal(as.vector(SE(a)), as.vector(SE(b))) 60 | [1] TRUE 61 | > all.equal(as.vector(coef(a)),as.vector(e$total)) 62 | [1] TRUE 63 | > all.equal(as.vector(SE(a)), as.vector(e$se)) 64 | [1] TRUE 65 | > if(!is.null(getOption("DEBUG"))){## uses 6194x6194 matrix 66 | + d <- predict(api.reg2, newdata=na.omit(apipop[,"enroll",drop=FALSE])) 67 | + all.equal(as.vector(coef(a)), as.vector(sum(coef(d)))) 68 | + all.equal(as.vector(SE(a)), as.vector(sqrt(sum(vcov(d))))) 69 | + } 70 | > 71 | > proc.time() 72 | user system elapsed 73 | 0.239 0.026 0.272 74 | -------------------------------------------------------------------------------- /tests/rss_scores.R: -------------------------------------------------------------------------------- 1 | ## Example from Rao, Scott, and Skinner 1998 Statistica Sinica 2 | library(survey) 3 | data(myco) 4 | dmyco<-svydesign(id=~1, strata=~interaction(Age,leprosy),weights=~wt,data=myco) 5 | m_full<-svyglm(leprosy~I((Age+7.5)^-2)+Scar, family=quasibinomial, design=dmyco) 6 | m_null<-svyglm(leprosy~I((Age+7.5)^-2), family=quasibinomial, design=dmyco) 7 | 8 | stopifnot(isTRUE(all.equal(coef(m_null), c(`(Intercept)`=-4.6, `I((Age + 7.5)^-2)`=-427),tol=1e-2))) 9 | 10 | s<-svyscoretest(m_full, ~Scar) 11 | stopifnot(abs(s[1]-10.73)<0.05) 12 | 13 | t<-svyscoretest(m_full,~Scar,method="individual") 14 | stopifnot(abs(coef(t)- -32.61)<0.1) 15 | stopifnot(abs(vcov(t)-99.1)<0.1) 16 | 17 | -------------------------------------------------------------------------------- /tests/scoping.R: -------------------------------------------------------------------------------- 1 | 2 | ## regression test for testing regression 3 | 4 | library(survey) 5 | data(api) 6 | 7 | dstrat<-svydesign(id=~1,strata=~stype, weights=~pw, data=apistrat, fpc=~fpc) 8 | 9 | 10 | f<-function(){ 11 | form<-acs.46~stype 12 | svyglm(formula=form, design = dstrat) 13 | } 14 | 15 | g<-function(form){ 16 | svyglm(formula=form, design = dstrat) 17 | } 18 | f() 19 | g(acs.46~stype) 20 | 21 | f<-function(){ 22 | form<-Surv(acs.46)~stype 23 | svycoxph(formula=form, design = dstrat) 24 | } 25 | 26 | g<-function(form){ 27 | svycoxph(formula=form, design = dstrat) 28 | } 29 | 30 | f() 31 | g(Surv(acs.46)~stype) 32 | 33 | ## check coxph for a single predictor 34 | svycoxph(Surv(acs.46)~api00,design=dstrat) 35 | -------------------------------------------------------------------------------- /tests/simdata1.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/tests/simdata1.RData -------------------------------------------------------------------------------- /tests/survcurve.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | library(survival) 3 | 4 | pbc2<-rbind(pbc,pbc) 5 | pbc2$id<-rep(1:418,2) 6 | 7 | dpbc1<-svydesign(id=~1, data=pbc) 8 | dpbc2<-svydesign(id=~id, data=pbc2) 9 | 10 | s1<-svykm(Surv(time,status>0)~1, subset(dpbc1, bili>6), se=TRUE) 11 | s2<-svykm(Surv(time,status>0)~1, subset(dpbc2, bili>6), se=TRUE) 12 | 13 | (c1<-confint(s1,(1:5)*365)) 14 | (c2<-confint(s2,(1:5)*365)) 15 | all.equal(c1, c2) 16 | 17 | m1<-svycoxph(Surv(time,status>0)~log(bili), design=dpbc1) 18 | m2<-svycoxph(Surv(time,status>0)~log(bili), design=dpbc2) 19 | 20 | d<-data.frame(bili=c(5,10)) 21 | p1<-predict(m1, se=TRUE, newdata=d,type="curve") 22 | p2<-predict(m2, se=TRUE, newdata=d,type="curve") 23 | 24 | (pc1<-confint(p1[[1]],(1:5)*365)) 25 | (pc2<-confint(p2[[1]],(1:5)*365)) 26 | all.equal(pc1, pc2) 27 | 28 | (q1<-quantile(p1[[2]])) 29 | (q2<-quantile(p2[[2]])) 30 | all.equal(q1,q2) 31 | -------------------------------------------------------------------------------- /tests/survcurve.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 3.1.0 (2014-04-10) -- "Spring Dance" 3 | Copyright (C) 2014 The R Foundation for Statistical Computing 4 | Platform: x86_64-apple-darwin13.1.0 (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > library(survey) 19 | 20 | Attaching package: 'survey' 21 | 22 | The following object is masked from 'package:graphics': 23 | 24 | dotchart 25 | 26 | > library(survival) 27 | Loading required package: splines 28 | > 29 | > pbc2<-rbind(pbc,pbc) 30 | > pbc2$id<-rep(1:418,2) 31 | > 32 | > dpbc1<-svydesign(id=~1, data=pbc) 33 | Warning message: 34 | In svydesign.default(id = ~1, data = pbc) : 35 | No weights or probabilities supplied, assuming equal probability 36 | > dpbc2<-svydesign(id=~id, data=pbc2) 37 | Warning message: 38 | In svydesign.default(id = ~id, data = pbc2) : 39 | No weights or probabilities supplied, assuming equal probability 40 | > 41 | > s1<-svykm(Surv(time,status>0)~1, subset(dpbc1, bili>6), se=TRUE) 42 | > s2<-svykm(Surv(time,status>0)~1, subset(dpbc2, bili>6), se=TRUE) 43 | > 44 | > (c1<-confint(s1,(1:5)*365)) 45 | 0.025 0.975 46 | 365 0.6446215 0.8594153 47 | 730 0.5410938 0.7766848 48 | 1095 0.2683127 0.5103356 49 | 1460 0.1444731 0.3722001 50 | 1825 0.1009672 0.3204713 51 | > (c2<-confint(s2,(1:5)*365)) 52 | 0.025 0.975 53 | 365 0.6446215 0.8594153 54 | 730 0.5410938 0.7766848 55 | 1095 0.2683127 0.5103356 56 | 1460 0.1444731 0.3722001 57 | 1825 0.1009672 0.3204713 58 | > all.equal(c1, c2) 59 | [1] TRUE 60 | > 61 | > m1<-svycoxph(Surv(time,status>0)~log(bili), design=dpbc1) 62 | > m2<-svycoxph(Surv(time,status>0)~log(bili), design=dpbc2) 63 | > 64 | > d<-data.frame(bili=c(5,10)) 65 | > p1<-predict(m1, se=TRUE, newdata=d,type="curve") 66 | > p2<-predict(m2, se=TRUE, newdata=d,type="curve") 67 | > 68 | > (pc1<-confint(p1[[1]],(1:5)*365)) 69 | 0.025 0.975 70 | 365 0.8410027 0.9266263 71 | 730 0.7371114 0.8548312 72 | 1095 0.5517779 0.7018583 73 | 1460 0.4335073 0.5992819 74 | 1825 0.3260899 0.5046241 75 | > (pc2<-confint(p2[[1]],(1:5)*365)) 76 | 0.025 0.975 77 | 365 0.8409490 0.9267054 78 | 730 0.7370152 0.8549432 79 | 1095 0.5515848 0.7019513 80 | 1460 0.4332252 0.5992968 81 | 1825 0.3257172 0.5045795 82 | > all.equal(pc1, pc2) 83 | [1] "Mean relative difference: 0.0002070722" 84 | > 85 | > (q1<-quantile(p1[[2]])) 86 | 0.75 0.5 0.25 87 | 489 930 1492 88 | > (q2<-quantile(p2[[2]])) 89 | 0.75 0.5 0.25 90 | 489 930 1492 91 | > all.equal(q1,q2) 92 | [1] TRUE 93 | > 94 | > proc.time() 95 | user system elapsed 96 | 3.410 0.099 3.519 97 | -------------------------------------------------------------------------------- /tests/svyby-strings.R: -------------------------------------------------------------------------------- 1 | 2 | ## check that stringsAsFactors fixes the string levels problem 3 | data(api, package = "survey") 4 | des <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) 5 | est0 <- 6 | survey::svyby(design=des, formula=~cname, by=~both, FUN=survey::svymean, keep.var=TRUE, stringsAsFactors=TRUE) 7 | 8 | stopifnot(isTRUE(all(dim(est0)==c(2,23)))) 9 | -------------------------------------------------------------------------------- /tests/svyby_bug.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | options(warn=2) 3 | 4 | ## Caused warnings and unhelpful results in 4.1_1 (Guilherme Jacob) 5 | data(api) 6 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 7 | svyby(~api99, ~stype, dclus1, svymean ) 8 | 9 | set.seed(123) 10 | apiclus1$api99[ sample.int( nrow(apiclus1) , 5 ) ] <- NA 11 | dclus1.na <-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 12 | 13 | # subsetting w/ na.rm = FALSE... 14 | svymean( ~api99 , subset( dclus1.na , stype == "E" ) , na.rm = FALSE ) 15 | svymean( ~api99 , subset( dclus1.na , stype == "H" ) , na.rm = FALSE ) 16 | svymean( ~api99 , subset( dclus1.na , stype == "M" ) , na.rm = FALSE ) 17 | 18 | # ... looks like this: 19 | svyby(~api99, ~stype, dclus1.na , svymean ) 20 | 21 | # subsetting w/ na.rm = TRUE... 22 | svymean( ~api99 , subset( dclus1.na , stype == "E" ) , na.rm = TRUE ) 23 | svymean( ~api99 , subset( dclus1.na , stype == "H" ) , na.rm = TRUE ) 24 | svymean( ~api99 , subset( dclus1.na , stype == "M" ) , na.rm = TRUE ) 25 | 26 | # ... looks like this 27 | svyby(~api99, ~stype, dclus1.na , svymean , na.rm = TRUE ) 28 | 29 | # Without missing values, this works: 30 | svyby(~api99, ~stype, dclus1 , svymean , na.rm = TRUE , covmat = TRUE ) 31 | 32 | # ... but this breaks! 33 | svyby(~api99, ~stype, dclus1.na , svymean , na.rm = TRUE , covmat = TRUE ) 34 | 35 | # ... and i don't think this is the expected behavior 36 | svyby( ~api99, ~stype, dclus1.na , svymean , na.rm.all = TRUE , covmat = TRUE ) 37 | svyby( ~api99, ~stype, dclus1.na , svymean , na.rm.all = TRUE , na.rm = TRUE , covmat = TRUE ) 38 | 39 | 40 | ## Now some more as tests 41 | svyby(~api99, ~stype, dclus1.na , svytotal , na.rm = TRUE , covmat = TRUE ) 42 | svyby(~api99, ~stype, dclus1.na , svyratio , na.rm = TRUE , denominator=~api00, covmat = TRUE ) 43 | 44 | ff<-function(f,d,...,na.rm=TRUE) svyglm(f,d,...) 45 | svyby(api99~1, ~stype, dclus1.na , ff , na.rm = TRUE , covmat = TRUE ) 46 | -------------------------------------------------------------------------------- /tests/svyby_se.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | data(api) 3 | dstrat<-svydesign(id=~1,strata=~stype, weights=~pw, data=apistrat, fpc=~fpc) 4 | 5 | a<-svyby(~enroll,~stype,design=dstrat,svytotal,vartype=c("ci","se")) 6 | b<-svyby(~enroll,~stype,design=dstrat,svytotal,vartype=c("se","ci")) 7 | 8 | 9 | stopifnot(all.equal(SE(a),SE(b))) 10 | -------------------------------------------------------------------------------- /tests/svycontrast.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | data(api) 3 | dclus2<-svydesign(id=~dnum+snum, weights=~pw, data=apiclus2) 4 | rclus2<-as.svrepdesign(dclus2) 5 | model<-svyglm(formula = api00 ~ ell + meals + mobility, design = rclus2) 6 | svycontrast(model, c(ell=1,meals=0)) 7 | a<-svycontrast(model, c(0,1,0,0)) 8 | 9 | model2<-svyglm(formula = api00 ~ ell + meals + mobility, design = rclus2,return.replicates=TRUE) 10 | svycontrast(model2, c(ell=1,meals=0)) 11 | a2<-svycontrast(model2, c(0,1,0,0)) 12 | stopifnot(!is.null(a2$replicates)) 13 | -------------------------------------------------------------------------------- /tests/svyivreg-var.R: -------------------------------------------------------------------------------- 1 | 2 | library(survey) 3 | data(api) 4 | dstrat<-svydesign(id=~1,strata=~stype, weights=~pw, data=apistrat, fpc=~fpc) 5 | a<-summary(svyglm(api00~ell+meals+mobility, design=dstrat)) 6 | b<- summary(svyivreg(api00~ell+meals+mobility, design=dstrat)) 7 | stopifnot(isTRUE(all.equal(a$cov.scaled, b$vcov))) 8 | -------------------------------------------------------------------------------- /tests/svyivreg.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | library(AER) 3 | 4 | load("cigsw.rda") 5 | 6 | des<-svydesign(id=~1, weights=~wt, data=cigsw) 7 | m<-svyivreg(log(packs) ~ log(rprice) + log(rincome) | log(rincome) + tdiff + I(tax/cpi), design=des) 8 | 9 | all.equal(as.vector(coef(m)), c(10.42009 , -1.588135, 0.6140887),tolerance=1e-6) 10 | all.equal(as.vector(SE(m)), c( 1.047699, .3394232, .3614382 ),tolerance=1e-6) 11 | -------------------------------------------------------------------------------- /tests/svyolr-rake-subset.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | data(api) 3 | dclus1 <- svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 4 | 5 | dclus1<-update(dclus1, mealcat=cut(meals,c(0,25,50,75,100))) 6 | 7 | ## population marginal totals for each stratum 8 | pop.types <- data.frame(stype=c("E","H","M"), Freq=c(4421,755,1018)) 9 | pop.schwide <- data.frame(sch.wide=c("No","Yes"), Freq=c(1072,5122)) 10 | 11 | 12 | ## rake with the population totals 13 | dclus1r<-rake(dclus1, list(~stype,~sch.wide), list(pop.types, pop.schwide)) 14 | 15 | # works 16 | m <- svyolr(mealcat~avg.ed+mobility+stype, design=dclus1) 17 | 18 | # fails in 4.1 (should work because svyolr's default na.action is na.omit) 19 | m2 <- svyolr(mealcat~avg.ed+mobility+stype, design=dclus1r) 20 | 21 | # fails in 4.1 (should work because NA values are subsetted out) 22 | m3 <- svyolr(mealcat~avg.ed+mobility+stype, design=subset( dclus1r , !is.na( avg.ed ) ) ) 23 | -------------------------------------------------------------------------------- /tests/svyolr.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | 3 | ################################################################################ 4 | # Example from svyolr: runs OK 5 | data(api) 6 | dclus1<-svydesign(id=~dnum, weights=~pw, data=apiclus1, fpc=~fpc) 7 | dclus1<-update(dclus1, mealcat=cut(meals,c(0,25,50,75,100))) 8 | 9 | m<-svyolr(mealcat~avg.ed+mobility+stype, design=dclus1) 10 | m 11 | 12 | ## Use regTermTest for testing multiple parameters 13 | test<-regTermTest(m, ~avg.ed+stype, method="LRT") 14 | ################################################################################ 15 | 16 | ################################################################################ 17 | # If we wrap everything into a function: error b/c it looks for design variable 18 | # dclus1 in .GlobalEnv 19 | 20 | foo <- function(x){ 21 | dclus1<-svydesign(id=~dnum, weights=~pw, data=x, fpc=~fpc) 22 | dclus1<-update(dclus1, mealcat=cut(meals,c(0,25,50,75,100))) 23 | 24 | m<-svyolr(mealcat~avg.ed+mobility+stype, design=dclus1) 25 | ## Use regTermTest for testing multiple parameters 26 | regTermTest(m, ~avg.ed+stype, method="LRT") 27 | } 28 | 29 | # OK 30 | foo(apiclus1) 31 | 32 | # Clean-up everything but apiclus1 and foo 33 | rm(list = setdiff(ls(),c('apiclus1','foo','test'))) 34 | 35 | # Error 36 | test2<-foo(apiclus1) 37 | ################################################################################ 38 | all.equal(test,test2) 39 | 40 | -------------------------------------------------------------------------------- /tests/testSUMMER/SUMMER.R: -------------------------------------------------------------------------------- 1 | ## CRAN won't allow this test unless INLA is a listed dependency 2 | ## which is impossible, so the test is hidden away here. 3 | 4 | library(survey) 5 | 6 | data("DemoData2",package="SUMMER") 7 | data("DemoMap2", package="SUMMER") 8 | 9 | if(require("INLA",quietly=TRUE)){ 10 | INLA::inla.setOption(num.threads="1:1") 11 | library(survey) 12 | des0 <- svydesign(ids = ~clustid+id, strata = ~strata, 13 | weights = ~weights, data = DemoData2, nest = TRUE) 14 | Xmat <- aggregate(age~region, data = DemoData2, FUN = mean) 15 | 16 | cts.cov.res <- svysmoothArea(tobacco.use ~ age, 17 | domain = ~region, 18 | design = des0, 19 | adj.mat = DemoMap2$Amat, 20 | X.domain = Xmat, 21 | pc.u = 1, 22 | pc.alpha = 0.01, 23 | pc.u.phi = 0.5, 24 | pc.alpha.phi = 2/3) 25 | print(cts.cov.res) 26 | plot(cts.cov.res) 27 | summary(cts.cov.res) 28 | } 29 | -------------------------------------------------------------------------------- /tests/testoutput/DBIcheck.R: -------------------------------------------------------------------------------- 1 | 2 | library(survey) 3 | library(RSQLite) 4 | 5 | data(api) 6 | apiclus1$api_stu<-apiclus1$api.stu 7 | apiclus1$comp_imp<-apiclus1$comp.imp 8 | dclus1<-svydesign(id=~dnum, weights=~pw, fpc=~fpc,data=apiclus1) 9 | dbclus1<-svydesign(id=~dnum, weights=~pw, fpc=~fpc, 10 | data="apiclus1",dbtype="SQLite", dbname=system.file("api.db",package="survey")) 11 | 12 | m<-svymean(~api00+stype,dclus1) 13 | m.db<-svymean(~api00+stype, dbclus1) 14 | all.equal(coef(m),coef(m.db)) 15 | all.equal(vcov(m), vcov(m.db)) 16 | 17 | r<-svyratio(~api_stu, ~enroll, design=dclus1) 18 | r.db<-svyratio(~api_stu, ~enroll, design=dbclus1) 19 | all.equal(coef(r), coef(r.db)) 20 | all.equal(SE(r), SE(r.db)) 21 | 22 | b<-svyby(~api99+api00,~stype, design=dclus1, svymean, deff=TRUE) 23 | b.db<-svyby(~api99+api00,~stype, design=dbclus1,svymean, deff=TRUE) 24 | all.equal(coef(b), coef(b.db)) 25 | all.equal(SE(b), SE(b.db)) 26 | all.equal(deff(b), deff(b.db)) 27 | 28 | l<-svyglm(api00~api99+mobility, design=dclus1) 29 | l.db<-svyglm(api00~api99+mobility, design=dbclus1) 30 | all.equal(coef(l),coef(l.db)) 31 | all.equal(vcov(l), vcov(l.db)) 32 | 33 | dclus1<-update(dclus1, apidiff=api00-api99) 34 | dclus1<-update(dclus1, apipct= apidiff/api99) 35 | dbclus1<-update(dbclus1, apidiff=api00-api99) 36 | dbclus1<-update(dbclus1, apipct= apidiff/api99) 37 | 38 | u<-svymean(~api00+apidiff+apipct, dclus1) 39 | u.db<-svymean(~api00+apidiff+apipct, dbclus1) 40 | all.equal(u, u.db) 41 | 42 | all.equal(nrow(dclus1),nrow(dbclus1)) 43 | 44 | ## replicate weights 45 | rclus1<-as.svrepdesign(dclus1) 46 | db_rclus1<-svrepdesign(weights=~pw, repweights="wt[1-9]+", type="JK1", scale=(1-15/757)*14/15, 47 | data="apiclus1rep",dbtype="SQLite", dbname=system.file("api.db",package="survey"),combined.weights=FALSE) 48 | m<-svymean(~api00+api99,rclus1) 49 | m.db<-svymean(~api00+api99,db_rclus1) 50 | all.equal(m,m.db) 51 | 52 | summary(db_rclus1) 53 | 54 | s<-svymean(~api00, subset(rclus1, comp_imp=="Yes")) 55 | s.db<-svymean(~api00, subset(db_rclus1, comp_imp=="Yes")) 56 | all.equal(s,s.db) 57 | -------------------------------------------------------------------------------- /tests/testoutput/README: -------------------------------------------------------------------------------- 1 | These are tests involving the printed output. They do not give 2 | character-by-character identical results on all systems (and in 3 | particular, the CRAN Windows system gives slightly different results 4 | from any computer I have tried), so they can't be part of the default 5 | R CMD check. 6 | -------------------------------------------------------------------------------- /tests/testoutput/api.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | options(survey.replicates.mse=TRUE) 3 | example(api) 4 | 5 | options(survey.replicates.mse=FALSE) 6 | example(api) 7 | -------------------------------------------------------------------------------- /tests/testoutput/fpc.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | ## check many permutations of fpc specification 3 | example(fpc) 4 | 5 | -------------------------------------------------------------------------------- /tests/testoutput/multistage.R: -------------------------------------------------------------------------------- 1 | ## 2 | ## Check that multistage samples still work 3 | ## 4 | library(survey) 5 | example(mu284) 6 | 7 | -------------------------------------------------------------------------------- /tests/testoutput/multistage.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 3.1.0 (2014-04-10) -- "Spring Dance" 3 | Copyright (C) 2014 The R Foundation for Statistical Computing 4 | Platform: x86_64-apple-darwin13.1.0 (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | R is a collaborative project with many contributors. 11 | Type 'contributors()' for more information and 12 | 'citation()' on how to cite R or R packages in publications. 13 | 14 | Type 'demo()' for some demos, 'help()' for on-line help, or 15 | 'help.start()' for an HTML browser interface to help. 16 | Type 'q()' to quit R. 17 | 18 | > ## 19 | > ## Check that multistage samples still work 20 | > ## 21 | > library(survey) 22 | 23 | Attaching package: 'survey' 24 | 25 | The following object is masked from 'package:graphics': 26 | 27 | dotchart 28 | 29 | > example(mu284) 30 | 31 | mu284> data(mu284) 32 | 33 | mu284> (dmu284<-svydesign(id=~id1+id2,fpc=~n1+n2, data=mu284)) 34 | 2 - level Cluster Sampling design 35 | With (5, 15) clusters. 36 | svydesign(id = ~id1 + id2, fpc = ~n1 + n2, data = mu284) 37 | 38 | mu284> (ytotal<-svytotal(~y1, dmu284)) 39 | total SE 40 | y1 15080 2274.3 41 | 42 | mu284> vcov(ytotal) 43 | y1 44 | y1 5172234 45 | > 46 | > 47 | > proc.time() 48 | user system elapsed 49 | 0.167 0.024 0.202 50 | -------------------------------------------------------------------------------- /tests/testoutput/nwtco-subcohort.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/tests/testoutput/nwtco-subcohort.rda -------------------------------------------------------------------------------- /tests/testoutput/nwts-cch.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | library(survival) 3 | data(nwtco) 4 | 5 | ntwco<-subset(nwtco, !is.na(edrel)) 6 | 7 | load("nwtco-subcohort.rda") 8 | nwtco$subcohort<-subcohort 9 | 10 | d_BorganII <- twophase(id=list(~seqno,~seqno), 11 | strata=list(NULL,~interaction(instit,rel)), 12 | data=nwtco, subset=~I(rel |subcohort)) 13 | 14 | ##Coefficient results same as Splus with code from 15 | ## http://faculty.washington.edu/norm/software.html 16 | ## SE slightly larger due to using sandwich variance. 17 | 18 | svycoxph(Surv(edrel, rel)~factor(stage)+factor(histol)+I(age/12), design=d_BorganII) 19 | 20 | ## 21 | ## This gives higher standard errors. calibrate() does not recompute the 22 | ## finite population correction if a calibration variable happens to predict 23 | ## sampling perfectly. It probably should. 24 | ## 25 | d_BorganIIps<-calibrate(twophase(id=list(~seqno,~seqno), 26 | strata=list(NULL,~rel), 27 | data=nwtco, subset=~I(rel |subcohort)), 28 | phase=2, formula=~interaction(instit,rel), 29 | epsilon=1e-10) 30 | 31 | svycoxph(Surv(edrel, rel)~factor(stage)+factor(histol)+I(age/12), design=d_BorganIIps) 32 | -------------------------------------------------------------------------------- /tests/testoutput/nwts.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cran/survey/25cb26894574e60905883092461786f02dfce1da/tests/testoutput/nwts.rda -------------------------------------------------------------------------------- /tests/testoutput/pps.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | data(election) 3 | 4 | dpps<- svydesign(id=~1, weights=~wt, fpc=~p, data=election_pps, pps="brewer") 5 | dppswr <-svydesign(id=~1, weights=~wt, data=election_pps) 6 | svytotal(~Bush+Kerry+Nader, dpps) 7 | svytotal(~Bush+Kerry+Nader, dppswr) 8 | 9 | ##subsets 10 | svytotal(~Bush+Kerry+Nader, subset(dpps, Nader>0)) 11 | 12 | ##multistage: should agree with STRS analysis 13 | data(api) 14 | dclus2<-svydesign(id = ~dnum + snum, fpc = ~fpc1 + fpc2, data = apiclus2) 15 | dclus2pps<-svydesign(id = ~dnum + snum, fpc = ~I(40/fpc1) + I(pmin(1,5/fpc2)), data = apiclus2) 16 | 17 | all.equal(svytotal(~sch.wide,dclus2), svytotal(~sch.wide,dclus2pps)) 18 | all.equal(svymean(~sch.wide,dclus2), svymean(~sch.wide,dclus2pps)) 19 | all.equal(svytotal(~enroll,dclus2), svytotal(~enroll,dclus2pps)) 20 | 21 | ## the new without-replacement methods 22 | data(election) 23 | dpps_br<- svydesign(id=~1, fpc=~p, data=election_pps, pps="brewer") 24 | dpps_ov<- svydesign(id=~1, fpc=~p, data=election_pps, pps="overton") 25 | dpps_hr<- svydesign(id=~1, fpc=~p, data=election_pps, pps=HR(sum(election$p^2)/40)) 26 | dpps_hr1<- svydesign(id=~1, fpc=~p, data=election_pps, pps=HR()) 27 | dpps_ht<- svydesign(id=~1, fpc=~p, data=election_pps, pps=ppsmat(election_jointprob)) 28 | ## Yates-Grundy type 29 | dpps_yg<- svydesign(id=~1, fpc=~p, data=election_pps, pps=ppsmat(election_jointprob),variance="YG") 30 | dpps_hryg<- svydesign(id=~1, fpc=~p, data=election_pps, pps=HR(sum(election$p^2)/40),variance="YG") 31 | 32 | ## The with-replacement approximation 33 | svytotal(~Bush+Kerry+Nader, dpps_ht) 34 | svytotal(~Bush+Kerry+Nader, dpps_yg) 35 | svytotal(~Bush+Kerry+Nader, dpps_hr) 36 | svytotal(~Bush+Kerry+Nader, dpps_hryg) 37 | svytotal(~Bush+Kerry+Nader, dpps_hr1) 38 | svytotal(~Bush+Kerry+Nader, dpps_br) 39 | svytotal(~Bush+Kerry+Nader, dpps_ov) 40 | 41 | ## subsets 42 | svytotal(~Bush+Kerry+Nader, subset(dpps_ht, Nader>0)) 43 | svytotal(~Bush+Kerry+Nader, subset(dpps_hryg, Nader>0)) 44 | 45 | ## counts 46 | svyby(~Bush+Kerry+Nader,~I(Nader>0), unwtd.count,design=dpps_ht) 47 | -------------------------------------------------------------------------------- /tests/testoutput/quantile-new.R: -------------------------------------------------------------------------------- 1 | ## From Ben Schneider, https://github.com/bschneidr/r-forge-survey-mirror/pull/7 2 | library(survey) 3 | data('api', package = 'survey') 4 | 5 | boot_design <- svydesign( 6 | ids = ~ 1, strata = ~ stype, 7 | weights = ~ pw, 8 | data = apistrat, 9 | ) |> as.svrepdesign(type = "boot") 10 | 11 | # Attempt to estimate variance of quantile using direct replication ---- 12 | new <- svyquantile( 13 | x = ~ api00 + api99, 14 | quantiles = c(0.25, 0.75), 15 | design = boot_design, 16 | interval.type = "quantile", 17 | return.replicates = TRUE 18 | ) 19 | 20 | print(new) 21 | 22 | old <- oldsvyquantile( 23 | x = ~ api00 + api99, 24 | quantiles = c(0.25, 0.75), 25 | design = boot_design, 26 | interval.type = "quantile", 27 | return.replicates = TRUE 28 | ) 29 | 30 | print(old) 31 | 32 | confint(new) 33 | confint(old) 34 | -------------------------------------------------------------------------------- /tests/testoutput/quantile-new.Rout.save: -------------------------------------------------------------------------------- 1 | 2 | R version 4.1.1 (2021-08-10) -- "Kick Things" 3 | Copyright (C) 2021 The R Foundation for Statistical Computing 4 | Platform: aarch64-apple-darwin20 (64-bit) 5 | 6 | R is free software and comes with ABSOLUTELY NO WARRANTY. 7 | You are welcome to redistribute it under certain conditions. 8 | Type 'license()' or 'licence()' for distribution details. 9 | 10 | Natural language support but running in an English locale 11 | 12 | R is a collaborative project with many contributors. 13 | Type 'contributors()' for more information and 14 | 'citation()' on how to cite R or R packages in publications. 15 | 16 | Type 'demo()' for some demos, 'help()' for on-line help, or 17 | 'help.start()' for an HTML browser interface to help. 18 | Type 'q()' to quit R. 19 | 20 | > ## From Ben Schneider, https://github.com/bschneidr/r-forge-survey-mirror/pull/7 21 | > library(survey) 22 | > data('api', package = 'survey') 23 | > 24 | > boot_design <- svydesign( 25 | + ids = ~ 1, strata = ~ stype, 26 | + weights = ~ pw, 27 | + data = apistrat, 28 | + ) |> as.svrepdesign(type = "boot") 29 | > 30 | > # Attempt to estimate variance of quantile using direct replication ---- 31 | > new <- svyquantile( 32 | + x = ~ api00 + api99, 33 | + quantiles = c(0.25, 0.75), 34 | + design = boot_design, 35 | + interval.type = "quantile", 36 | + return.replicates = TRUE 37 | + ) 38 | > 39 | > print(new) 40 | Statistic: 41 | api00 api99 42 | q0.25 565 526 43 | q0.75 756 728 44 | SE: 45 | api00 api99 46 | q0.25 19.22732 14.45368 47 | q0.75 13.72320 19.50807 48 | > 49 | > old <- oldsvyquantile( 50 | + x = ~ api00 + api99, 51 | + quantiles = c(0.25, 0.75), 52 | + design = boot_design, 53 | + interval.type = "quantile", 54 | + return.replicates = TRUE 55 | + ) 56 | > 57 | > print(old) 58 | Statistic: 59 | api00 api99 60 | q0.25 562.2056 525.4800 61 | q0.75 755.1226 726.7813 62 | SE: 63 | api00 api99 64 | q0.25 18.91980 14.53474 65 | q0.75 14.13114 18.73837 66 | > 67 | > confint(new) 68 | 2.5 % 97.5 % 69 | q0.25_api00 527.3152 602.6848 70 | q0.75_api00 729.1030 782.8970 71 | q0.25_api99 497.6713 554.3287 72 | q0.75_api99 689.7649 766.2351 73 | > confint(old) 74 | 2.5 % 97.5 % 75 | q0.25_api00 525.1235 599.2877 76 | q0.75_api00 727.4261 782.8191 77 | q0.25_api99 496.9924 553.9676 78 | q0.75_api99 690.0547 763.5078 79 | > 80 | -------------------------------------------------------------------------------- /tests/testoutput/scoping.R: -------------------------------------------------------------------------------- 1 | 2 | ## regression test for testing regression 3 | 4 | library(survey) 5 | data(api) 6 | 7 | dstrat<-svydesign(id=~1,strata=~stype, weights=~pw, data=apistrat, fpc=~fpc) 8 | 9 | 10 | f<-function(){ 11 | form<-acs.46~stype 12 | svyglm(formula=form, design = dstrat) 13 | } 14 | 15 | g<-function(form){ 16 | svyglm(formula=form, design = dstrat) 17 | } 18 | f() 19 | g(acs.46~stype) 20 | 21 | f<-function(){ 22 | form<-Surv(acs.46)~stype 23 | svycoxph(formula=form, design = dstrat) 24 | } 25 | 26 | g<-function(form){ 27 | svycoxph(formula=form, design = dstrat) 28 | } 29 | 30 | f() 31 | g(Surv(acs.46)~stype) 32 | 33 | ## check coxph for a single predictor 34 | svycoxph(Surv(acs.46)~api00,design=dstrat) 35 | -------------------------------------------------------------------------------- /tests/toy_example_for_postStratify.R: -------------------------------------------------------------------------------- 1 | library(survey) 2 | 3 | # Dummy data for testing nonresponse adjustments 4 | toy <- data.frame(id = 1:10, 5 | dummy = 1, 6 | class = c(rep("A", 5), rep("B", 5)), 7 | responded = c(rep(TRUE, 8), FALSE, FALSE), 8 | weight = rep(100, 10)) 9 | 10 | # With jackknife replicate weights 11 | toy_repweights <- matrix(rep(1000/9, 100), nrow = 10) 12 | diag(toy_repweights) <- rep(0, 10) 13 | 14 | # Scramble up which person is in which jackknife group 15 | toy_repweights <- toy_repweights[sample(1:10, size = 10), ] 16 | 17 | toy_design <- svrepdesign(variables = toy[, 1:4], 18 | weights = toy$weight, 19 | repweights = toy_repweights, 20 | type = "JK1", 21 | scale = 0.9) 22 | 23 | # Get the sum of the weights for the full sample 24 | poptotals <- as.data.frame(svyby(formula = ~dummy, 25 | by = ~class, 26 | design = toy_design, 27 | FUN = survey::svytotal)) 28 | 29 | poptotals$Freq <- poptotals$dummy 30 | poptotals$dummy <- NULL 31 | poptotals$se <- NULL 32 | 33 | # Adjust the weights of the responding sample to match to the full sample 34 | adjusted <- postStratify(design = subset(toy_design, responded), 35 | strata = ~class, 36 | population = poptotals) 37 | 38 | # This works for the weights... 39 | svyby(formula = ~dummy, 40 | by = ~class, 41 | design = adjusted, 42 | FUN = survey::svytotal) 43 | 44 | # ...and some, but not all, the replicate weights 45 | stopifnot(all.equal(colSums(toy_design$repweights), colSums(adjusted$repweights))) 46 | 47 | 48 | -------------------------------------------------------------------------------- /vignettes/survey-sae.html.asis: -------------------------------------------------------------------------------- 1 | %\VignetteIndexEntry{Small area estimation} 2 | %\VignetteEngine{R.rsp::asis} 3 | --------------------------------------------------------------------------------