*! Version 1.2.3  01sept1999  Jeroen Weesie/ICS  (STB-52 sg121)
program define suest
	version 6.0

	gettoken cmd 0 : 0, parse(" ,")
	local lcmd = length("`cmd'")

	if "`cmd'" == "" {
		if "`e(cmd)'" == "suest" {
			Display
		}
		else error 305
	}
	else if `"`cmd'"' == "clear" {
		Clear
	}
	else if `"`cmd'"' == substr("combine",1,`lcmd') {
		Combine `0'
	}
	else if `"`cmd'"' == substr("fit",1,`lcmd') {
		Fit `0'
	}
	else if `"`cmd'"' == "drop" {
		Drop `0'
	}
	else if `"`cmd'"' == substr("query",1,`lcmd') {
		Query
	}
	else if `"`cmd'"' == "save" {
		Save `0'
	}
	else {
		di in red "unknown command `cmd'"
		exit 198
	}
end


/* ===================================================================== */
/* methods                                                               */
/* ===================================================================== */


/* Query
   describes saved models
*/
program define Query
	di in gre "saved models: " in ye "$SU_names"
end


/* Clear
   drops all saved models, but does not affect posted results
*/
program define Clear
	if "$SU_names" ~= "" {
		Drop $SU_names

		global SU_names
		global SU_wtype
		global SU_wexp
	}
end


/* Drop name-list
   drops the models in name-list
*/
program define Drop
	while "`1'" ~= "" {
		global SU_names : subinstr global SU_names /*
			*/ "`1'" "", all word count(local nch)
		if `nch' > 0 {
			capt mat drop SU_b`1'
			capt mat drop SU_V`1'
			capt     drop SU_S`1'
			gettoken cmd sc : (global)SU_`1'
			DropVars `sc'
			global SU_`1'
		}
		else {
			local nfound "`nfound' `1'"
		}
		mac shift
	}
	if "`nfound'" ~= "" {
		di in blu "`nfound' not found"
	}
end


/* Fit name : est_cmd
*/
program define Fit
	pprecmd name cmd : `0'
	ChkName `name'

	* check cmd satisfies conditions
	if `"`cmd'"' == "" {
		di in re "syntax is -suest fit name : cmd-"
		exit 198
	}
	gettoken ecmd 0 : cmd
	ScoreOpt `ecmd' `name'
	capt drop `r(score)'
	local scopt "score(`r(score)')"

	/*
		check that model is well-specified for seemingly unrelated estimation
	*/

	syntax [varlist] [if] [in] [aw fw iw pw], /*
		*/ [ Cluster(varname) Robust Score(str) *]

	if "`robust'" ~= "" {
		di in red "models should be -estimated- without option robust"
		exit 498
	}
	if "`cluster'" ~= "" {
		di in red "specify clustering during -combine-, not during estimation"
		exit 498
	}
	if "`score'" ~= "" {
		di in red "don't specify score; it is automatically appended"
		exit 198
	}

	* weights ok?
	if trim("$SU_names") ~= "" {
		ChkWght `"`wtype'"'  `"`wexp'"'
	}
	if "`wtype'" ~= "" {
		local wght "[`wtype'`wexp']
	}

	local mcmd `ecmd' `varlist' `if' `in' `wght', `scopt' `options'
	di in whi `"`mcmd'"'
	capt noi `mcmd'

	Save `name' SU_`name'*
end


/* Save name varlist
   saves the current estimation results under "name" (max 4 chars)
   varlist is the number of score statistics
*/
program define Save
	local name `1'
	mac shift
	local scores `*'
	unab scores : `scores'

	* check that the estimation results satisfy conditions

	if "`e(cmd)'" == "" {
		error 301
	}
	if "`e(vcetype)'" == "Robust" {
		di in red "models with robust se's cannot be saved"
		exit 498
	}
	if "`e(clustvar)'" ~= "" {
		di in red "specify clustering during -combine-, not during estimation"
		exit 498
	}

	if trim("$SU_names") ~= "" {
		ChkWght `"`e(wtype)'"'  `"`e(exp)'"'
	}

	* save results

	ChkName `name'

	* save b and vce

	* ologit and oprobit require modifcation of stored results
	if "`e(cmd)'" == "ologit" | "`e(cmd)'" == "oprobit" {
		FixOrder SU_b`name' SU_V`name'
	}
	else {
		matrix SU_b`name' = e(b)
		matrix SU_V`name' = e(V)
	}

	NameEq `name' SU_b`name' SU_V`name'

	* save sample
	capt drop SU_S`name'
	quietly gen byte SU_S`name' = e(sample)
	label var SU_S`name' "e(sample) of model `name'"

	* all scores are set to 0 out-of-sample
	tokenize `scores'
	while "`1'" ~= "" {
		quietly replace `1' = 0 if ~e(sample)
		mac shift
	}

	* save command-name and scores
	global SU_`name' "`e(cmd)' `scores'"

	if trim("$SU_names") == "" {
		global SU_wtype "`e(wtype)'"
		global SU_wexp  "`e(wexp)'"
	}

	* insert saved model in list of saved models
	global SU_names "$SU_names `name'"
