alpha.ado

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

*! version 4.7.3  01oct2004
program define alpha, rclass byable(recall)
	version 8, missing

	* undocumented: coo == casewise
	syntax varlist(min=2 numeric) [if] [in] [, Asis Casewise Coo Detail Item /*
	 */ Generate(string) Label Min(integer 1) Reverse(varlist numeric) Std ]

	DropDup varlist : "`varlist'"
	local k : word count `varlist'

	if `min' < 1 | `min' > `k' {
		di as err "invalid option min()"
		exit 198
	}

	if "`coo'" != "" {
		local casewise casewise
	}

	* scratch

	tempvar cnt nobs rest test touse x
	tempname ac acor acorr alph alpha av avar C mIIC MEAN nc ncor nv nvar Obs IRC ITC VAR

/* begin */ quietly {

	* --------------------------------------------------------------------------
	* select and count cases; treatment of missing values
	* --------------------------------------------------------------------------

	*   N = #obs selected via if/in/min
	*  NC = #complete obs

	if "`casewise'" == "" & `min' < `k' {      /* incomplete cases allowed */

		marksample touse, novarlist
		egen `nobs' = robs(`varlist') if `touse'
		replace `touse' = (`nobs' < . & `nobs' >= `min')
		count if `touse'
		local N = r(N)		/* # if in */
		count if `nobs'==`k' & `touse'
		local NC = r(N)         /* # if in & complete */
	}
	else {                                   /* only complete cases */
		marksample touse
		count if `touse'
		local N = r(N)
		local NC `N'
	}
	if `N' == 0 {
		error 2000
	}

	* --------------------------------------------------------------------------
	* drop constant variables
	* note: we do not check again whether #obs >= min
	* --------------------------------------------------------------------------

	foreach v of local varlist {
		summ `v' if `touse', meanonly
		if r(min) == r(max) {
			local vardrop `vardrop' `v'
		}
		else	local varkeep `varkeep' `v'
	}
	if "`vardrop'" != "" {
		noi di as txt /*
		 */ "`vardrop' constant in analysis sample, dropped from analysis"
		local varlist `varkeep'
		local k : word count `varlist'
	}
	* below the varlist is kept tokenized
	tokenize `varlist'

	if `k' == 1 {
		error 102
	}

	* --------------------------------------------------------------------------
	* signs of variables sgn1, sgn2, ...
	* --------------------------------------------------------------------------

	forvalues i = 1/`k' {
		local sgn`i' 1
	}
	if "`reverse'" != "" {            /* signs specified by user */
		local restlist
		foreach v of local reverse {
			ListIndex "`varlist'"  "`v'"
			if `r(index)' > 0  {
				local sgn`r(index)' -1
				local revlist "`revlist'`v' "
			}
			else {
				local restlist "`restlist'`v' "
			}
		}
		if "`restlist'" != "" {
			noi di as txt /*
			 */ "`restlist'included in reverse-list, but not in varlist"
		}
	}
	else if "`asis'" == "" {     /* automatic signs via -factor- */
		tempvar score
		factor `varlist' if `touse'
		score `score'
		forvalues i = 1/`k' {
			corr ``i'' `score' if `touse'
			if r(rho) < 0 {
				local revlist "`revlist' ``i''"
				local sgn`i' -1
			}
		}
	}

	* --------------------------------------------------------------------------
	* compute OBS, MEAN, VAR and COV/CORR
	* --------------------------------------------------------------------------

	* matrix C    = corr/cov for signed variables
	* matrix Obs  = pairwise number of non-missing cases
	* matrix MEAN = unsigned means of variables
	* matrix VAR  = variance of variables
	* var cnt     = #non-mv's

	if `N' != `NC' {                    /* some cases contain missing values */

		mat `Obs'  = J(`k',`k',0)
		mat `C'    = `Obs'
		mat `MEAN' = J(1,`k',0)
		mat `VAR'  = J(1,`k',0)
		gen int `cnt' = 0

		if "`std'" == "" {
			local corropt  cov
			local r_arg    cov_12
		}
		else {
			local r_arg rho
		}

		forvalues i = 1/`k' {
			summ ``i'' if `touse'
			mat `Obs'[`i',`i'] = r(N)
			mat `MEAN'[1,`i']  = r(mean)
			mat `VAR'[1,`i']   = r(Var)
			if "`std'" == "" {
				mat `C'[`i',`i'] = r(Var)
			}
			else {
				mat `C'[`i',`i'] = 1
			}
			replace `cnt' = `cnt' + 1 if `touse' & ``i'' < .

			local imin1 = `i'-1
 			forvalues j = 1/`imin1' {
				corr ``i'' ``j'' if `touse', `corropt'
				if r(N) != 0 {
					mat `C'[`i',`j'] = `sgn`i'' * `sgn`j'' * r(`r_arg')
					mat `C'[`j',`i'] = `C'[`i',`j']
				}
				else {
					di as err "no simultaneous obs on ``i'' and ``j''"
					exit 498
				}
				mat `Obs'[`i',`j'] = r(N)
				mat `Obs'[`j',`i'] = r(N)
			}
		} /* forvalues i */
	}

	else {                                     /* all cases complete */

		mat acc `C' = `varlist' if `touse', dev mean(`MEAN') nocons
		mat `C' = (1/(r(N)-1)) * `C'
		mat `VAR' = vecdiag(`C')

		* adapt C for the signs of variables
		if "`revlist'" != "" {
			forvalues i = 1/`k' {
				local imin1 = `i'-1
				forvalues j = 1/`imin1' {
					mat `C'[`i',`j'] = `C'[`i',`j'] * `sgn`i'' * `sgn`j''
					mat `C'[`j',`i'] = `C'[`i',`j']
				}
			}
		}

		* modifcation in case of correlations
		if "`std'" != "" {
			mat `C' = corr(`C')
		}
		mat `Obs' = J(`k',`k',`N')
		gen int `cnt' = `k'
	}

	* --------------------------------------------------------------------------
	* test scores
	* --------------------------------------------------------------------------

	gen `test' = 0 if `touse'
	forvalues i = 1/`k' {
		if "`std'" == "" {
			replace `test' = `test' + `sgn`i'' * ``i'' if `touse' & ``i'' < .
		}
		else {
			replace `test' = `test' + /*
			 */  `sgn`i'' * (``i''-`MEAN'[1,`i']) / sqrt(`VAR'[1,`i']) /*
			 */  if `touse' & ``i'' < .
		}
	}
	* note: at this point, cnt>0 is ensured
	replace `test' = `test' / `cnt' if `touse'

	* --------------------------------------------------------------------------
	* compute statistics for the additive scale in all items
	* --------------------------------------------------------------------------

	if "`std'" != "" {
		scalar `avar' = 1
		scalar `nvar' = 1
	}
	else {
		scalar `avar' = 0
		scalar `nvar' = 0
		forvalues i = 1/`k' {
			scalar `avar' = `avar' + `Obs'[`i',`i'] * `C'[`i',`i']
			scalar `nvar' = `nvar' + `Obs'[`i',`i']
		}
	}

	scalar `acor' = 0                         /* weighted sum of variances */
	scalar `ncor' = 0                         /* sum of weights */
	forvalues i = 1/`k' {
		local imin1 = `i'-1
		forvalues j = 1/`imin1' {
			scalar `acor' = `acor' + `Obs'[`i',`j']*`C'[`i',`j']
			scalar `ncor' = `ncor' + `Obs'[`i',`j']
		}
	}

	scalar `acorr' = `acor'/`ncor'
	scalar `alpha' = (`k'*`acorr')/(`avar'/`nvar'+(`k'-1)*`acorr')
	if scalar(`alpha') < 0 {
		scalar `alpha' = .
	}

	* double save in r() and S_#
 	if "`std'" == "" {
 		return scalar cov = scalar(`acorr' )
 	}
	else {
		return scalar rho = scalar(`acorr')
	}

	return scalar k     = `k'
	return scalar alpha = scalar(`alpha')

	global S_4 = scalar(`acorr')
	global S_5 = `k'
	global S_6 = scalar(`alpha')

	* --------------------------------------------------------------------------
	* compute statistics for additive scales formed by removing single items
	* --------------------------------------------------------------------------

	if `k' == 2 & "`item'" != "" {
		di as txt "option -item- ignored with 2 variables"
		local item
	}

	if "`item'" != "" {
		mat `ITC'  = J(1,`k',0)          /* item-test correlations */
		mat `IRC'  = J(1,`k',0)          /* item-rest correlations */
		mat `mIIC' = J(1,`k',0)          /* mean InterItem corr/cov */
		mat `alph' = J(1,`k',0)          /* alpha */

		if "`std'" != "" {
			scalar `av' = 1
			scalar `nv' = 1
		}
		forvalues i = 1/`k' {
			scalar `ac' = `acor'
			scalar `nc' = `ncor'
			forvalues j = 1/`k' {
				if `i' != `j' {
					scalar `ac' = `ac' - `Obs'[`i',`j']*`C'[`i',`j']
					scalar `nc' = `nc' - `Obs'[`i',`j']
				}
			}
			if "`std'" == "" {
				scalar `av' = `avar' - `Obs'[`i',`i']*`C'[`i',`i']
				scalar `nv' = `nvar' - `Obs'[`i',`i']
			}
			mat `mIIC'[1,`i'] = `ac'/`nc'
			mat `alph'[1,`i'] = /*
			 */ ((`k'-1)*`ac'/`nc') / ((`av'/`nv')+(`k'-2)*`ac'/`nc')
			if `alph'[1,`i'] < 0 {
				mat `alph'[1,`i'] = .
			}

			* Item-Test correlations
			corr ``i'' `test' if `touse'
			mat `ITC'[1,`i'] = `sgn`i'' * r(rho)

			* Item-Rest (=Test-Item) correlations
			if "`std'" == "" {
				gen `x' = `sgn`i'' * ``i'' if `touse' & ``i''<.
			}
			else {
				gen `x' = `sgn`i''*(``i''-`MEAN'[1,`i'])/sqrt(`VAR'[1,`i']) /*
				 */ if `touse' & ``i''<.
			}

			gen `rest' = (`cnt'*`test'-`x') / (`cnt'-1) /*
			 */ if `touse' & ``i'' < . & `cnt' > 1
			corr ``i'' `rest' if `touse'
			mat `IRC'[1,`i'] = `sgn`i'' * r(rho)

			drop `x' `rest'
		}
	}

/* end quietly */ }

	* --------------------------------------------------------------------------
	* display and related results
	* --------------------------------------------------------------------------

	if "`std'" == "" {
		local un un
	}
	local testtxt "mean(`un'standardized items)"

	di as txt _n "Test scale = `testtxt'"