*! version 3.1, 14Feb2003, John_Hendrickx@yahoo.com
/*
Direct comments to:

John Hendrickx <John_Hendrickx@yahoo.com>

The latest version of desmat is available at SSC-IDEAS:
http://ideas.uqam.ca/ideas/data/bocbocode.html

Version 3.1, February 14, 2003
Now respects "linesize"
Version 3.0, March 30, 2001
Version 7 compatibility, output uses -scml- directives
Version 2.3, February 28 2001
moved the "incrmnt" subprogram below destest, for compatibility with version 7
Version 2.2, Sept 19
Use svytest for svy programs
Version 2.1, September 12, 2000
Added "using" option, write results to a tab delimited file
Version 2.0, Jun 30 2000
Added options for significance cutpoints, symbols, separation space,
number of decimal points. Can be specified using macro variables as in
-desrep-. Output using option "joint" now in compact for as well
Version 1.1, April 3 2000
Compact results, no display of the variables being tested, asterisks to
indicate significance
Version 1.0, October 27 1999

Program to be used in conjuction with desmat. Arguments are a list of model
terms to be tested. If no arguments are specified, all terms are tested.
An option "joint" can be specified to test for the joint siginficance of all
model terms.
An option "equal" can be specified to test for equality among the model terms.
*/

