*! version 1.0.1  24apr1996
program define svyprop
	version 4.0
	local varlist "req ex"
	local weight "pweight iweight noprefix"
	local if "opt"
	local in "opt"
	#delimit ;
	local options "STRata(str) PSU(str) FPC(str) BY(str)
		       SUBpop(str) noLABel FORmat(str)" ;
	#delimit cr
	parse "`*'"
	if "`format'"=="" { local format "%9.6f" }

	tempvar doit nh

/* Get weights. */

	if "`exp'"=="" {
		var_get pweight `exp', optional
		local exp "$S_1"
	}
	else if "`weight'"=="pweight" { /* try to varset pweight variable */
		capture confirm variable `exp'
		if _rc==0 {
			var_get pweight `exp'
			local exp "$S_1"
		}
	}
	if "`exp'"!="" {
		if "`weight'"=="" { local weight "pweight" }
	}

/* Generate weights if necessary. */

	capture confirm variable `exp'
	if _rc {
		tempvar w
		if "`exp'"=="" { qui gen byte   `w' = 1 } 
		else		 qui gen double `w' = `exp'
	}
	else local w "`exp'"

/* Get strata, psu, and fpc. */

	var_get strata `strata', optional
	local strata "$S_1"
	capture confirm string variable `strata'
	if _rc { local mstrata "`strata'" }

	var_get psu `psu', optional
	local psu "$S_1"
	capture confirm string variable `psu'
	if _rc { local mpsu "`psu'" }
	
	var_get fpc `fpc', optional
	local fpc "$S_1"

/* Process by() option. */

	if "`by'"!="" {
		unabbrev `by'
		local by "$S_1"
	}

/* Mark. */

	mark `doit' `if' `in'
	
/* Check for negative weights if pweights. */

	if "`weight'"=="pweight" {
		capture assert `w' >= 0 if `doit'
		if _rc { error 402 }
	}
	
/* Markout. */
	
	markout `doit' `w' `mstrata' `mpsu' `fpc' `varlist' `by'

	capture confirm string variable `strata'
	if _rc==0 { /* markout string `strata' */
		qui replace `doit' = 0 if trim(`strata')==""
	}
	capture confirm string variable `psu'
	if _rc==0 { /* markout string `psu' */
		qui replace `doit' = 0 if trim(`psu')==""
	}

/* Process subpop() option. */

	if "`subpop'"!="" {
		tempvar sub
		capture gen byte `sub' = (`subpop') if `doit'
		if _rc {
			if _rc != 902 {
				di in red "error in expression in " /*
				*/ "subpop() option"
			}
			noisily error _rc
		}
		local andsub "& `sub'"
	}

/* Compute nh, etc. */

	Gen_nh `doit' `w' "`sub'" "`strata'" "`psu'" "`fpc'" `nh'

/* Display header. */

	Header "`weight'" "`exp'" "`strata'" "`psu'" "`fpc'" "`subpop'"

/* No by(). */

	if "`by'"=="" {
		Prop `doit' `w' "`sub'" "`strata'" "`psu'" `nh' /*
		*/	"`label'" `format' `varlist'
		exit
	}

