tetrachoric.ado

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

*! version 1.0.0  21mar2005
program tetrachoric, rclass byable(recall)
	version 8

	#del ;
	syntax varlist(numeric) [if] [in] [fw]
	[,
		AVAILable
		FORmat(passthru)
		noTABle
		POSdef
	] ;
	#del cr

	tempname alpha N p rho R

	marksample touse, novarlist

	if "`weight'" != "" {
		local wght "[`weight'`exp']"
	}

	quietly summarize `touse' `wght' if `touse', meanonly
	scalar `N' = r(N)
	if `N'==0 {
		error 2000
	}

	ZeroOneOnly `varlist' if `touse'
	if "`available'" == "" {
		markout `touse' `varlist'
		quietly summarize `touse' `wght' if `touse', meanonly
		scalar `N' = r(N)
		if `N' == 0 {
			error 2000
		}
	}

	local nv : list sizeof varlist
	tokenize `varlist'

	matrix `R' = I(`nv')
	matrix rownames `R' = `varlist'
	matrix colnames `R' = `varlist'

	forvalues i = 1 / `nv' {
		forvalues j = 1 / `=`i'-1' {
			quietly tab ``i'' ``j'' `wght' if `touse', matcell(`p')
			
			matrix `p' = `p' / r(N)
			assert rowsof(`p')==2 & colsof(`p')==2

			if (`p'[1,2]==0) | (`p'[2,1]==0) {
				scalar `rho' = 1
			}
			else if (`p'[1,1]==0) | (`p'[2,2]==0) {
				scalar `rho' = -1
			}
			else {
				scalar `alpha' = ///
				   (`p'[1,1]*`p'[2,2]) / (`p'[1,2]*`p'[2,1])
				  
				scalar `rho' = /// 
				   (`alpha'^(_pi/4) - 1) / (`alpha'^(_pi/4)+1)
			}

			matrix `R'[`i',`j'] = `rho'
			matrix `R'[`j',`i'] = `rho' 
		}
	}

	if "`posdef'" != "" {
		PosDef `R'
		local nneg = r(nneg)
		if `nneg' > 0 {
			matrix `R' = r(pd)
		}
	}

	if "`table'" == "" {
		if "`format'" == "" {
			local format format(%8.4g)
		}
	
		dis _n as txt "Tetrachoric correlations (N=" `N' ")"
		matlist `R' , `format' half border(rows) rowtitle(Variable)
	}
	
	if "`posdef'" != "" {
		if `nneg' == 0 {
			dis _n as txt /// 
			    "(correlation matrix is positive definite)"
		}
		else { 
			dis _n as txt /// 
			   "{p 0 1}(correlation matrix is positive " /// 
			   "semidefinite; `nneg' negative eigenvalues set to 0)"
		}
	}

	return scalar N    = `N'
	return scalar rho  = `R'[1,2]
	if "`posdef'" != "" {
		return scalar nneg = `nneg'
	}
	return matrix corr = `R'
end


// checks that variables are 0-1 (or missing) only
program ZeroOneOnly
	syntax varlist if

	tempname p
	foreach v of local varlist {
		capture assert inlist(`v',0,1) `if' & !missing(`v')
		if _rc {
			dis as err "variable `v' is not 0/1 coded"
			exit 198
		}
		
		quietly tab `v' `if', matcell(`p')
		if rowsof(`p') == 1 {
			dis as err "variable `v' does not vary"
			exit 198
		}
	}
end


program PosDef, rclass
	args R

	if !issym(`R') {
		error 505
	}

	tempname evec eval PDR
	
	matrix symeig `evec' `eval' = `R'
	local nneg = 0
	forvalues j = 1 / `=colsof(`eval')' {
		if `eval'[1,`j'] < 0 {
			local ++nneg
			matrix `eval'[1,`j'] = 0
		}
	}

	if `nneg' > 0 {
		matrix `PDR' = corr(`evec' * diag(`eval') * `evec'')
		
		return matrix pd   =  `PDR'
		return scalar nneg = `nneg'
	}
	else {
		return matrix pd   = `R', copy
		return scalar nneg = 0
	}
end
exit