*! version 1.0.2  11jan1995                             STB-24: dm27
program define coll2
	version 4.0
	parse "`*'", parse("=,[] ")

	local n 1
	local fcn "mean"
	iskey `1'
	while $S_1==0 {
		if substr("`1'",1,1)=="(" {		/* is typespec */
			typespec "`1'"
			local fcn "$S_1"
			mac shift
		}
		else if "`2'"=="=" { 	/* is neworoldvarname=oldvarname */
			v_eq_v `1' `3'
			local keep "`keep' $S_1"
			local tar "`tar' $S_2"
			local old`n' "$S_1"
			local fcn`n' "`fcn'"
			local new`n' "$S_2"
			local n = `n'+1
			mac shift 3
		}
		else {			/* varlist */
			local list "`1'"
			mac shift
			iskey "`1'"
			while $S_1==0 & substr("`1'",1,1)!="(" & "`2'"!="=" {
				local list "`list' `1'"
				mac shift
				iskey "`1'"
			}
			local varlist "req ex" 
			parse "`list'"
			local i 1
			local vi : word `i' of `varlist'
			while "`vi'" != "" {
				local keep "`keep' `vi'"
				local tar "`tar' `vi'"
				local old`n' "`vi'"
				local fcn`n' "`fcn'"
				local new`n' "`vi'"
				local n=`n'+1
				local i=`i'+1
				local vi : word `i' of `varlist'
			}
		}
		iskey `1'
	}
	local n=`n'-1
	if `n'==0 { error 198 }

	local varlist
	local if "opt"
	local in "opt"
	local weight "aweight fweight"
	local options "BY(string) CW"
	parse "`*'"
	if "`by'"!="" { 
		unabbrev `by'
		local by "$S_1"
		bynottar "`by'" "`tar'"
	}

	if "`weight'" != "" { 
		tempvar w
		qui gen `w' `exp' `if' `in'
		local wgt "[`weight'=`w']"
	}
	tempvar touse
	mark `touse' `if' `in' `wgt' 
	if "`cw'"!="" {
		markout `touse' `keep'
	}

	preserve
	qui keep if `touse'
	qui keep `keep' `by' `w'

					/* check uniqueness */
/*
Table:
	old`i'	(original) name of source variable		x
	use`i'  renamed old`i' 
	new`i'  target variable					x
	drp`i'  =use`i' if may be dropped, else " "
	fcn`i'  function to call				x
*/
	local i 1
	while `i' <= `n' {
		if "`drp`i''"=="" {
			tempname use
			local use`i' "`use'"
			rename `old`i'' `use'
			local lasti `i'
		}
		local j=`i'+1
		while `j'<=`n' {
			if "`new`i''" == "`new`j''" {
				di in red "error:" _n /*
				*/ _col(8) "`new`i'' = (`fcn`i'') `old`i''" /*
				*/ _n /*
				*/ _col(8) "`new`j'' = (`fcn`j'') `old`j''" /*
				*/ _n "name conflict"
				exit 198
			}
			if "`drp`i''"=="" & "`old`i''" == "`old`j''" {
				local lasti `j'
				local use`j' "`use'"
				local drp`j' " "
			}
			local j=`j'+1
		}
		if "`drp`i''"=="" {
			local drp`lasti' "`use'"
		}
		local i=`i'+1
	}

	quietly { 
		tempvar new
		local i 1
		while `i'<=`n' { 
			_`fcn`i'' `new`i'' `use`i'' "`weight'" "`w'" "`by'"
			capture drop `drp`i''
			label var `new`i'' "(`fcn`i'') `old`i''"
			local i=`i'+1
		}
	}
	if "`by'" != "" {
		sort `by'
		quietly by `by': keep if _n==_N
	}
	else	quietly keep in 1

	restore, not
end


program define bynottar /* "byvars" "targetvars" */
	version 4.0 
	local byvars "`1'"
	parse "`2'", parse(" ")
	local i 1 
	local byv : word `i' of `byvars'
	while "`byv'" != "" { 
		local j 1
		while "``j''" != "" {
			if "`byv'"=="``j''" { 
				di in red /*
				*/ "``j'' may not be both target and by()"
				exit 198
			}
			local j=`j'+1
		}
		local i=`i'+1
		local byv : word `i' of `byvars'
	}
end




program define v_eq_v /* neworoldvar oldvar */
	version 4.0
	unabbrev `2'
	local one "$S_1"
	capture confirm var `1'
	if _rc { 
		capture confirm new var `1'
		if _rc { 
			di in red "`1' invalid variable name"
			exit 198
		}
	}
	global S_2 "`1'"
end


program define typespec /* <typespec> ) */
	version 4.0 
	parse "`*'", parse("() ")
	if "`3'" != ")" {
		unexpect "`3'" quote ")"
		/*NOTREACHED*/
	}
	global S_1 "`2'"
	if "`2'"=="mean" | "`2'"=="sd" | "`2'"=="sum" | "`2'"=="rawsum" { exit }
	if "`2'"=="count" | "`2'"=="max" | "`2'"=="min" { exit } 
	if "`2'"=="iqr" { exit }
	if "`2'"=="median" {
		global S_1 "p 50"
		exit 
	}
	if substr("`2'",1,1)=="p" { 
		local x = real(substr("`2'",2,.))
		if `x'>=1 & `x'<=99 & `x'==int(`x') {
			global S_1 "p `x'"
			exit
		}
	}
	unexpect "`2'" noquote "mean, sd, etc." 
	/*NOTREACHED*/
end



program define unexpect /* <what_found> {quote|noquote} <what_expected> */
	version 4.0
	if "`2'"=="quote" { 
		local q "_quote"
	}
	di in red _quote "`1'" _quote " found where " /*
		*/ `q' "`3'" `q' " expected"
	exit 198
end

program define iskey 
	version 4.0
	global S_1 1
	if "`1'"=="" | "`1'"=="[" | "`1'"=="," { exit }
	if "`1'"=="if" | "`1'"=="in" { exit }
	global S_1 0
end


/* routines for calculating statistics */


program define _mean /* newvar oldvar wtype wvar byvars */
	version 4.0
	local y  "`1'"
	local x  "`2'"
	local wt  "`3'"
	local w   "`4'"
	local by  "`5'"

	if "`w'"=="" {
		local w 1
	}
	if "`by'" != "" {
		sort `by'
		local by "by `by':"
	}

	quietly {
		`by' gen `y' = sum(`w'*`x')/sum(cond(`x'!=.,`w',0))
		`by' replace `y' = `y'[_N]
	}