end


/* Combine [name-list] [, cluster(varname) level(#)]
*/
program define Combine, eclass
	if !replay() {
		gettoken names 0 : 0, parse(",")
		DropDup names : "`names'"
	}
	else local names $SU_names

	syntax [, Cluster(varname) Level(passthru)]

	tokenize `names'
	local n : word count `names'

	tempvar touse
	gen byte `touse' = 0

	local j 1
	local nn 0
	local cn1 1
	while "``j''" ~= "" {
		local name ``j''

		if "$SU_`name'" == "" {
			di in red "model `name' not found"
			exit 198
		}
		confirm byte variable SU_S`name'
		quietly replace `touse' = `touse' | SU_S`name'

		local nb = colsof(SU_b`name')
		local nn = `nn' + `nb'
		local jp1 = `j' + 1
		local cn`jp1' = `cn`j'' + `nb'       /* 1 + cumulative sum of bi */

		local j `jp1'
	}

	/*
		form stacked b, block-diagonal V, and concatenated lists of score
	*/

	tempname b V

	local score
	matrix `V' = J(`nn',`nn',0)       /* pre-alloc V */

	local j 1
	while "``j''" ~= "" {
		local name ``j''
		matrix `b' = nullmat(`b') , SU_b`name'
		matrix `V'[`cn`j'',`cn`j''] = SU_V`name'

		gettoken cmd sc : (global)SU_`name'
		local score "`score' `sc'"

		local j = `j'+1
	}

	* properly name V
	local ceq : coleq `b'
	local cnames : colnames `b'
	mat colnames `V' = `cnames'
	mat coleq    `V' = `ceq'
	mat rownames `V' = `cnames'
	mat roweq    `V' = `ceq'

	/*
		compute VCE via _robust
	*/

	if "`cluster'" ~= "" {
		local clopt "cluster(`cluster')"
	}
	if "$SU_wtype" ~= "" {
		local wght [$SU_wtype$SU_wexp]
	}
	capt _robust `score' if `touse' `wght', var(`V') `clopt'
	if _rc {
		di in red "shit! failure in invoking _robust"
		exit 198
	}

	/*
		post results
	*/

	quietly count if `touse'
	local N = r(N)

	est post `b' `V', esample(`touse') obs(`N')

	est local vcetype  Robust
	est local clustvar `cluster'
	est local wtype    $SU_wtype
	est local wexp     $SU_wexp
	est local names    `names'
	est local cmd      suest

	Display , `level'
end


/* Display [,level(#)]
*/
program define Display
	syntax [, Level(passthru)]
	di in gre "Simultaneous VCE" /*
		*/ _col(63) "Obs    = " in ye _col(72) %7.0f e(N)
	di
	est display, `level'
end


/* ===================================================================== */
/* utilities                                                             */
/* ===================================================================== */


/* ChkName name
   check whether model name is ok
*/
program define ChkName
	args name
	if length("`name'") > 4 {
		di in red "name specified: `name'. It should be max 4 chars"
		exit 198
	}
	if "$SU_names" ~= "" {
		local tmp : subinstr global SU_names "`name'" "", /*
			*/ word all count(local nch)
		if `nch' > 0 {
			di in red "`name' already defined. Drop `name' if no longer needed"
			exit 198
		}
	}
end


/* ChkWght wtype wexp
   verifies that the weighting expression is identical to the stored w-exp
   Note: test is not foolproof; we store weighting expression,
   not the actual weights
*/
program define ChkWght
	args wtype wexp
	if "`wtype'" ~= "$SU_wtype" {
		di in red "type-of-weight should be identical to earlier models"
		exit 498
	}
	else if "`wtype'" ~= "" {
		local exp1 `"`wexp'"'
		gettoken tmp exp1 : exp1
		local exp2 "$SU_wexp"
		gettoken tmp exp2 : exp2
		tempvar Exp1 Exp2
		qui gen `Exp1' = `exp1'
		qui gen `Exp2' = `exp2'
		capt assert reldif(`Exp1',`Exp2')<1e-6
		if _rc {
			di in re "weighting expression differ from previous model"
			exit 498
		}
	}
end


/* NameEq name b V
   rename the equations to "name" in case of 1/0 equation, otherwise it
	prefixes "name" to equations if 	this yields unique equation names,
	and numbers the equations "name"_nnn otherwise.
*/
program define NameEq
	args name b V

	local eqnames : coleq `b'
	DropDup eq : "`eqnames'"
	local neq : word count `eq'
	if "`eq'" == "_" {
		local eqnames `name'
	}
	else {
		* modify equation names
		Prefix "`name'" "`eq'"
		DropDup eqmod : "`r(list)'"
		local neqmod : word count `eqmod'
		if `neq' == `neqmod' {
			* modified equation names are unique
			local i 1
			while `i' <= `neq' {
				local oldname : word `i' of `eq'
				local newname : word `i' of `eqmod'
				local eqnames : subinstr local eqnames /*
					*/ "`oldname'" "`newname'", word all
				local i = `i'+1
			}
		}
		else {
			* truncated modified equations not unique, use name1, name2, etc
			tokenize `eq'
			local i 1
			while `i' <= `neq' {
				local eqnames : subinstr local eqnames /*
					*/ "``i''" "`name'_`i'", word all
				local i = `i'+1
			}
		}
	}
	matrix coleq `b' = `eqnames'
	matrix roweq `V' = `eqnames'
	matrix coleq `V' = `eqnames'
end


/* Prefix name list
   returns in r(list) the words in list, prefixed with name,
	and truncated to 8 chars
*/
program define Prefix, rclass
	args name list
	tokenize "`list'"
	while "`1'" ~= "" {
		local nword = substr("`name'`1'",1,8)
		local nlist `nlist' `nword'
		mac shift
	}
	return local list `nlist'
end


/* DropDup newlist : list
   drops all duplicate tokens from list -- copied from hausman.ado
*/
program define DropDup
	args newlist	/*  name of macro to store new list
	*/  colon	/*  ":"
	*/  list	/*  list with possible duplicates */

	gettoken token list : list
	while "`token'" != "" {
		local fixlist `fixlist' `token'
		local list : subinstr local list "`token'" "", word all
		gettoken token list : list
	}

	c_local `newlist' `fixlist'
end


/* InList name name1 name2 ...
   returns r(member) = 1 if name equals one of name1, name2 etc, and
   0 otherwise
*/
program define InList, rclass
	args name list
	local list : subinstr local list "`name'" "", word count(local nch)
	return local member = `nch'>0
end


/* ScoreOpt cmd_name name
   returns in r(score) the specification of the score() option for
	cmd_name, so that the score statistics are named SU_name*.
*/
program define ScoreOpt, rclass
	args ecmd name

   InList `ecmd'  "cloglog logistic logit probit scobit clogit2"
	if `r(member)' == 1 {
		return local score "SU_`name'"
		exit
	}

	InList `ecmd'  "ologit oprobit mlogit"
	if `r(member)' == 1 {
		return local score "SU_`name'*"
		exit
	}

	InList `ecmd'  "hetprob intreg nbreg regh"
	if `r(member)' == 1 {
		return local score "SU_`name'1 SU_`name'2"
		exit
	}

	InList `ecmd'  "heckprob"
	if `r(member)' == 1 {
		return local score "SU_`name'1 SU_`name'2 SU_`name'3"
		exit
	}

	InList `ecmd'  "heckman"
	if `r(member)' == 1 {
		return local score "SU_`name'1 SU_`name'2 SU_`name'3 SU_`name'4"
		exit
	}

	di in re `""suest fit" does not support `ecmd'"'
	di in re `"invoke `ecmd' with score(), then invoke "suest save" it"'
	exit 198
