*! version 1.3.0  7Oct98    STB-46 sg89.2 fix for var=-#
program define adjust
	version 5.0

* Syntax:
* adjust var[= #] [var[= #] ...] [if exp] [in range] , by(varlist)
*     [generate(var [var]) {xb | pr} {stdp | stdf | noerror} xblabel prlabel
*      stdplabel stdflabel <tabdisp options>]
*
* Where the allowed tabdisp options are: format(%fmt) center left cellwidth(#)
*     csepwidth(#) scsepwidth(#) stubwidth(#)

	local ecmd "$S_E_cmd"
	CheckCmd `ecmd'   /* check the estimation command we follow */

	GetbName "`ecmd'"
	local bnames "$S_1"  /* var names from estimation coefficient vec. */

	/* Non standard parsing due to var[= #][var[= #]...]
	   This next command splits it into two parts: the varlist part
	   (com = $S_1) and the rest (opt = $S_2).
	*/
	SplitIt `*'
	local com "$S_1"
	local opt "$S_2"

	/* Non standard parsing of the varlist */
	ParseVar `com'
	local covars "$S_1"    /* Covariates to be set */
	local covals "$S_2"    /* Values to set the covariates or "mean" */
	CheckVar "`covars'" "`bnames'"  /* error if covars not in bnames */

	/* standard parsing for the opt part of the command */
	local if "optional"
	local in "optional"
	local options "BY(string) Generate(string) XB Pr STDF STDP noError"
	local options "`options' XBLABel(string) PRLABel(string)"
        local options "`options' STDPLABel(string) STDFLABel(string)"
	/* Now add the allowed tabdisp options */
	local options "`options' CENter Left Format(string)"
	local options "`options' CELLWidth(string) STUBWidth(string)"
	local options "`options' CSEPwidth(string) SCSEPwidth(string)"
	parse "`opt'"

	/* Pull all the tabdisp options into one local variable */
	local tabopts "`center' `left'"
	if "`format'" != "" { local tabopts "`tabopts' f(`format')" }
	if "`cellwid'" != "" { local tabopts "`tabopts' cellw(`cellwid')" }
	if "`stubwid'" != "" { local tabopts "`tabopts' stubw(`stubwid')" }
	if "`csepwid'" != "" { local tabopts "`tabopts' csepw(`csepwid')" }
	if "`scsepwi'" != "" { local tabopts "`tabopts' scsep(`scsepwi')" }

	CheckBy `by'
	local by "$S_1"      /* the by vars  */
	Subtract "`by'" "`covars'"
	local bynotc "$S_1"  /* the by vars not in covars list */
	Subtract "`by'" "`bynotc'"
	local byinc "$S_1"   /* the by vars in the covars list */
	Subtract "`bnames'" "`covars' `by'"
	local asis "$S_1"    /* variables left as is */

	/* mark the sample */
	tempvar touse
	mark `touse' `if' `in'
	markout `touse' `bnames'
	markout `touse' `by' , strok
	qui count if `touse'
	if _result(1) == 0 { error 2000 }   /* need observations */

	CheckSTD "`xb' `pr'" "`stdf' `stdp'" "`error'" "`ecmd'"
	local stdopt "$S_1"  /* either stdp, stdf, or null */
	local ipopt "$S_2"   /* either xb or pr */

	if "`stdopt'" == "stdp" {
		if "`stdplab'" == "" { local stdlab "S.E." }
		else { local stdlab "`stdplab'" }
	}
	else if "`stdopt'" == "stdf" {
		if "`stdflab'" == "" { local stdlab "S.E.(f)" }
		else { local stdlab "`stdflab'" }
	}

	if "`ipopt'" == "pr" {
		if "`prlabel'" == "" { local iplab  "P" }
		else { local iplab "`prlabel'" }
	}
	else if "`ipopt'" == "xb" {
		if "`xblabel'" == "" { local iplab  "xb" }
		else { local iplab "`xblabel'" }
	}

	CheckGen "`generat'" "`stdopt'"
	local ngen "$S_1"    /* number of generate variables */
	local gen1 "$S_2"    /* 1st generate var (for xb or pr) */
	local gen2 "$S_3"    /* 2nd generate var (for stdp or stdf) */
	if `ngen' == 0 {  /* prediction and error vars are temporary */
		tempvar tmppred
		local gen1 `tmppred'
		if "`stdopt'" != "" {
			tempvar tmperr
			local gen2 `tmperr'
		}
	}
	else if `ngen' == 1 & "`stdopt'" != "" { /* error var is temporary */
		tempvar tmperr
		local gen2 `tmperr'
	}

	/* preliminary set up if we are generating variables  */
	if `ngen' > 0 {  /* find sort order and make id -- for future merge */
		local sorted : sortedby
		tempvar id
		gen long `id' = _n
		qui compress `id'
		capture confirm new variable _merge
		if _rc != 0 {
			di in red "_merge already defined, drop before running"
			exit _rc
		}
	}

	/* cut the data set down to essential elements */
        preserve
	qui keep if `touse'
	keep `bnames' `by' `id'

	/* set up temporary variables for by vars that are also covars */
	local newby "`bynotc'"
	parse "`byinc'", parse(" ")
	local i 1
	while "``i''" != "" {
		tempvar tmp`i'
		gen `tmp`i'' = ``i''
		local tlab : variable label ``i''
		if "`tlab'" == "" { local tlab "``i''" }
		label var `tmp`i'' "`tlab'"
		local vlab : value label ``i''
		label val `tmp`i'' `vlab'
		local newby "`newby' `tmp`i''"
		local i = `i' + 1
	}

	/* set the covars equal to the covals  */
	SetCovs "`covars'" "`covals'"
	local thevals "$S_1"

	/* Under certain commands have to generate _inter=1 */
	if "`ecmd'" == "corc" | "`ecmd'" == "hlu" | "`ecmd'" == "prais" {
		gen _inter = 1
	}

	/* get the predictions (and errors if required)  */
	if "`ipopt'" == "xb" { predict `gen1', xb }
	else if "`ipopt'" == "pr" { predict `gen1' }
	label var `gen1' "`iplab'"
	if "`stdopt'" != "" {
		predict `gen2', `stdopt'
		label var `gen2' "`stdlab'"
	}

	/* If we created _inter then remove it */
	if "`ecmd'" == "corc" | "`ecmd'" == "hlu" | "`ecmd'" == "prais" {
		drop _inter
	}

	/* display some table header info  */
	Header "`iplab'" "`stdlab'" "`generat'" "`asis'" "`by'" "`covars'" /*
		*/ "`covals'" "`thevals'"

	/* create and display the table of results  */
	DoTable "`newby'" "`gen1'" "`gen2'" "`iplab'" "`stdlab'" "`tabopts'"

	/* If we generated vars then merge them in original sorted order */
	if `ngen' > 0 {
		keep `id' `generat'
		sort `id'
		tempfile hold
		qui save "`hold'"
		restore, preserve
		sort `id'
		merge `id' using "`hold'"
		drop _merge
		if "`sorted'" != "" { sort `sorted' }
		restore, not
	}
end


* CheckBy expands and checks the by() option variables which are passed on
* the command line.  The expanded by vars are returned in $S_1, the number
* of by vars in $S_2.  The by variables are also checked for repeats and an
* error issued.
program define CheckBy   /* <byvars>  */
	version 5.0

	/* expand the by vars checking for too many */
	local maxby 7   /* 7 because of tabdisp */
	capture noi unabbrev `*' , min(1) max(`maxby')
	if _rc != 0 {
		di in red "by() option required (maximum of `maxby' variables)"
		exit 100
	}
	local bylist "$S_1"

	/* check for repeats in the by vars */
	capture Repeats `bylist'
	if "$S_1" != "" {
		di in red "$S_1: specified twice in the by option"
		exit 198
	}

	global S_1 "`bylist'"
end


* CheckCmd is passed a string which should be the name of the estimation
* command last run (if any).  This program checks that it is one of the
* accepted estimation commands.
program define CheckCmd   /* <estcmd> */
	version 5.0

	if "`*'" == "" {
		di in red "This command must follow an estimation command"
		exit 301
	}

	/* check that it is one of the accepted ones */
	#delimit ;
	if	  "`*'"=="blogit"
		| "`*'"=="bprobit"
		| "`*'"=="boxcox"
		| "`*'"=="bsqreg"
		| "`*'"=="clogit"
		| "`*'"=="cnreg"
		| "`*'"=="cnsreg"
		| "`*'"=="corc"
		| "`*'"=="cox"
		| "`*'"=="dprobit"
		| "`*'"=="ereg"
		| "`*'"=="eivreg"
		| "`*'"=="fit"
		| "`*'"=="glogit"
		| "`*'"=="glm"
		| "`*'"=="gprobit"
		| "`*'"=="hlu"
		| "`*'"=="intreg"
		| "`*'"=="logistic"
		| "`*'"=="logit"
	{ ;
		local ok "true" ;
	} ;
	/* had to split -if- into two parts because of length */
	if	  "`*'"=="newey"
		| "`*'"=="ologit"
		| "`*'"=="oprobit"
		| "`*'"=="poisson"
		| "`*'"=="prais"
		| "`*'"=="probit"
		| "`*'"=="qreg"
		| "`*'"=="regdw"
		| "`*'"=="regress"
		| "`*'"=="rreg"
		| "`*'"=="stcox"
		| "`*'"=="svylogit"
		| "`*'"=="svyprobt"
		| "`*'"=="svyreg"
		| "`*'"=="tobit"
		| "`*'"=="vwls"
		| "`*'"=="xtgee"
		| "`*'"=="xtgls"
		| "`*'"=="xtpois"
		| "`*'"=="xtprobit"
		| "`*'"=="xtreg"
	{ ;
		local ok "true" ;
	} ;
	#delimit cr

	if "`ok'" != "true" {
		di in red "This command currently not allowed following `*'"
		exit 301
	}

/*
The following explains why this command will not follow certain estimation
commands.

anova -- While -anova- does use -regress- it handles the naming in a
         non-convential way.  So it is impossible to get the variable names
         from the _b vector which is needed by this routine.

areg  -- the variable specified in the -absorb()- required option does not
         have it's betas computed and so that variable is not handled as we
         might think by -predict-.  If we allowed this command the results
         produced would not be what is expected.

canon, gnbreg, heckman, mlogit, mvreg, nbreg, stweib, sureg, weibull --
         are multiple-equation models and are not currently supported.

*/
end


* CheckGen checks the generate() vars and returns the number of vars in
* $S_1, the first var name in $S_2, and the second in $S_3.  CheckGen also
* checks to see if stdopt was set and 2 variables specified.  If so it is an
* error.
program define CheckGen  /* <genvars> <stdopt> */
	version 5.0

	local genvars `1'
	local stdopt `2'

	local ngen 0
	if "`genvars'"!="" {
		confirm new variable `genvars'
		local ngen : word count `genvars'
		if `ngen' > 2 {
			di in red "one or two variables allowed in generate()"
			exit 198
		}
		local gen1 : word 1 of `genvars'
		if `ngen' == 2 { local gen2 : word 2 of `genvars' }
	}

	if "`stdopt'" == "" & `ngen' == 2 {
		di in red "`gen2' not allowed, stdf or stdp was not specified"
		exit 198
	}

	global S_1 "`ngen'"
	global S_2 "`gen1'"
	global S_3 "`gen2'"
end


* CheckSTD is passed: the xb or pr options (which might be null); the stdp or
* stdf options (which might be null); the noerror option; and the name of the
* estimation command.  Only one of xb or pr are allowed.  Only one of stdp,
* stdf, or noerror are allowed.  If stdf then we check that the estimation
* command supports it.  If pr then we check that the estimation command
* supports it.  If pr we also check that neither stdp nor stdf are used.  The
* defaults are xb and stdp.  Either stdp, stdf, or null are passed back in
* S_1.  Either xb or pr are passed back in S_2.
program define CheckSTD /* <xb or pr or null> <stdp or stdf or null>
                           <noerror or null> <ec> */
        version 5.0

        local ip `1'
        local std `2'
        local ne `3'
        local ec `4'

	local defip "xb"     /* default is xb */
	local defstd "stdp"     /* default is stdp  */

	/* determine if xb or pr (error if both) */
        parse "`ip'", parse(" ")
        if "`1'" != "" & "`2'" != "" {
                di in red "only one of xb and pr may be specified"
                exit 198
        }
        if "`1'" == "" & "`2'" == "" { local theip "`defip'" }
        else { local theip "`1'" }

        /* if pr check to see if valid for estimation command */
        if "`theip'" == "pr" {
                /* pr is only valid after certain estimation commands */
                #delimit ;
                if "`ec'"!="blogit" & "`ec'"!="bprobit" & "`ec'"!="dprobit" &
                   "`ec'"!="logistic" & "`ec'"!="logit" & "`ec'"!="mlogit" &
                   "`ec'"!="probit" { ;
                        di in red "pr invalid option after `ec' command" ;
                        exit 198 ;
                } ;
                #delimit cr
        }

        /* if "noerror" check that user did not say stdp or stdf */
        if "`ne'" == "noerror" & trim("`std'") != "" {
                di in red "can not specify both noerror and `std'"
                exit 198
        }

        /* determine if stdp or stdf (error if both) */
        parse "`std'", parse(" ")
        if "`1'" != "" & "`2'" != "" {
                di in red "only one of stdf and stdp may be specified"
                exit 198
        }
        if "`1'" == "" & "`2'" == "" {
                if "`ne'" != "noerror" & "`theip'" != "pr" {
			local thestd "`defstd'"
		}
        }
        else { local thestd "`1'" }

	/* pr not allowed with stdp or stdf */
        if "`theip'" == "pr" & "`thestd'" != "" {
                di in red "`thestd' not available with pr option"
                exit 198
        }

        /* if stdf check to see if valid for estimation command */
        if "`thestd'" == "stdf" {
                /* stdf is only valid after an LR estimation command */
                #delimit ;
                if "`ec'"!="anova" & "`ec'"!="boxcox" & "`ec'"!="corc" &
                   "`ec'"!="fit" & "`ec'"!="hlu" & "`ec'"!="prais" &
                   "`ec'"!="regdw" & "`ec'"!="regress" & "`ec'"!="rreg" { ;
                        di in red "stdf invalid after `ec' command" ;
                        exit 198 ;
                } ;
                #delimit cr
        }

	global S_1 "`thestd'"
	global S_2 "`theip'"
end


* CheckVar checks that every element of vlist is in blist -- error if not.
* It also checks that there are no repeats in vlist.
program define CheckVar   /* <vlist> <blist>  */
	version 5.0

	local vlist "`1'"
	local blist "`2'"

	/* check for repeats in vlist */
	Repeats `vlist'
	if "$S_1" != "" {
		di in red "$S_1: specified twice in the varlist"
		exit 198
	}

	/* check vlist is in blist  */
	Subtract "`vlist'" "`blist'"
	if "$S_1" != "" {
		di in red "$S_1 -- not used in last estimation"
		exit 198
	}
end


* DispWrap displays the <first> message followed by a list of the
* <vars> = <vals>.  It keeps the output within the <width> of the display
* and each new line is indented <tab> amount.  If there are no <vals> then
* just <vars> are output.  If there are fewer <vals> then <vars> then the
* last <vars> are output without <vals>.
program define DispWrap /* <width> <tab> <first> <vars> [<vals>] */
	version 5.0

	local width `1'
	local tab `2'
	local first `3'
	local vars `4'
	local vals `5'
	local nvar : word count `vars'

	local used = length("`first'")
	di in gr "`first'" _c
	local i 1
	while `i' <= `nvar' {
		local avar : word `i' of `vars'
		local aval : word `i' of `vals'
		local aval : display `aval'
		local chunk = 1 + length("`avar'")
		if "`aval'" != "" {
			local chunk = `chunk' + 3 + length("`aval'")
		}
		if `i' != `nvar' { local chunk = `chunk' + 1 }
		if (`used'+`chunk') > `width' {
			di ""
			di _dup(`tab') " " _c
			local used = `tab' + `chunk'
		}
		else { local used = `used' + `chunk' }
		di in gr " `avar'" _c
		if "`aval'" != "" { di in gr " = `aval'" _c }
		if `i' != `nvar' { di in gr "," _c }
		local i = `i' + 1
	}
	di ""
end


* DoTable collapses the data based on the <byvars>.  It creates for each
* cell of the resulting table the mean of the predictions (<predvar>) and
* the square root of the average of the squares of the standard errors
* (<errvar>).  <predlab> and <errlab> are used to label the <predvar> and
* <errvar>.  Extra tabdisp options are passed in <tabopts>. The program
* displays the created table.
program define DoTable /*<byvars><predvar><errvar><predlab><errlab><tabopts>*/
	version 5.0

	preserve

	local byvars "`1'"
	local predvar "`2'"
	local errvar "`3'"
	local predlab "`4'"
	local errlab "`5'"
	local tabopts "`6'"

	/* we don't average std errors, we average variances then sqrt */
	if "`errvar'" != "" { qui replace `errvar' = `errvar'^2 }

	/* get means of predicted values and variances by the byvars */
	collapse `predvar' `errvar', by(`byvars')

	/* do sqrt of variance to get back to std errors */
	if "`errvar'" != "" { qui replace `errvar' = sqrt(`errvar') }
	/* Now: if stdp then `errvar' = s * sqrt(sum(hj)/n) */
	/*      if stdf then `errvar' = s * sqrt(1+sum(hj)/n) */
	/* where the sum is over the appropriate cell of the byvars table */
	/* and hj is the jth element of the hat matrix. */

	/* change the variable labels to something reasonable */
	/* these will be displayed in the table if only one by var */
	label var `predvar' "`predlab'"
	if "`errvar'" != "" { label var `errvar' "`errlab'" }

	/* now we create the table */
	local nby : word count `byvars'
	parse "`byvars'", parse(" ")
	if `nby' > 3 {
		tabdisp `1' `2' `3', c(`predvar' `errvar') /*
				*/ by(`4' `5' `6' `7') `tabopts'
	}
	else { tabdisp `1' `2' `3', c(`predvar' `errvar') `tabopts' }

	restore
end


* GetbName gets the names off of the _b vector deleting the _cons name and
* any other troublesome names (like _se for tobit).  It returns the names
* in $S_1
program define GetbName  /* <cmdname> */
	version 5.0

	local cmdname `1'
	tempname b
	matrix `b' = get(_b)
	local bnames : colnames(`b')
	Subtract "`bnames'" "_cons"  /* remove _cons from bname  */
	if "`cmdname'" == "tobit" | "`cmdname'" == "cnreg" {
		Subtract "$S_1" "_se"	/* remove _se */
	}
	#delimit ;
	if "`cmdname'" == "corc" | "`cmdname'" == "hlu" |
	   "`cmdname'" == "prais" { ;
		Subtract "$S_1" "_inter" ;	/* remove _inter */
	} ;
	#delimit cr
	if "`cmdname'" == "ologit" | "`cmdname'" == "oprobit" {
		Substub "$S_1" "_cut"  /* remove _cut# */
	}
end


* Header displays preliminary information before the table is displayed
program define Header  /* <iplab> <stdlab> <gen> <asis> <by> <covars> <covals>
			<thevals> */
	version 5.0

	local iplab "`1'"    /* label for xb or pr var */
	local stdlab "`2'"   /* label for stdp or stdf var */
	local genvars "`3'"  /* names of generated variables */
	local asis "`4'"     /* names of variables left as is */
	local by "`5'"       /* names of the by variables */
	local covars "`6'"   /* names of the covariates that were set */
	local covals "`7'"   /* values covars were set to or the word "mean" */
	local thevals "`8'"  /* values covars were set to */

	local nby : word count `by'
	local ncov : word count `covars'
	local ngen : word count `genvars'
	local nasis : word count `asis'

	local width : set display linesize /* allowed width for header */
	local tab 5      /* length of indenting */

	di in gr _dup(`width') "-"

	/* Display generated variables (if any) */
	if `ngen' == 1 {
		DispWrap "`width'" "`tab'" "Created variable:" "`genvars'"
	}
	else if `ngen' > 1 {
		DispWrap "`width'" "`tab'" "Created variables:" "`genvars'"
	}

	/* Display as is variables (if any) */
	if `nasis' == 1 {
		DispWrap "`width'" "`tab'" "Variable left as is:" "`asis'"
	}
	else if `nasis' > 1 {
		DispWrap "`width'" "`tab'" "Variables left as is:" "`asis'"
	}

	/* split covars and thevals into those set to mean and other */
	local i 1
	while `i' <= `ncov' {
		local tmpval : word `i' of `covals'
		local tmpthe : word `i' of `thevals'
		local tmpvar : word `i' of `covars'
		if "`tmpval'" == "mean" {
			local mvars "`mvars' `tmpvar'"
			local mvals "`mvals' `tmpthe'"
		}
		else {
			local ovars "`ovars' `tmpvar'"
			local ovals "`ovals' `tmpthe'"
		}
		local i = `i' + 1
	}
	local nmvars : word count `mvars'
	local novars : word count `ovars'

	/* Display the covariates and values they were set to */
	if `nmvars' == 1 {
		DispWrap "`width'" "`tab'" "Covariate set to mean:" /*
			*/ "`mvars'" "`mvals'"
	}
	else if `nmvars' > 1 {
		DispWrap "`width'" "`tab'" "Covariates set to mean:" /*
			*/ "`mvars'" "`mvals'"
	}
	if `novars' == 1 {
		DispWrap "`width'" "`tab'" "Covariate set to value:" /*
			*/ "`ovars'" "`ovals'"
	}
	else if `novars' > 1 {
		DispWrap "`width'" "`tab'" "Covariates set to value:" /*
			*/ "`ovars'" "`ovals'"
	}
	di in gr _dup(`width') "-"

	/* if multiway table then tell what is in the cells */
	if `nby' != 1 {
		di in gr "Table cells contain: `iplab'" _c
		if "`stdlab'" != "" { di in gr " and `stdlab'" }
	}
end


* ParseVar parses the var[= #][var[= #]...] syntax and returns the
* variable names in $S_1 and the values (or the word "mean") in $S_2.
* It will handle the * and - expansions.
program define ParseVar    /* <varlist> */
	version 5.0
	parse "`*'", parse(" =-*")
	local i 1
	while "``i''" != "" {
		if "``i''" == "=" | "``i''" == "-" | "``i''" == "*" {
			di in red "``i'' used improperly in varlist"
			exit 198
		}
		local j = `i' + 1
		if "``j''" == "*" {  /*  * expansions */
			local k = `j' + 1
			if "``k''" == "-" {  /* * expansion with - */
				local m = `k' + 1
				unabbrev "``i''``j''``k''``m''"
				local varlist "`varlist' $S_1"
				local temp "$S_2"
				local h 1
				while `h' <= `temp' {
					local vallist "`vallist' mean"
					local h = `h' + 1
				}
				local i = `i' + 4
			}
			else {  /*  * expansion without - */
				unabbrev "``i''``j''"
				local varlist "`varlist' $S_1"
				local temp "$S_2"
				local h 1
				while `h' <= `temp' {
					local vallist "`vallist' mean"
					local h = `h' + 1
				}
				local i = `i' + 2
			}
		}
		else if "``j''" == "-" {  /* - expansion */
			local k = `j' + 1
			unabbrev "``i''``j''``k''"
			local varlist "`varlist' $S_1"
			local temp "$S_2"
			local h 1
			while `h' <= `temp' {
				local vallist "`vallist' mean"
				local h = `h' + 1
			}
			local i = `i' + 3
		}
		else {  /* no * or - expansion */
			unabbrev ``i''
			local varlist "`varlist' $S_1"
			if "``j''" == "=" {  /* var=# syntax */
				local k = `j' + 1
				if "``k''" == "-" { /* negative sign */
					local neg "-"
					local k = `k' + 1
					local i = `i' + 1
				}
				else { /* no negative sign */
					local neg
				}
				capture noi confirm number `neg'``k''
				if _rc != 0 {
					di in red /*
			*/ "only numbers allowed in var = # form of varlist"
					exit _rc
				}
				local vallist "`vallist' `neg'``k''"
				local i = `i' + 3
			}
			else {  /* no *, -, or =  */
				local vallist "`vallist' mean"
				local i = `i' + 1
			}
		}
	}
	global S_1 "`varlist'"
	global S_2 "`vallist'"
end


* Repeats checks for repeated terms in <vlist> and returns a list of the
* repeated terms in $S_1
program define Repeats   /* <vlist> */
	version 5.0

	local vlen : word count `*'
	local i 1
	while `i' < `vlen' {
		local j = `i' + 1
		while `j' <= `vlen' {
			if "``i''" == "``j''" {
				local reps "`reps' ``i''"
				local j = `vlen'
			}
			local j = `j' + 1
		}
		local i = `i' + 1
	}
	global S_1 "`reps'"
end


* SetCovs sets the <vars> to equal the values in <vals> or their mean
* if <vals> says "mean".  It returns the vals (with the means replaced
* by actual values) in $S_1
program define SetCovs   /* <vars> <vals>  */
	version 5.0

	local covars `1'
	local covals `2'
	local ncov : word count `covars'
	local i 1
	tempvar tmpmean
	gen `tmpmean' = 0
	while `i' <= `ncov' {
		local covari : word `i' of `covars'
		local covali : word `i' of `covals'
		if "`covali'" == "mean" {
			qui replace `tmpmean' = sum(`covari')/_N
			/* divide by _N ok because dropped missing values */
			qui replace `covari' = `tmpmean'[_N]
			local amean = `tmpmean'[_N]
			local coval2 "`coval2' `amean'"
		}
		else {
			qui replace `covari' = `covali'
			local coval2 "`coval2' `covali'"
		}
		local i = `i' + 1
	}
	global S_1 "`coval2'"
end


* SplitIt splits the command into two parts corresponding to the non-standard
* varlist part (returned in $S_1) and the remaining part that is allowed to
* have the [if exp] [in range], options stuff (returned in $S_2).
program define SplitIt
	version 5.0

	parse "`*'", parse(" ,")

	local i 1
	while "``i''"!="," & "``i''"!="if" & "``i''"!="in" & "``i''"!="" {
		local com "`com' ``i''"
		local i = `i' + 1
	}
	while "``i''" != "" {
		local opt "`opt' ``i''"
		local i = `i' + 1
	}

	global S_1 "`com'"
	global S_2 "`opt'"
end


* Subtract removes the tokens in elist from flist and returns the
* "cleaned" flist in S_1.  Adapted from code provided by vlw
program define Subtract   /* <flist> <elist> */
        local flist `1'
        local elist `2'

        local nelist : word count `elist'

        parse "`flist'", parse(" ")
        local i 1
        while "``i''" != "" {
                local j 1
                while `j' <= `nelist' {
                        local eword : word `j' of `elist'
                        local j = `j' + 1
                        if "`eword'" == "``i''" {
                                local `i' " "
                                local j = `nelist' + 1
                        }
                }
                local i = `i' + 1
        }

        global S_1 `*'
end


* Substub removes any tokens in flist that begin with the tokens in elist
* and returns the "cleaned" flist in S_1.
program define Substub   /* <flist> <elist> */
        local flist `1'
        local elist `2'

        local nelist : word count `elist'

        parse "`flist'", parse(" ")
        local i 1
        while "``i''" != "" {
                local j 1
                while `j' <= `nelist' {
                        local eword : word `j' of `elist'
                        local j = `j' + 1
                        if "`eword'" == substr("``i''",1,length("`eword'")) {
                                local `i' " "
                                local j = `nelist' + 1
                        }
                }
                local i = `i' + 1
        }

        global S_1 `*'
end