lrtest.ado

是一个经济学管理应用软件 很难找的 但是经济学学生又必须用到

*! version 4.1.1  01apr2005
program define lrtest, rclass

	local caller = _caller()
	if `caller' < 8 {
		_lrtest7 `0'
		return add
		exit
	}

	version 8

	// translate old syntax into new syntax

	gettoken tok : 0, parse(" ,")
	if `"`tok'"' == "," | `"`tok'"' == "" {
		OldSyntax `caller' `"`0'"'
		local 0 `r(newsyntax)'
		if `"`0'"' == "" {
			exit
		}
	}

	// extract the specification of the models for the test

	ParseSpecTest `"`0'"'
	local model1 `r(model1)'
	local model2 `r(model2)'
	local 0 `r(rest)'
	if !replay() {
		di as err `"invalid input following specifications: `0'"'
		exit 198
	}
	local nmodel1 : word count `model1'
	local nmodel2 : word count `model2'
	local Qcomposite = (`nmodel1' > 1) | (`nmodel2' > 1)


	// parse the rest of the syntax

	syntax [, Df(str) FORCE STats DIr ASIS ]

	local Qforce = ("`force'" != "")
	local Qasis  = ("`asis'"  != "")
	local Qdir   = ("`dir'"   != "")
	local Qstats = ("`stats'" != "")

	if "`df'" == "-9" {
		// for compatibility with versions <=7
		local df
	}

	if "`df'" != "" {
		confirm number `df'
		capt assert `df' > 0
		if _rc {
			di as err "df() should be positive"
			exit 198
		}
		capt confirm integer number `df'
		if _rc {
			di as txt "(specified degrees of freedom is not " ///
			   "an integer (`df'))"
		}
	}


	/*
		extract results from retained models into scalars with

			prefix  r = restricted   model
			prefix  u = unrestricted model
	*/

	tempname u_N u_df u_ll u_ll0  r_N r_df r_ll r_ll0 tmp	///
		u_num_ce r_num_ce u_kf u_krc u_krs r_kf r_krc r_krs

	local unrestricted `model1'   // guess the unrestricted model
	local restricted   `model2'   // maybe swap below

	GetInfo "`unrestricted'" `Qforce'
	scalar `u_N'      = r(N)
	scalar `u_df'     = r(df)
	scalar `u_ll'     = r(ll)
	scalar `u_ll0'    = r(ll_0)
	scalar `u_num_ce' = r(num_ce)
	local  u_cmd        `r(cmd)'
	local  u_depvar     `r(depvar)'
	//
	local  u_mixed_method `r(mixed_method)'
	scalar `u_kf' = r(k_f)
	scalar `u_krc' = r(k_rc)
	scalar `u_krs' = r(k_rs)

	GetInfo "`restricted'" `Qforce'
	scalar `r_N'      = r(N)
	scalar `r_df'     = r(df)
	scalar `r_ll'     = r(ll)
	scalar `r_ll0'    = r(ll_0)
	scalar `r_num_ce' = r(num_ce)
	local  r_cmd        `r(cmd)'
	local  r_depvar     `r(depvar)'
	//
	local  r_mixed_method `r(mixed_method)'
	scalar `r_kf' = r(k_f)
	scalar `r_krc' = r(k_rc)
	scalar `r_krs' = r(k_rs)

	if (`u_df' < `r_df')  &  (!`Qasis') {
		// guessed wrong which was unrestricted model
		// swap restricted and unrestricted
		local unrestricted `model2'
		local restricted   `model1'

		foreach m in cmd depvar mixed_method {  	//  macros
			local m     `u_`m''
			local u_`m' `r_`m''
			local r_`m' `m'
		}
		foreach m in N df ll ll0 kf krc krs { 	// scalars
			scalar `tmp'   = `u_`m''
			scalar `u_`m'' = `r_`m''
			scalar `r_`m'' = `tmp'
		}
	}

	/*
		check assumptions for LR test (nesting...),
		only for non-composite models
	*/

	tempname tdf
	scalar `tdf' = `u_df' - `r_df'
	if "`df'" != "" {
		scalar `tdf' = `df'
	}

	if !`Qforce' {

		if ("`u_cmd'" == "vec" | "`r_cmd'" == "vec" ) {
			if `u_num_ce' != `r_num_ce' {
				di as err "{p 0 4}constrained and "	/// 
					"unconstrained models do not "	///
					"have the same number of " 	///
					"cointegrating equations{p_end}
				exit 498	
			}
		}


	
		if `tdf' < 0 {
			di as err "df(unrestricted) < df(restricted): " ///
			   `u_df' " < " `r_df'
			exit 498
		}
		else if `tdf' == 0 {
			di as err "df(unrestricted) = df(restricted) = " `u_df'
			exit 498
		}
	}

	if !`Qforce' & !`Qcomposite' {

		if ("`u_cmd'" == "xtmixed") | ("`r_cmd'" == "xtmixed") {
			if `u_kf' < `r_kf' | `u_krc' < `r_krc' | ///
			   `u_krs' < `r_krs' {
di as err "{p 0 4 2}Mixed models are not nested{p_end}"
				exit 498
			}
			if ("`u_mixed_method'" != "`r_mixed_method'") {
di as err "cannot compare a REML model with an ML model"
				exit 498
			}
			if ("`u_mixed_method'" == "REML") {
				if `u_kf' != `r_kf' {
di as err "{p 0 4 2}REML criterion is not comparable under different "
di as err "fixed-effects specifications{p_end}"
					exit 498
				}
				local remlnote remlnote
			}
			if (`u_krs' != `r_krs') {
			    if (`u_krs'==`r_krs' + 1) & (`u_krc' == `r_krc') {
				local chibar chibar
			    }
			    else {
				local conservative conservative
			    }
			}
			local noll0 noll0
		}

		if `u_N' != `r_N' {
			di as err "observations differ: " `u_N' " vs. " `r_N'
			exit 498
		}

		// note that "_est hold name" saves e(sample) into a byte
		// varname _est_name.  Note that this var may have been dropped.

		local smp1 = cond("`model1'"!=".", "_est_`model1'", "e(sample)")
		local smp2 = cond("`model2'"!=".", "_est_`model2'", "e(sample)")
		capt assert `smp1'==0 | `smp2'==0
		if _rc==0 {
			di as txt "(samples cannot be compared, sample info is missing)"
		}
		else {
			capt assert `smp1'==`smp2'
			if _rc == 9 {
				di as err "samples differ"
				exit 498
			}
		}

		if "`u_cmd'" != "`r_cmd'" {
			di as err "test involves different estimators: " ///
			   "`u_cmd' vs. `r_cmd'"
			exit 498
		}

		if ("`u_depvar'" != "") & ("`r_depvar'" != "") & ///
		   ("`u_depvar'" != "`r_depvar'") {
			di as err "dependent variables differ: " ///
			   "`u_depvar' vs. `r_depvar'"
			exit 498
		}

		if !missing(`u_ll0') & !missing(`r_ll0') {
			if reldif(`u_ll0',`r_ll0') > 1E-6 {
				di as err "log-likelihood of null" ///
				   " models differ:" ///
				   %9.0g `u_ll0' " vs. " %9.0g `r_ll0'
				exit 498
			}
		}
		else {
			if "`noll0'" == "" {
			    di as txt "(log-likelihoods of null models" ///
			       " cannot be compared)"
			}
		}
	}

	/*
		compute test
	*/
	
	ret scalar df   = `tdf'
	ret scalar chi2 = -2*(`r_ll' - `u_ll')
	if "`chibar'" == "" {
		ret scalar p    = chiprob(return(df), return(chi2))
	}
	else {
		ret local chibar chibar
		if return(df) == 1 {
			ret scalar p = cond(return(chi2)>1e-5, ///
				chiprob(return(df), return(chi2))/2, 1)
		}
		else {
			ret scalar p = ///
			   0.5*chiprob(return(df)-1,return(chi2)) + ///
			   0.5*chiprob(return(df),return(chi2))
		}
	}	

	// double save for backward compatibility
	global S_3 = return(df)
	global S_6 = return(chi2)
	global S_7 = return(p)

	/*
		display result
	*/

	if "`chibar'" == "" {
		di as txt _n "Likelihood-ratio test" _col(56)  ///
	   	   "LR chi2(" as res return(df) as txt ")"     ///
	   	   _col(68) "=" as res %10.2f return(chi2)
	}
	else {
		if return(df) == 1 {
			local dfdisp 01
		}
		else {
			local dfdisp : display return(df)-1 "_" return(df)
		}
		di as txt _n "Likelihood-ratio test" _col(51)  ///
		   "{help j_chibar##|_new:LR chibar2(`dfdisp')}" ///
                   _col(68) "{help j_chibar##|_new:=}" as res %10.2f return(chi2)
	}

	if !`Qcomposite' {

		di as txt "(Assumption: "                                    ///
		   as res "{stata est replay `restricted':`restricted'}"     ///
		   as txt " nested in "                                      ///
		   as res "{stata est replay `unrestricted':`unrestricted'}" ///
		   as txt ")" _c
		if "`chibar'" == "" {
	 	   di as txt _col(56) "Prob > chi2 = " as res %9.4f return(p)
		}
		else {
		   di as txt _col(51) "Prob > chibar2   = " as res %9.4f return(p)
		}
	}
	else {

		di _col(56) as txt "Prob > chi2 = " as res %9.4f return(p) _n

		di as txt "{p}Assumption: (" _c
		foreach m of local restricted {
			di as res "{stata est replay `m':`m'}" _c
			if "`ferest()'" != "" {
				di as txt ", " _c
			}
		}
		di as txt ") nested in (" _c
		foreach m of local unrestricted {
			di as res "{stata est replay `m':`m'}" _c
			if "`ferest()'" != "" {
				di as txt ", " _c
			}
		}
		di as txt "){p_end}"
	}
	if "`conservative'" != "" {
		di 
di as txt "{p 0 6 2}Note: {help j_xtmixedlr##|_new:LR test is conservative}{p_end}"