program define destest
	version 7

	* quit of not used after desmat
	if "$ncols" == ""  {
		display as error "destest is for use after estimating a model specified using {help desmat}"
		exit
	}

	* get the arguments and the options, watch out in case no arguments are
	* specified
	tokenize "`0'", parse(",")
	if "`1'" == "," {
		local opts `2'
	}
	else {
		local args `1'
		local opts `3'
	}

	local 0 ", `opts'"

	#delimit ;
	syntax [,  Joint Equal OUTRAW REPLACE
				ndec(numlist > 0 integer max=1)
				sigcut(numlist)
				sigsym(string)
				sigsep(numlist >=0 integer max=1) ];
	#delimit cr

	global linewd: set linesize

	* options can be be specified as global macro variables,
	* overridden by the command string
	if "`ndec'"=="" {
		if "$D_NDEC" ~= "" {local ndec $D_NDEC }
		else {local ndec 3 }
	}
	if "`sigcut'" == "" {
		if "$D_SIGCUT" ~= "" {local sigcut $D_SIGCUT }
		else {local sigcut ".05 .01" }
	}
	if "`sigsym'" == "" {
		if "$D_SIGSYM" ~= "" {local sigsym $D_SIGSYM }
		else {local sigsym "* **" }
	}
	if "`sigsep'" == "" {
		if "$D_SIGSEP" ~= "" {local sigsep $D_SIGSEP }
		else {local sigsep 0}
	}
	* add trailing space for checking
	local zero "`0' "
	if "$D_RAW" ~= "" & index(lower("`zero'"),"outraw ") == 0 {
		local outraw "$D_RAW"
	}
	if "$D_REPL" ~= "" & index(lower("`zero'"),"replace ") == 0 {
		local replace "$D_REPL"
	}

	* find the length of the longest significance symbol
	tokenize "`sigsym'"
	local sigwd=length("`1'")
	while "`1'" ~= "" {
		local sigwd=max(`sigwd',length("`1'"))
		macro shift
	}

	* see if "using" was specified
	local pnt=index("`args'","using")
	if `pnt' ~= 0 {
		preserve
		local args1=substr("`args'",1,`pnt'-1)
		local usin=substr("`args'",`pnt',.)
		gettoken usin1 usin: usin
		gettoken usin2 args2: usin
		local args "`args1' `args2'"
		local args=trim("`args'")
		local using "`usin1' `usin2'"
		if "`e(F)'" ~= "" {
			local lstcol 5
		}
		if "`e(chi2)'" ~= "" | "`e(deviance)'" ~= "" {
			local lstcol 4
		}
		if `sigsep' > 0 | "`outraw'" ~= "" {
			local lstcol=`lstcol'+1
		}
		local i 1
		while `i' <= `lstcol' {
			quietly gen str$linewd __O__`i'=""
			local i=`i'+1
		}
		global D__WRT 1
		if "`outraw'" == "" {
			global D__FMT `", "%12.`ndec'f""'
		}
	}

	* change any asterisks in the argument list to periods
	local alltrms: subinstr local args "*" ".", all
	* table headers
	if "`alltrms'" == "" {
		display "Testing all model terms ..."
		if "`using'" ~= "" {
			quietly replace __O__1 = "Testing all model terms ..." if _n==$D__WRT
			incrmnt
		}
	}
	if "`equal'" ~= "" {
		display "Testing equality of coefficients"
		if "`using'" ~= "" {
			quietly replace __O__1 = "Testing equality of coefficients" if _n==$D__WRT
			incrmnt
		}
	}
	if "`joint'" ~= "" {
		display "Testing joint significance"
		if "`using'" ~= "" {
			quietly replace __O__1 = "Testing joint significance" if _n==$D__WRT
			incrmnt
		}
	}
	if substr("`e(cmd)'",1,3) == "svy" {
		display "Using svytest"
		if "`using'" ~= "" {
			quietly replace __O__1 = "Using svytest" if _n==$D__WRT
			incrmnt
		}
	}
	if "`e(chi2)'" ~= "" | "`e(deviance)'" ~= "" {
		local div=$linewd-(10+`sigsep'+`sigwd'+6+10)
		display as text "{hline $linewd}"
		local colpos=$linewd-12
		display "Term" _col(`div') " Wald chi2" _col(`colpos') "df  P > chi2"
		display as text "{hline $linewd}"
		if "`using'" ~= "" {
			quietly replace __O__1 = "Term" if _n==$D__WRT
			quietly replace __O__2 = "Wald chi2" if _n==$D__WRT
			local curcol 3
			if `sigsep' > 0 | "$D__FMT" == "" {
				local curcol 4
			}
			quietly replace __O__`curcol' = "df" if _n==$D__WRT
			local curcol=`curcol'+1
			quietly replace __O__`curcol' = "P > chi2" if _n==$D__WRT
			incrmnt
			incrmnt
		}
	}
	if "`e(F)'" ~= "" {
		local div=$linewd-(10+`sigsep'+`sigwd'+10+10+10)
		local hdiv=`div'-1
		display as text "{hline $linewd}"
		display "Term" _col(`hdiv') "F statistic" _col(55) "Model  Residual  Prob > F"
		display _col(58) "df        df"
		display as text "{hline $linewd}"
		if "`using'" ~= "" {
			quietly replace __O__1 = "Term" if _n==$D__WRT
			quietly replace __O__2 = "F statistic" if _n==$D__WRT
			local curcol 3
			if `sigsep' > 0 | "$D__FMT" == "" {
				local curcol 4
			}
			quietly replace __O__`curcol' = "Model" if _n==$D__WRT
			quietly replace __O__`curcol' = "df" if _n==$D__WRT+1
			local curcol=`curcol'+1
			quietly replace __O__`curcol' = "Residual" if _n==$D__WRT
			quietly replace __O__`curcol' = "df" if _n==$D__WRT+1
			local curcol=`curcol'+1
			quietly replace __O__`curcol' = "P > F" if _n==$D__WRT
			incrmnt
			incrmnt
		}
	}

	* if no arguments are specified, test all terms
	if "`alltrms'" == "" {
		local i 1
		local nr 1
		local termcnt="${term`i'}"

		while "`termcnt'" ~= "" {
			tokenize "`termcnt'", parse("-")
			local varn="``1'[varn]'"
			if "`joint'" ~= "" {
				local jtest "`jtest' `termcnt'"
				display "`varn'" _col(`div')
				if "`using'" ~= "" {
				  quietly replace __O__1 = "`varn'" if _n==$D__WRT
				  incrmnt
				}
			}
			else {
				#delimit ;
				dotest `using' , nr(`nr') term(`varn') termcnt(`termcnt') `equal'
				ndec(`ndec') sigsep(`sigsep')
				sigcut(`sigcut') sigsym(`sigsym') sigwd(`sigwd');
				#delimit cr
				local nr=`nr'+1
			}
			local i=`i'+1
			local termcnt="${term`i'}"
		}
	}
	else {
		tokenize "`alltrms'"
		local term `1'
		local nr 1
		while "`term'" ~= "" {
			macro shift
			local alltrms `*'

			* find contents of term
			local i 1
			local tryterm="${term`i'}"
			local termcnt=""
			while "`tryterm'" ~= "" & "`termcnt'" == "" {
				tokenize "`tryterm'", parse("-")
				local varn="``1'[varn]'"
				if "`term'" == "`varn'" {
				  local termcnt="`tryterm'"
				}
				local i=`i'+1
				local tryterm="${term`i'}"
			}

			if "`joint'" ~= "" {
				local jtest "`jtest' `termcnt'"
				display "`term'" _col(`div')
				if "`using'" ~= "" {
				  quietly replace __O__1 = "`term'" if _n==$D__WRT
				  incrmnt
				}
			}
			else {
				#delimit ;
				dotest `using' , nr(`nr') term(`term') termcnt(`termcnt') `equal'
				ndec(`ndec') sigsep(`sigsep')
				sigcut(`sigcut') sigsym(`sigsym') sigwd(`sigwd');
				#delimit cr
				local nr=`nr'+1
			}

			tokenize `alltrms'
			local term `1'
		}
	}

	if "`joint'" ~= "" {
		#delimit ;
		dotest `using' , nr(1) term("joint significance") termcnt(`jtest') `equal'
		ndec(`ndec') sigsep(`sigsep')
		sigcut(`sigcut') sigsym(`sigsym') sigwd(`sigwd');
		#delimit cr
	}

	display as text "{hline $linewd}"
	if "`using'" ~= "" { incrmnt }

	* legend for significance symbols
	gettoken cut sigct: sigcut
	gettoken sym sigsm: sigsym
	while "`cut'" ~= "" {
		display %-`sigwd's "`sym'" " p < `cut'"
		if "`using'" ~= "" {
			quietly replace __O__1="`sym' p < `cut'" if _n == $D__WRT
			incrmnt
		}
		gettoken cut sigct: sigct
		gettoken sym sigsm: sigsm
	}

	if "`using'" ~= "" {
		global D__WRT=$D__WRT-1
		outshee2 __O__1-__O__`lstcol' `using' in 1/$D__WRT, nonames noquote `replace'
		restore
	}
	macro drop D__*
end

program define incrmnt
	version 7
		if $D__WRT >= _N {
			local n=_N+10
			quietly set obs `n'
		}
		global D__WRT=$D__WRT+1
end

program define dotest
	version 7
	#delimit ;
	syntax [using] , nr(integer) term(string) termcnt(string)
				     ndec(numlist > 0 integer max=1)
				     sigcut(numlist)
				     sigsym(string)
				     sigsep(numlist >=0 integer max=1)
				     sigwd(numlist >=0 integer max=1)
				     [ equal ];
	#delimit cr

	tokenize "`termcnt'", parse("-")
	local lastvar "`3'"

	if "`termcnt'" == "" {
		display "Can't find dummies for test of `term'"
	}
	else {
		local tstprog "testparm"
		if substr("`e(cmd)'",1,3) == "svy" {
			local tstprog "svytest"
		}
		if "`lastvar'" == "" {
			* don't test for equality of a single variable, even if requested
			capture `tstprog' `termcnt'
		}
		else {
			capture `tstprog' `termcnt', `equal'
		}
		* "capture" preceding testparm plows ahead even if the variables in
		* question have been dropped. If everything did go according to plan,
		* display the results now:
		if _rc == 0 {
			* determine significance level

			* r(p) isn't stored for svytest
			if substr("`e(cmd)'",1,3) == "svy" {
				local prob=fprob(`r(df)',`r(df_r)',`r(F)')
			}
			else {
				local prob=`r(p)'
			}

			local sig_=""
			gettoken cut sigct: sigcut
			gettoken sym sigsm: sigsym
			while "`cut'" ~= "" {
				if `prob' < `cut' {
				  local sig_="`sym'"
				}
				gettoken cut sigct: sigct
				gettoken sym sigsm: sigsm
			}

			if "`r(chi2)'" ~= "" {
				local div=$linewd-(10+`sigsep'+`sigwd'+6+10)
				#delimit ;
				display "`term'" _col(`div') %10.`ndec'f as res `r(chi2)'
				  _skip(`sigsep') %-`sigwd's "`sig_'"
				  %6.0f `r(df)' %10.`ndec'f `prob' "{text}";
				#delimit cr
				if "`using'" ~= "" {
				  quietly replace __O__1 = "`term'" if _n==$D__WRT
				  quietly replace __O__2 = string(`r(chi2)'$D__FMT) if _n==$D__WRT
				  * place a tab between statistics and sig symbols
				  * if raw output is requested or a separation space was specified
				  if `sigsep' > 0 | "$D__FMT" == "" {
				    quietly replace __O__3="`sig_'" if _n==$D__WRT
				    local curcol 4
				  }
				  else {
				    quietly replace __O__2=string(`r(chi2)'$D__FMT)+"`sig_'" if _n==$D__WRT
				    local curcol 3
				  }
				  quietly replace __O__`curcol' = string(`r(df)') if _n==$D__WRT
				  local curcol=`curcol'+1
				  quietly replace __O__`curcol' = string(`prob'$D__FMT) if _n==$D__WRT
				  incrmnt
				}
			}
			if "`r(F)'" ~= "" {
				local div=$linewd-(10+`sigsep'+`sigwd'+10+10+10)
				#delimit ;
				display "`term'" _col(`div') %10.`ndec'f as res `r(F)'
				  _skip(`sigsep') %-`sigwd's "`sig_'"
				  %10.0f `r(df)' %10.0f `r(df_r)' %10.`ndec'f `prob' "{text}";
				#delimit cr
				if "`using'" ~= "" {
				  quietly replace __O__1 = "`term'" if _n==$D__WRT
				  quietly replace __O__2 = string(`r(F)'$D__FMT) if _n==$D__WRT
				  * place a tab between statistics and sig symbols
				  * if raw output is requested or a separation space was specified
				  if `sigsep' > 0 | "$D__FMT" == "" {
				    quietly replace __O__3="`sig_'" if _n==$D__WRT
				    local curcol 4
				  }
				  else {
				    quietly replace __O__2=string(`r(F)'$D__FMT)+"`sig_'" if _n==$D__WRT
				    local curcol 3
				  }
				  quietly replace __O__`curcol' = string(`r(df)') if _n==$D__WRT
				  local curcol=`curcol'+1
				  quietly replace __O__`curcol' = string(`r(df_r)') if _n==$D__WRT
				  local curcol=`curcol'+1
				  quietly replace __O__`curcol' = string(`prob'$D__FMT) if _n==$D__WRT
				  incrmnt
				}
			}
		}
		else {
			display as error "An error occurred while testing `term', `termcnt'"
			display as error "One or more estimates do not exist."
		}
	}
end