/* If here, we have by() subpopulations. */

	tempvar first bysub
	sort `doit' `sub' `by'
	qui by `doit' `sub' `by': gen byte `first' = /*
	*/	(_n==1 & `doit' `andsub')
	qui gen byte `bysub' = . in 1  /* so replace auto promotes */
	qui replace `bysub' = sum(`first')
	local nby = `bysub'[_N]

	local i 1
	while `i' <= `nby' {
		_crcbygr `by' if `bysub'==`i' & `first'
		Prop `doit' `w' (`bysub'==`i') "`strata'" "`psu'" `nh' /*
		*/	"`label'" `format' `varlist'
		local i = `i' + 1
	}
end

program define Gen_nh
	version 4.0
	local doit   "`1'"  /* Input: mark   variable */
	local w      "`2'"  /* Input: weight variable */
	local sub    "`3'"  /* Input: subpop variable */
	local strata "`4'"  /* Input: strata variable */
	local psu    "`5'"  /* Input: psu    variable */
	local fpc    "`6'"  /* Input: fpc    variable */
	local nh     "`7'"  /* Output: nh    variable */

	quietly {

	/* Compute total #obs. */

		count if `doit'
		if _result(1) == 0 { noisily error 2000 }
		local nobs = _result(1)
	
	/* Compute subpopulation #obs. */

		if "`sub'"!="" {
			count if `sub' & `doit'
			if _result(1) == 0 {
				di in red "subpop() has no observations"
				exit 2000
			}
			local osub = _result(1)
		}
	
	/* Sort by strata, PSU, and weights. */

		sort `doit' `strata' `psu' `w'

	/* Compute total #strata. */
	
		by `doit' `strata': gen byte `nh' = (_n==1) if `doit'
		count if `nh' == 1
		local nstr = _result(1)
		
	/* `nh' = #PSU in stratum h */
	
		if "`psu'"!="" {
			by `doit' `strata' `psu': replace `nh' = (_n==1) /*
			*/	if `doit'
		}
		else { /* observations are PSUs */
			replace `nh' = 1 if `doit'
		}

	/* Compute total #PSU. */

		count if `nh' == 1
		local npsu = _result(1)

	/* Finish `nh' computation.  Note: automatic promotion of type. */

		by `doit' `strata': replace `nh' = sum(`nh') if `doit'
		by `doit' `strata': replace `nh' = `nh'[_N]

	/* Check if `nh' >= 2. */ 

		capture assert `nh' >= 2 if `doit'
		if _rc {
			di in red "stratum with only one PSU detected"
			exit 499
		}

	/* Check fpc variable for sensible ranges. */

		if "`fpc'"!="" {
			CheckFPC `doit' `strata' `fpc' `nh'
				/* this returns FPC term in S_1 */
			global S_7 "$S_1*(`nh'/(`nh'-1))"
		}
		else global S_7 "(`nh'/(`nh'-1))"

	/* Sum weights over population and subpopulation. */
		
		tempname npop
		GenSum `npop' `doit'*`w'

		if "`sub'"!="" {
			tempname nsub
			GenSum `nsub' `sub'*`w'
		}
	}
	
/* Save macros. */

	global S_1 "`nobs'"
	global S_2 "`nstr'"
	global S_3 "`npsu'"
	global S_4 = `npop'
	if "`sub'"!="" {
		global S_5 "`osub'"
		global S_6 = `nsub'
	}
end

program define Prop
	version 4.0
	local doit   "`1'"
	local w      "`2'"
	local sub    "`3'"
	local strata "`4'"
	local psu    "`5'"
	local nh     "`6'"
	local label  "`7'"
	local format "`8'"
	macro shift 8

	tempvar d r yh nhsub
	tempname x varx

	if "`sub'"=="" { local sub 1 }

	quietly {

	/* Sort by strata and PSU first. */

		sort `doit' `strata' `psu' `w'

	/* Sum weights over (sub)population. */

		GenSum `x' `sub'*`doit'*`w'

	/* Sum weights over strata and psu. */
	
		GenSumBy `d' `sub'*`w' `doit' `strata'
		
		if "`psu'"!="" {
			tempvar xhi
			GenSumBy `xhi' `sub'*`w' `doit' `strata' `psu'
			replace `d' = `xhi'-`d'/`nh'

			by `doit' `strata' `psu': replace `xhi' = /*
			*/	(_n==1 & `doit')
			GenSum `varx' `xhi'*$S_7*`d'^2
			drop `xhi'
		}
		else {
			replace `d' = `sub'*`w'-`d'/`nh'
			GenSum `varx' `doit'*$S_7*`d'^2
		}
		
	/* Sort by varlist first. */

		sort `doit' `*' `strata' `psu' `w'

	/* Sum weights by varlist. */
	
		GenSumBy `r' `sub'*`w' `doit' `*'
		
		replace `r' = `r'/`x'

	/* Sum weights over varlist by strata, and PSU. */

		GenSumBy `yh' `sub'*`w' `doit' `*' `strata'
		
		if "`psu'"!="" {
			tempvar yhi
			GenSumBy `yhi' `sub'*`w' `doit' `*' `strata' `psu'
			by `doit' `*' `strata' `psu': gen byte `nhsub' = (_n==1)
			replace `yhi' = . if `nhsub'==0 | `doit'==0
		}
		else {
			local yhi "`sub'*`w'"
			gen byte `nhsub' = 1
		}
		
		by `doit' `*' `strata': replace `nhsub' = sum(`nhsub') if `doit'
		by `doit' `*' `strata': replace `nhsub' = `nhsub'[_N]

		replace `yh' = $S_7*((`yhi'-`yh'/`nh'-`r'*`d')^2 + /*
		*/ `yh'^2/(`nh'*`nhsub') - (`yh'/`nh'+`r'*`d')^2)

		drop `d'
		GenSumBy `d' `yh' `doit' `*'
		replace `d' = sqrt(`d' + `varx'*`r'^2)/`x'
		
		by `doit' `*': replace `nhsub' = /*
		*/	cond(_n==_N & `doit', sum(`sub'), .)
	}

	format `nhsub' %8.0f
	format `r' `d' `format'
	
	capture noisily {
		rename `nhsub' _Obs
		rename `r' _EstProp
		rename `d' _StdErr
	
		list `*' _Obs _EstProp _StdErr if _Obs!=., /*
		*/	noobs nodisp `label'
	}
	nobreak {
		local rc = _rc
		capture drop _Obs
		capture drop _EstProp
		capture drop _StdErr
		if `rc' { error `rc' }
	}
