*--------------------------------------------------------------; * Computes sample size and allocation for various types of ; * allocation schemes from a stratified random sample ; * Macro printit is a general routine used to format output ; *--------------------------------------------------------------; %macro printit; proc print data = &outalloc noobs split='*'; title1 " "; title2 " "; title3 "Stratum weights and sample sizes for &ttl_ allocation"; %if &optfixn ne 0 %then %let tl_ = %str(Sample Size Fixed at &nfixed); %else %do; %if &optfixc ne 0 %then %let tl_ = %str(to minimize variance with cost fixed at &maxcost); %else %let tl_ = %str(to obtain an error bound of &bound on population ¶m); %end; title4 "&tl_"; title5 "Output Data Set = &outalloc"; %if &flag_ =yes %then %do; title6 "WARNING: Some Required sample sizes exceed population size"; %end; %if &vlag_ =yes %then %do; title7 "NOTE: Minimum sample sizes were set to &minsamp"; %end; &labc label &npop= 'Stratum*Sizes'; label wt_ = 'Stratum*Weights'; label tni_ = 'Exact*Allocation'; label ni = 'Nearest*Integer*(ni)'; sum &npop wt_ tni_ ni; var &prvars; %let flag_ =no; %let vlag_ =no; %let labc =; %mend printit; *--------------------------------------------------------------; * Computes sample size and allocation for various types of ; * allocation schemes from a stratified random sample ; *--------------------------------------------------------------; %macro alloc(type=,opt=,nfixed=,overhead=,maxcost=,cost=,bound=, setup=,strata=,npop=,var=,param=,minsamp=,wi=,outalloc=, sample=,phat=); %if %length(&strata) = 0 %then %let strata = %str(strata); %if %length(&cost) = 0 %then %let cost = %str(cost); %if %length(&npop) = 0 %then %let npop = %str(npop); %if %length(&var) = 0 %then %let var = %str(var); %if %length(&outalloc) = 0 %then %let outalloc = %str(outalloc); %if %length(&overhead) = 0 %then %let overhead = %str(0); %if %length(&setup) > 0 %then %let dset = %str(&setup); %else %let dset = %str(&sample); %let labc = %str(); %let flag_ =no; %let vlag_ =no; %let strc = %str( label &cost = 'Sampling*Costs';); %let typopt = %index(%upcase(&type),OPTIMAL); %let typney = %index(%upcase(&type),NEYMAN); %let typpro = %index(%upcase(&type),PROP); %let optfixc = %index(%upcase(&opt),FIXEDC); %let optfixn = %index(%upcase(&opt),FIXEDN); %let optfixw = %index(%upcase(&opt),FIXEDW); %if %index(%upcase(¶m),PROP) > 0 %then %let param=proportion; %let stw = %str(); %let invars = %str(term0_ term1_ term2_ termw_); %let outvars = %str(ntotal_ sum1_ sum2_ sumw_); %if %length(&phat) > 0 %then %do; %let var = %str(&phat*(1-&phat)); %end; %if &optfixw ne 0 %then %do; %let stringwt = %str(&wi/sum_); %let stw = %str(/wt_); data tot_; set &dset end = eof; sum_ + &wi; if eof = 1 then output; keep sum_; data &dset; set &dset; if _n_ = 1 then set tot_; wt_ = &stringwt; drop sum_; %end; %if %length(&minsamp) = 0 %then %let minsamp = 2; data w_; set &dset; term0_ = &npop; term1_ = &npop*sqrt(&var); term2_ = &npop*&var; termw_ = &npop**2*&var&stw; %if &typopt > 0 or &optfixc > 0 %then %do; %let labc = &strc; %let invars = %str(term0_ term1_ term2_ term3_ term4_ termw_); %let outvars = %str(ntotal_ sum1_ sum2_ sum3_ sum4_ sumw_); term3_ = &npop*sqrt(&var/&cost); term4_ = &npop*sqrt(&var*&cost); %end; proc means data = w_ noprint; var &invars; output out = size_ sum = &outvars; %if &optfixc > 0 %then %do; %let stringwt = %str(term3_/sum3_); %let labc = &strc; %let ttl_ = %str(optimal); %let prvars = %str(&strata &cost &npop wt_ tni_ ni); data size_; set size_; nsize_ = (&maxcost-&overhead)*sum3_/sum4_; nsize_ = int(nsize_); data &outalloc; set w_; if _n_ = 1 then set size_; wt_ = &stringwt; tni_ = nsize_*wt_; ni = round(tni_, 1); if ni > &npop then do; ni = &npop; call symput('flag_','yes'); end; if ni < &minsamp then do; ni = &minsamp; call symput('vlag_','yes'); end; keep &prvars; %printit; %end; %if &optfixn = 0 %then %do; %if %index(%upcase(¶m),MEAN) > 0 %then %let d = %str(&bound**2/4); %if %index(%upcase(¶m),PROP) > 0 %then %let d = %str(&bound**2/4); %if %index(%upcase(¶m),TOTAL) > 0 %then %let d = %str(&bound**2/4/ntotal_**2); %end; %if &typopt > 0 and &optfixc = 0 %then %do; %let labc = &strc; %let stringwt = %str(term3_/sum3_); %let ttl_ = %str(optimal); %let prvars = %str(&strata &cost &npop wt_ tni_ ni); data size_; set size_; %if &optfixn eq 0 %then %do; nsize_ = (sum3_*sum4_)/(ntotal_**2*&d + sum2_); nsize_ = ceil(nsize_); %end; %else %do; nsize_ = &nfixed; %end; data &outalloc; set w_; if _n_ = 1 then set size_; wt_ = &stringwt; tni_ = nsize_*wt_; ni = round(tni_, 1); if ni > &npop then do; ni = &npop; call symput('flag_','yes'); end; if ni < &minsamp then do; ni = &minsamp; call symput('vlag_','yes'); end; keep &prvars; %printit; %end; %if &optfixw > 0 %then %do; %let ttl_ = %str(fixed weights); %let prvars = %str(&strata &npop wt_ tni_ ni); data size_; set size_; nsize_ = sumw_/(ntotal_**2*&d + sum2_); data &outalloc; set w_; if _n_ = 1 then set size_; tni_ = nsize_*wt_; ni = round(tni_, 1); if ni > &npop then do; ni = &npop; call symput('flag_','yes'); end; if ni < &minsamp then do; ni = &minsamp; call symput('vlag_','yes'); end; keep &prvars; %printit; %end; %if &typney ne 0 %then %do; %let stringwt = %str(term1_/sum1_); %let ttl_ = %str(neyman); %let prvars = %str(&strata &npop wt_ tni_ ni); data size_; set size_; %if &optfixn eq 0 %then %do; nsize_ = (sum1_*sum1_)/(ntotal_**2*&d + sum2_); nsize_ = ceil(nsize_); %end; %else %do; nsize_ = &nfixed; %end; data &outalloc; set w_; if _n_ = 1 then set size_; wt_ = &stringwt; tni_=nsize_*wt_; ni = round(tni_, 1); if ni > &npop then do; ni = &npop; call symput('flag_','yes'); end; if ni < &minsamp then do; ni = &minsamp; call symput('vlag_','yes'); end; keep &prvars; %printit; %end; %if &typpro ne 0 %then %do; %let stringwt = %str(term0_/ntotal_); %let ttl_ = %str(proportional); %let prvars = %str(&strata &npop wt_ tni_ ni); data size_; set size_; %if &optfixn eq 0 %then %do; nsize_ = (ntotal_*sum2_)/(ntotal_**2*&d + sum2_); nsize_ = ceil(nsize_); %end; %else %do; nsize_ = &nfixed; %end; data &outalloc; set w_; if _n_ = 1 then set size_; wt_ = &stringwt; tni_ = nsize_*wt_; ni = round(tni_, 1); if ni > &npop then do; ni = &npop; call symput('flag_','yes'); end; if ni < &minsamp then do; ni = &minsamp; call symput('vlag_','yes'); end; keep &prvars; %printit; %end; run; title; %mend alloc;