end

program define _sd /* newvar oldvar wtype wvar byvars */
	version 4.0
	local y "`1'"
	local x "`2'"
	local wt  "`3'"
	local w   "`4'"
	local by  "`5'"
	
	if "`w'"=="" {
		local w 1
	}
	if "`by'" != "" {
		sort `by'
		local by "by `by':"
	}

	quietly {
		if "`wt'"=="aweight" {
			tempvar new
			remakew `x' `w' `new' "`by'"
			local w "`new'"
		}

		tempvar m
		`by' gen double `m' = sum(`w'*`x')/sum(cond(`x'!=.,`w',0))
		`by' gen `y' = sqrt( /*
				*/ sum(((`w'*`x')-`m'[_N])^2) / /*
				*/ sum(cond(`x'!=.,`w',0)-1)
				*/ )
		`by' replace `y' = `y'[_N]
	}
end

program define _sum
	version 4.0

	local y "`1'"
	local x "`2'"
	local wt  "`3'"
	local w   "`4'"
	local by  "`5'"
	
	if "`w'"=="" {
		local w 1
	}
	if "`by'" != "" {
		sort `by'
		local by "by `by':"
	}

	quietly {
		if "`wt'"=="aweight" {
			tempvar new
			remakew `x' `w' `new' "`by'"
			local w "`new'"
		}
		`by' gen `y' = sum(`w'*`x')
		`by' replace `y' = `y'[_N]
	}
end

program define _rawsum
	version 4.0

	local y "`1'"
	local x "`2'"
	local wt  "`3'"
	local w   "`4'"
	local by  "`5'"
	
	if "`by'" != "" {
		sort `by'
		local by "by `by':"
	}

	quietly {
		`by' gen `y' = sum(`x')
		`by' replace `y' = `y'[_N]
	}
end

program define _count
	version 4.0

	local y "`1'"
	local x "`2'"
	local wt  "`3'"
	local w   "`4'"
	local by  "`5'"
	
	if "`by'" != "" {
		sort `by'
		local by "by `by':"
	}

	quietly {
		if "`wt'"=="fweight" {
			`by' gen `y' = sum(cond(`x'!=.,`w',0))
		}
		else	`by' gen `y' = sum(`x'!=.)
		`by' replace `y' = `y'[_N]
	}
end
			

program define _max
	version 4.0

	local y "`1'"
	local x "`2'"
	local wt  "`3'"
	local w   "`4'"
	local by  "`5'"

	tempvar touse
	quietly {
		gen byte `touse' = (x != `.')
		sort `by' `touse' `x'
		if "`by'" != "" {
			by `by': gen `y' = `x'[_N]
		}
		else	gen `y' = `x'[_N]
	}
end

program define _min
	version 4.0

	local y "`1'"
	local x "`2'"
	local wt  "`3'"
	local w   "`4'"
	local by  "`5'"

	tempvar touse revx
	quietly {
		gen byte `touse' = (`x'!=.)
		gen `revx' = -`x'
		sort `by' `touse' `revx'
		if "`by'" != "" {
			by `by': gen `y' = `x'[_N]
		}
		else	gen `y' = `x'[_N]
	}
end


program define _p 
	version 4.0

	local p "`1'"
	local y "`2'"
	local x "`3'"
	local wt  "`4'"
	local w   "`5'"
	local by  "`6'"

	tempvar touse i n g
	quietly {
		gen byte `touse' = `x'!=.
		sort `by' `touse' `x'

		if "`w'"=="" {
			local w 1
		}
		else {
			tempvar new 
			if "`by'" !="" {
				remakew `x' `w' `new' "by `by':"
			}
			else	remakew `x' `w' `new'
			local w "`new'"
		}

		by `by' `touse': gen double `n' = sum(`w') if `touse'
		by `by' `touse': /*
			*/ gen double `g' = `n'*`p'/100 if `touse' & _n==_N
		gen long `i' = .
		by `by' `touse': /*
			*/ replace `i'=cond(`i'[_n-1]!=.,`i'[_n-1], /*
			*/ 	cond(`n'-`g'[_N]>.01,_n,.)) if `touse'
		by `by' `touse': /*
			*/ gen `y' = cond(`g'- `n'[`i'-1] >.01, /*
			*/	`x'[`i'], (`x'[`i'-1]+`x'[`i'])/2) /*
			*/	if `touse' & _n==_N

		if "`by'" != "" {
			by `by': replace `y' = `y'[_N]
		}
		else	replace `y' = `y'[_N]
	}
end

program define _iqr
	version 4.0

	local y "`1'"
	local x "`2'"
	local wt  "`3'"
	local w   "`4'"
	local by  "`5'"

	tempvar p75 p25
	_p 75 `p75' `x' "`wt'" "`w'" "`by'"
	_p 25 `p25' `x' "`wt'" "`w'" "`by'"
	quietly gen `y' = `p75' - `p25'
end

/* utilities used by _* routines */


program define remakew /* xvar oldw neww by-prefix */
	version 4.0
	local x "`1'"
	local w "`2'"
	local new "`3'"
	local by "`4'"		/* form is "" or "by vn vn ...:" */

	tempvar sum obs 
	`by' gen long `obs' = sum(`x'!=.)
	`by' gen double `sum' = sum(cond(`x'!=.,`w',0))
	`by' gen double `new' = cond(`x'!=., `w'*`obs'[_N]/`sum'[_N], .) 
end