end

program define CheckFPC
	version 4.0
	local doit   "`1'"
	local strata "`2'"
	local fpc    "`3'"
	local nh     "`4'"
	
	capture assert `fpc' >= 0 if `doit'
	if _rc {
		di in red "fpc() must be >= 0"
		exit 499
	}
	capture by `doit' `strata': assert abs((`fpc' - `fpc'[1]) /*
	*/	/max(`fpc'[1],1)) < 1e-5 if `doit'
	if _rc {
		di in red "all observations within a stratum must have " /*
		*/ "the same fpc() value"
		exit 499
	} 
	capture assert `fpc' >= `nh' if `doit'
	if _rc {
		capture assert `fpc' <= 1 if `doit'
		if _rc {
			di in red "fpc() must be <= 1 if a rate " /*
			*/ "or >= # sampled PSUs per stratum" 
			exit 499
		}
		else global S_1 "(1-`fpc')*"
	}
	else global S_1 "(1-`nh'/`fpc')"
end

program define GenSum  /* scalarname expression */
	version 4.0
	local s "`1'"
	macro shift
	tempvar y e
	quietly {
		gen double `y' = sum(`*')
		gen double `e' = sum((`*')-(`y'-`y'[_n-1])) in 2/l
		scalar `s' = `y'[_N] + `e'[_N]
	}
end

program define GenSumBy  /* varname_to_hold_sum expression_to_sum by_varlist */
	version 4.0
	local s "`1'"
	local x "`2'"
	macro shift 2
	tempvar e
	quietly {
		by `*': gen double `s' = sum(`x')
		by `*': gen double `e' = sum((`x')-(`s'-`s'[_n-1]))
		by `*': replace `s' = `s'[_N] + `e'[_N]
	}
end

program define Header /* display header */
	version 4.0
	local wgt    "`1'"
	local exp    "`2'"
	local strata "`3'"	
	local psu    "`4'"
	local fpc    "`5'"
	local subpop "`6'"
	local nobs   "$S_1"
	local nstr   "$S_2"
	local npsu   "$S_3"
	local npop   "$S_4"
	local osub   "$S_5"
	local nsub   "$S_6"
		
	if "`wgt'"    == "" { local wgt    "pweight"        }
	if "`exp'"    == "" { local exp    "<none>"         }
	if "`strata'" == "" { local strata "<one>"          }
	if "`psu'"    == "" { local psu    "<observations>" }

	di _n in gr _dup(78) "-"
	
	#delimit ;
	di in gr "`wgt':" _col(11) "`exp'"
	   in gr _col(49) "Number of obs`fnote'" _col(68) "= "
	   in ye %9.0f `nobs' _n
	   in gr "Strata:" _col(11) "`strata'"
	   in gr _col(49) "Number of strata" _col(68) "= "
	   in ye %9.0f `nstr' _n
	   in gr "PSU:" _col(11) "`psu'"
	   in gr _col(49) "Number of PSUs" _col(68) "= "
	   in ye %9.0f `npsu' ; 

	if "`fpc'"!="" { ;
		di in gr "FPC:" _col(11) "`fpc'"
		   in gr _col(49) "Population size" _col(68) "="
		   in ye %10.0g `npop' ;
	} ;
	else { ;
		di in gr _col(49) "Population size" _col(68) "="
		   in ye %10.0g `npop' ;
	} ;
	if "`subpop'"!="" { ;
		di in gr "Subpop.:" _col(11) "`subpop'"
		   _col(49) "Subpop. no. of obs" _col(68) "= "
		   in ye %9.0f `osub' _n
		   in gr _col(49) "Subpop. size" _col(68) "="
		   in ye %10.0g `nsub'
	} ;
	di in gr _dup(78) "-" _n(2) "Survey proportions estimation" ;
end ;