sampling/ 0000755 0001762 0000144 00000000000 15033773102 012065 5 ustar ligges users sampling/MD5 0000644 0001762 0000144 00000016440 15033773102 012402 0 ustar ligges users a0a1174a68f0a0a20169db0817b93cbc *DESCRIPTION ae72356fe82d0ef390267faddc7628af *NAMESPACE 9da2c0433ff0f277f4dca4edb4e4cc38 *R/HTestimator.R 08c4d7114334d10a0caec1fc6bf71968 *R/HTstrata.r c9b1ae0be6fe3df9883ede499bb10339 *R/Hajekestimator.r d1fe76f0337a7a83a6e902ef57541ff1 *R/Hajekstrata.r fe4f3c4849c77f39e23f698eca641df9 *R/UPMEpik2frompikw.R e46e4d37db086ced1aa7be52a49cd99c *R/UPMEpikfromq.R 23780f67aa119e06e017e57affdd5076 *R/UPMEpiktildefrompik.R 0dccea40f8c13c0b820558079c6049ec *R/UPMEqfromw.R 545df0ce43ca06cfb0c7fbc9442a15a1 *R/UPMEsfromq.R 102b1a3871bb37821dc7ad8ef53f22df *R/UPbrewer.R 18d63d5af3691ef430eb0129db69e2c2 *R/UPmaxentropy.R 593f5cc0fc0acf8705657d50c172cac8 *R/UPmaxentropypi2.R 7fa457ee403a0b911d8d189811d2fcf8 *R/UPmidzuno.R 0002b2eb0657eac34889d4bb8f75bde7 *R/UPmidzunopi2.R c6af0290109363c3d31363b94144cb4e *R/UPminimalsupport.R 78b55dad22fdeed69d97cb9ee11f237b *R/UPmultinomial.R de6f26f391766cf54b1b0e9234bd7d94 *R/UPopips.r 695bcb24ea0da460420aec129d36955b *R/UPpivotal.r 367109233af0ba4fb12deb6ed85680ec *R/UPpoisson.R 3e614b0d70ad5ea13ffa93131d421f31 *R/UPrandompivotal.R 1c9ace9f09024f5a9a79dbe0e8ee0df9 *R/UPrandomsystematic.R 524efbe9b151122e0e390002d6c8e6e5 *R/UPsampford.R b687f9fee230d9dc101f05a2c63a1fa9 *R/UPsampfordpi2.r 25806b316c79131009c208b7827d7301 *R/UPsystematic.R 925deff4870d5ce2203e418ae99c655d *R/UPsystematicpi2.R c0eb4ec2628625425f6210cdfbbb6fca *R/UPtille.R d002737a0f285f107e31f5a12aece8de *R/UPtillepi2.R dc87e66c2501fe1aead27dfe1b5ef170 *R/as_int.r 9ac79cb69b3ffd8f96984f49ede89d84 *R/balancedcluster.R ff2082de62b9741eece459369ccd1fed *R/balancedstratification.R 59065fbcb53f0015bd7990735caec82b *R/balancedtwostage.R 53e62760fea98e7c30cdc7eeedc42818 *R/calib.r 28d3d2ac6fc3a6008683e313472c6b90 *R/calibev.r 999511be362810b6970f43f50c9b2196 *R/checkcalibration.R 7937c838f969518d281942465939efdb *R/cleanstrata.R f31a31792ede02a3c86e2a492acb5380 *R/cluster.r 39c9d86bca5f4e38e3130c3a9325a74b *R/disjunctive.R 9c2972ba701bd6a2cc3988d34c45554f *R/fastflightcube.R 4685754109fa3b574f94774ed4b62ff7 *R/gencalib.R f8f217acc40d29baab54a330c10bcd74 *R/getdata.r d25c378c17416caa65b913522b929a06 *R/inclusionprobabilities.R 2fe76fd3a0dfce5268a28997cbdaf052 *R/inclusionprobastrata.R 6ee3f3f14a53db1df0a458d266b55980 *R/landingcube.R 0a103aad8de9560a72eb9cc1851c17bf *R/mstage.r c8d2f7e09c4074d3dd323b3248ee6e6b *R/postest.r 1aa9e564d16d64b1e616ea09838534e3 *R/poststrata.r 75769b91b99bcc971e5bf3808fb2f013 *R/ratioest.r fd2544a8cb4d5217ee747cc35aeb9bea *R/ratioest_strata.r b22724653d0e7ba80c4df99f242b793f *R/regest.r b122c6f4e381461121006625138345fa *R/regest_strata.r 6852035727c0ec3c9ab6d2d85f6aeae3 *R/rhg.r cc40a03d7b7fddf52b7d2790d0513797 *R/rhg_strata.r f5a7f5e7fb324169076bed95f2ed2397 *R/rmodel.r bf4b40ee7262d8f14af763eba89a76f1 *R/samplecube.R 3d3548f11701d8a50858b15db0fa2682 *R/srswor.R 968691ea093c11bc866c59c6920f25d6 *R/srswor1.R 2a3f22e5754f8fcaa0a7cf656fba9e06 *R/srswr.R c14b989cae91ceb752f857f044bda7b6 *R/strata.r bddf8f11e93733f4393e28b8a2462d1b *R/varHT.r 65c054c0a234bddb75b4684cf19751b2 *R/varest.r 6820788410303d82df42fd8260c7c324 *R/vartaylor_ratio.r 55e2d5b9dfeba5d0fcf76e3768b2e6c9 *R/writesample.R f1f6bf2b1c948d4986b6694fbf1d37a3 *build/vignette.rds 8daf23fb7558b0dcdf8578a71b509e2e *data/MU284.rda 4134ceaeb1231bf2a3496f9afd74ccee *data/belgianmunicipalities.rda fe8d882c7a82998ed38cc6caf36f8529 *data/rec99.rda 04160e33b7934beedf9e42b0e58752d2 *data/swissmunicipalities.rda c2e9ab2471691383ba3811fc3600d3b5 *inst/doc/HT_Hajek_estimators.R f688a2aa443123bae71648bdb2785eee *inst/doc/HT_Hajek_estimators.Snw 83ae2d004d34235feb1af5bf5e9f568c *inst/doc/HT_Hajek_estimators.pdf 2bfeb089af2a94b23dc9af746e1d1345 *inst/doc/UPexamples.R 649d0f521a31da148c2176204591d1bb *inst/doc/UPexamples.Snw 8cdea729b783a99d9c5fe4ba0ce2f598 *inst/doc/UPexamples.pdf c4a5a449c9aa4be510841155de373d23 *inst/doc/calibration.R 3d5dba939e56a1709461977ca78ca7e3 *inst/doc/calibration.Snw 05d8a76594ecc47fde91a2dae0f2f101 *inst/doc/calibration.pdf a9f4afacb53b413b625317c65fff7e59 *man/HTestimator.Rd fa3365516ad50d03ab08668c96d43d58 *man/HTstrata.Rd 92849da4772776f01284ca5f57cda6c3 *man/Hajekestimator.Rd b26f2e44dd4a8d473a6cb7f7ea8485cd *man/Hajekstrata.Rd 73adb6d709be2360841e69e9fb0df6d9 *man/MU284.Rd 3641cf1b43781204de09f83d8e367d48 *man/UPbrewer.Rd 73d3ded94d47639b57ef3e9c652eece8 *man/UPmaxentropy.Rd 3b4afa1865e1741769f6d167c8179d0d *man/UPmidzuno.Rd 9807420064358ad70c2ff3eb0c1a93fb *man/UPmidzunopi2.Rd 2d0e82def37e4a20b6a64862b91b4160 *man/UPminimalsupport.Rd c5d69b1290ab4e1bfbce2c967426d67a *man/UPmultinomial.Rd 0634b370f4eb5a75200b9654a1855c87 *man/UPopips.Rd 4799044c34747914df4251c7692e68c1 *man/UPpivotal.Rd 1775831b942ee2bb275d93dd8a905c27 *man/UPpoisson.Rd 542864978594b0b7d297fe5eb2c40111 *man/UPrandompivotal.Rd 35eeab044e5d9a837d968dfb1bd184cb *man/UPrandomsystematic.Rd 7592102dfaf8bd6b89d7543739c8ba61 *man/UPsampford.Rd 0a645ca4a87fbe72aa9e72d38ac8d003 *man/UPsampfordpi2.Rd d5697462a287ec318a70155c7d3b713c *man/UPsystematic.Rd 530aea369cb0bb04137d6a39d0c5ae8b *man/UPsystematicpi2.Rd 80280edba5011cd94a16646fb54e9a55 *man/UPtille.Rd 51b840a16c82f22638dcfd322116591b *man/UPtillepi2.Rd 759ba49012f43aa328f0edafa81a5e17 *man/balancedcluster.Rd cf2ac1050213108ef29e7c942e6b8619 *man/balancedstratification.Rd 9f7b77e60478b5dd4a0827d5149feb4d *man/balancedtwostage.Rd 659f97a964a181ff80e117289b4c8316 *man/belgianmunicipalities.Rd db2e7a7606c87b9c11c49c471be92707 *man/calib.Rd bb19b54fece01ad049e7f0ed05b0a0b5 *man/calibev.Rd 0a0c32cfc773232ae1b2b6f078a7ade3 *man/checkcalibration.Rd ac12eccf1b6a8c59cc1485db8d551ded *man/cleanstrata.Rd 71ef37cd1ea18672adc2581fc994a58f *man/cluster.Rd 2331d0998cdce42acd317e15d8baef44 *man/disjunctive.Rd db506e56428e3209d387179631a08ca3 *man/fastflightcube.Rd 809f2c59e9b0e6825affac5f10d04acb *man/gencalib.Rd c190847b141b7ee2b66368fd266613ea *man/getdata.Rd 00131269b40d6fff6ad0f98f4aa0458b *man/inclusionprobabilities.Rd d7f340dc2245098aacbf318b64c6b119 *man/inclusionprobastrata.Rd c61107ac45db6a82ae6578ddcdba0581 *man/landingcube.Rd cb828bc7cbac179e094d8594491a3a74 *man/mstage.Rd dbc0e2484618c4b8586c1e80f8a69d22 *man/postest.Rd e1a87ef127f6295212c8df268715fe36 *man/poststrata.Rd 9f118952e508180c8320e85fbb2cabcf *man/ratioest.Rd 71152b76a8757252fb0781eb04379510 *man/ratioest_strata.Rd e748f5f8f4e8cb0d2987ce1b9e639a19 *man/rec99.Rd 117beb0b919ac2ba83e0acc5c0d9d1dd *man/regest.Rd 05fbbdf72e0a7eb6bff84dfb0344a6d1 *man/regest_strata.Rd 6832776fdbec1cb66a6715aaee4c64bb *man/rhg.Rd 0a458898c00c06f0922cb0729ca07905 *man/rhg_strata.Rd 88b8759c878eef5037bfa85445af204e *man/rmodel.Rd 8e0dd4e88f832cf16d7add7293bd9660 *man/samplecube.Rd 059d7d91746599d85fb051bab729e69c *man/sampling-internal.Rd cd9b2ff7df69b71be7d17db78c2867fa *man/srswor.Rd ab2ca117f4d61837c634e980bcdcbf82 *man/srswor1.Rd c7aecb7cf42beab574c052cb4ce9d397 *man/srswr.Rd 9cade8207cfb07a9dc47c889a938a295 *man/strata.Rd a364efc8434566bc73a71218ca5ad9cc *man/swissmunicipalities.Rd 9df67c2b59e5fc09a09980c04cec4c04 *man/varHT.Rd 4ca3d99e19c0821af777ca01339fe5a8 *man/varest.Rd bb08fc7ba29b9b3668d6ec4876d8c8b8 *man/vartaylor_ratio.Rd 3dc52cb41e07b47cc8ee0adcc2dbbcc4 *man/writesample.Rd 1a2fa79cf90ad39905a943ccdaa1b9af *src/init.c a5fccd459d68d965fb6f694875cc5804 *src/str.c f688a2aa443123bae71648bdb2785eee *vignettes/HT_Hajek_estimators.Snw 649d0f521a31da148c2176204591d1bb *vignettes/UPexamples.Snw 3d5dba939e56a1709461977ca78ca7e3 *vignettes/calibration.Snw sampling/R/ 0000755 0001762 0000144 00000000000 15011321164 012257 5 ustar ligges users sampling/R/poststrata.r 0000644 0001762 0000144 00000001601 14520143727 014657 0 ustar ligges users poststrata<-function(data, postnames = NULL) { if (missing(data) | missing(postnames)) stop("incomplete input") data = data.frame(data) if(is.null(colnames(data))) stop("the column names in data are missing") index = 1:nrow(data) m = match(postnames, colnames(data)) if (any(is.na(m))) stop("the names of the poststrata are wrong") data2 = cbind.data.frame(data[, m]) x1 = data.frame(unique(data[, m])) colnames(x1) = postnames nr_post=0 post=numeric(nrow(data)) nh=numeric(nrow(x1)) for(i in 1:nrow(x1)) { expr=rep(FALSE, nrow(data2)) for(j in 1:nrow(data2)) expr[j]=all(data2[j, ]==x1[i, ]) y=index[expr] if(is.matrix(y)) nh[i]=nrow(y) else nh[i]=length(y) post[expr]=i } result=cbind.data.frame(data,post) names(result)=c(names(data),"poststratum") list(data=result, npost=nrow(x1)) } sampling/R/srswor1.R 0000644 0001762 0000144 00000000166 14520143727 014040 0 ustar ligges users "srswor1" <- function(n,N) {j=0 s=numeric(N) for(k in 1:N) if(runif(1)<(n-j)/(N-k+1)) {j=j+1;s[k]=1;} s } sampling/R/cleanstrata.R 0000644 0001762 0000144 00000000207 14520143727 014715 0 ustar ligges users "cleanstrata" <- function(strata) { a=sort(unique(strata)) b=1:length(a) names(b)=a as.vector(b[as.character(strata)]) } sampling/R/UPMEpik2frompikw.R 0000644 0001762 0000144 00000000721 14520143730 015522 0 ustar ligges users "UPMEpik2frompikw" <-function(pik,w) { n=sum(pik) n=.as_int(n) N=length(pik) M=array(0,c(N,N)) for(k in 1:N) for(l in 1:N) if(pik[k]!=pik[l] & k!=l) M[k,l]= (pik[k]*w[l]-pik[l]*w[k])/(w[l]-w[k]) else M[k,l]=-1 for(i in 1:N) M[i,i]=pik[i] for(k in 1:N) { tt=0 comp=0 for(l in 1:N) {if(M[k,l]!=-1) tt=tt+M[k,l] else comp=comp+1 } cc=(n*pik[k]-tt)/comp for(l in 1:N) if(M[k,l]==-1) M[k,l]=cc } M } sampling/R/UPsampford.R 0000644 0001762 0000144 00000001170 14520143730 014466 0 ustar ligges users UPsampford<-function(pik,eps=1e-6,max_iter=500) { if(any(is.na(pik))) stop("there are missing values in the pik vector") n=sum(pik) n=.as_int(n) list= pik>eps & pik < 1-eps pikb=pik[list] n=sum(pikb) N=length(pikb) s=pik if(N<1) stop("the pik vector has all elements outside of the range [eps,1-eps]") else { sb=rep(2,N) y=pikb/(1-pikb)/sum(pikb/(1-pikb)) step=0 while(sum(sb<=1)!=N & step<=max_iter) { sb=as.vector(rmultinom(1,1,pikb/sum(pikb))+rmultinom(1,.as_int(n-1),y)) step=step+1 } if(sum(sb<=1)==N) s[list]=sb else stop("Too many iterations. The algorithm was stopped.") } s } sampling/R/UPmaxentropypi2.R 0000644 0001762 0000144 00000000533 14520143730 015476 0 ustar ligges users "UPmaxentropypi2" <-function(pik) { n=sum(pik) n=.as_int(n) N=length(pik) M=array(0,c(N,N)) if(n>=2) { pik2=pik[pik>0 & pik<1] pikt=UPMEpiktildefrompik(pik2) w=pikt/(1-pikt) M[pik>0 & pik<1,pik>0 & pik<1]=UPMEpik2frompikw(pik2,w) M[,pik==1]=pik for(k in 1:N) if(pik[k]==1) M[k,]=pik } if(n==1) for(k in 1:N) M[k,k]=pik[k] M } sampling/R/UPmaxentropy.R 0000644 0001762 0000144 00000001222 14520143730 015057 0 ustar ligges users "UPmaxentropy" <-function(pik) { if(is.data.frame(pik)) if(ncol(pik)>1) stop("pik is not a vector") else pik=unlist(pik) else if(is.matrix(pik)) if(ncol(pik)>1) stop("pik is not a vector") else pik=pik[,1] else if(is.list(pik)) if(length(pik)>1) stop("pik is not a vector") else pik=unlist(pik) n=sum(pik) n=.as_int(n) if(n>=2) { pik2=pik[pik!=1] n=sum(pik2) n=.as_int(n) piktilde=UPMEpiktildefrompik(pik2) w=piktilde/(1-piktilde) q=UPMEqfromw(w,n) s2=UPMEsfromq(q) s=rep(0,times=length(pik)) s[pik==1]=1 s[pik!=1][s2==1]=1 } if(n==0) s=rep(0,times=length(pik)) if(n==1) s=as.vector(rmultinom(1, 1,pik)) s } sampling/R/UPsampfordpi2.r 0000644 0001762 0000144 00000001516 14520143730 015145 0 ustar ligges users UPsampfordpi2<-function(pik) { n=sum(pik) n=.as_int(n) if(n<2) stop("the sample size<2") N=length(pik) p=pik/n pikl=matrix(0,N,N) Lm=rep(0, n) lambda=p/(1-n*p) Lm[1]=1 if(n>=2) for (i in 2:n) { for (r in 1:(i-1)) Lm[i]=Lm[i]+((-1)^(r-1))*sum(lambda^r)*Lm[i-r] Lm[i]=Lm[i]/(i - 1) } if(any(Lm<0)) stop("it is not possible to compute pik2 for this example") t1=(n + 1) - (1:n) Kn=1/sum(t1*Lm/n^t1) Lm2=rep(0, n - 1) t2=(1:(n - 1)) t3=n - t2 for (i in 2:N) { for (j in 1:(i - 1)) { Lm2[1]=1 Lm2[2]=Lm[2] - (lambda[i] + lambda[j]) if(n>3) for (m in 3:(n - 1)) { Lm2[m]=Lm[m] - (lambda[i] + lambda[j]) * Lm2[m -1] - lambda[i] * lambda[j] * Lm2[m - 2] } pikl[i, j]=Kn * lambda[i] * lambda[j] * sum((t2+1-n*(p[i] + p[j]))*Lm2[t3]/n^(t2 - 1)) pikl[j, i]=pikl[i, j] } pikl[i, i]=pik[i] } pikl[1, 1]=pik[1] pikl } sampling/R/HTstrata.r 0000644 0001762 0000144 00000001516 14520143727 014212 0 ustar ligges users HTstrata<-function (y, pik, strata, description=FALSE) { str <- function(st, h, n) .C("str", as.double(st), as.integer(h), as.integer(n), s = double(n), PACKAGE = "sampling")$s if(any(is.na(pik))) stop("there are missing values in pik") if(any(is.na(y))) stop("there are missing values in y") if(length(y)!=length(pik)) stop("y and pik have different sizes") if (is.matrix(y)) sample.size <- nrow(y) else sample.size <- length(y) h <- unique(strata) s1 <- 0 for (i in 1:length(h)) { s <- str(strata, h[i], sample.size) est<-HTestimator(y[s == 1], pik[s == 1]) s1 <- s1 + est if(description) cat("For stratum",i,",the Horvitz-Thompson estimator is:",est,"\n") } if(description) cat("The Horvitz-Thompson estimator is:\n") s1 } sampling/R/rhg_strata.r 0000644 0001762 0000144 00000001412 14520143727 014611 0 ustar ligges users rhg_strata<-function(X,selection) { if(is.matrix(X)) X=as.data.frame(X) m=match(selection,names(X),nomatch=0) if(sum(m)==0) stop("the 'selection' should be the name of one the X columns") if(!("Stratum" %in% names(X))) stop("the column 'Stratum' is missing") result=NULL u=unique(X$Stratum) for(i in 1:length(u)) {si=X[X$Stratum==u[i],] x=cbind.data.frame(si$ID_unit,si$status,si[,m]) names(x)=c("ID_unit","status",names(X)[m]) result=rbind.data.frame(result,rhg(x,selection)) } res = NULL mm = match(names(X), names(result), nomatch = 0) index = (1:ncol(X))[mm == 0] if (length(index) > 0) { res = cbind.data.frame(X[X$ID_unit==result$ID_unit, index], result) names(res)[1:length(index)] = names(X)[index] } res } sampling/R/varest.r 0000644 0001762 0000144 00000001417 14520143730 013756 0 ustar ligges users varest<-function(Ys,Xs=NULL,pik,w=NULL) { if (any(is.na(pik))) stop("there are missing values in pik") if (any(is.na(Ys))) stop("there are missing values in y") if (length(Ys) != length(pik)) stop("y and pik have different sizes") if(!is.null(Xs)) {if(is.data.frame(Xs)) Xs=as.matrix(Xs) if(is.vector(Xs) & (length(Ys)!= length(Xs))) stop("x and y have different sizes") if(is.matrix(Xs) & (length(Ys) != nrow(Xs))) stop("x and y have different sizes") } a=(1-pik)/sum(1-pik) if(is.null(Xs)) {A=sum(a*Ys/pik) var=sum((1-pik)*(Ys/pik-A)^2)/(1-sum(a^2)) } else {B=t(Xs*w) beta=ginv(B%*%Xs)%*%B%*%Ys e=Ys-Xs%*%beta A=sum(a*e/pik) var=sum((1-pik)*(e/pik-A)^2)/(1-sum(a^2)) } var } sampling/R/UPtille.R 0000644 0001762 0000144 00000001052 14520143730 013763 0 ustar ligges users "UPtille" <- function(pik,eps=1e-6) { if(any(is.na(pik))) stop("there are missing values in the pik vector") n=sum(pik) n=.as_int(n) list = pik > eps & pik < 1 - eps pikb = pik[list] N = length(pikb) s=pik if(N<1) stop("the pik vector has all elements outside of the range [eps,1-eps]") else { n=sum(pikb) sb=rep(1,N) b=rep(1,N) for(i in 1:(N-n)) {a=inclusionprobabilities(pikb,N-i) v=1-a/b b=a p=v*sb p=cumsum(p) u=runif(1) for(j in 1:length(p)) if(u