end


/* DropVars list
   drops all variables named in list (in contrast with -drop varlist-,
   we don't terminate if some names in the list do not (no longer) exist
   as a variable.
*/
program define DropVars
	while "`1'" ~= "" {
		capt drop `1'
		mac shift
	}
end


/* FixOrder modifies the (b,V) of oprobit and ologit
   It adds equation name LP to the linear predictor, and renames
   the cutpoints to cutx:_cons, x=1,2,..
*/
capt prog drop FixOrder
program define FixOrder
	args b V
	mat `b' = e(b)
	mat `V' = e(V)
	local names : colnames `b'
	tokenize `names'
	while "`1'" ~= "" {
		if substr("`1'",1,4) ~= "_cut" {
			local nnames `nnames' LP:`1'
		}
		else {
			local 1 = substr("`1'",2,.)
			local nnames `nnames' `1':_cons
		}
		mac shift
	}
	mat colnames `b' = `nnames'
	mat colnames `V' = `nnames'
	mat rownames `V' = `nnames'
end

exit

Global objects used to store information
----------------------------------------

	SU_names     names of saved models, seperated by a blank
	SU_name      cmd, scores, ...
	SU_wtp       weight type
	SU_wexp      weight expression

Matrices
	SU_Vname     VCE in model name
	SU_bname     b in model name

Variables
	SU_Sname     identifies sample in model name

Warning:
	The out-of e(sample) value of the score statistics are set to 0 by Add.


Saved results
-------------

local
	e(cmd)        suest
	e(vcetype)    Robust
	e(clustvar)   cluster variable, or nothing
	e(names)      names of models incorporated
	e(wtype)      weight type
	e(wexp)       weighting expression

scalars
	e(N)          observations in union of samples

matrices
	e(V)
	e(b)

functions
   e(sample)


Dependencies
------------

  pprecmd


To Do
-----

 -- More informative header for -suest combine- (Display) describing the
    models that were combined. Also Query should become more informative.

 -- Adopt Fit for multiple-inline equations ?
    Didn't wwg have a utility for that ?

 -- I test whether models are weighted the same way by checking
    whether the strings representing the weighting-expressions
    are the same. Shouldn't I look at the numerical values ?

 -- Should I make the keyword "fit" optional, as wwg once suggested?
    I still don't like it.

 -- support for clogit (conditional logit model as discrete choice model)
    -- check yi+=1
    -- manually compute score = y-pi
	 -- if cluster-var specified
	      check constant within groups
		 else
		   specify group as clustervar