mds_estat.ado

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

*! version 1.0.0  24mar2005
program mds_estat, rclass
	version 9

	if !inlist("`e(cmd)'", "mds", "mdsmat", "mdslong") {
		dis as err "last estimation results not found"
		exit 301
	}

	gettoken key args : 0, parse(", ")
	local lkey = length(`"`key'"')
	if `"`key'"' == substr("config",1,max(3,`lkey')) {
		Config `args'
	}
	else if `"`key'"' == substr("correlations",1,max(3,`lkey')) {
		Correlations `args'
	}
	else if `"`key'"' == substr("pairwise",1,max(4,`lkey')) {
		Pairwise `args'
	}
	else if `"`key'"' == substr("quantiles",1,max(3,`lkey')) {
		Quantiles `args'
	}
	else if `"`key'"' == substr("stress",1,max(3,`lkey')) {
		Stress `args'
	}
	else if `"`key'"' == substr("summarize",1,max(2,`lkey')) {
		Summarize `args'
	}
	else {
		estat_default `0'
	}

	return add
end


// MDS configuration
program Config
	syntax [, ///
	   MAXlength(numlist integer min=1 max=1 >=4 <=32) FORmat(str) ]

	local id : word 1 of `e(id)'
	local chars `maxlength'
	if (`"`id'"' != "")     local ropt   row(`id')
	if (`"`format'"' == "") local format %12.4f
	if (`"`chars'"' == "")  local chars  12

	dis _n as txt "Approximating configuration " ///
		      "in `e(p)'-dimensional Euclidean space"

	matlist e(Y), left(4) border(b) `ropt' ///
	   twidth(`chars') format(`format')
end


program Correlations, rclass
	syntax [, ///
	  MAXlength(numlist integer min=1 max=1 >=4 <=32) FORmat(str) noTOTal ]

	local chars `maxlength'
	tempfile f
	tempname dissim dist res

	predict `dissim' `dist' `res', pairwise saving(`"`f'"') full
	preserve
	quietly use `"`f'"', clear

	local nid : word count `e(id)'
	if `nid' == 1 {
		local id1 `e(id)'1
		local id2 `e(id)'2
	}
	else if `nid' == 2 {
		local id1 : word 1 of `e(id)'
		local id2 : word 2 of `e(id)'
	}
	else {
		_stata_internalerror
	}
	quiet drop if `id1' == `id2'

// statistics per category

	tempname R Ri
	matrix `Ri' = J(1,3,.)
	local i = 1
	local rsp &-
	while `i' <= c(N) {
		quietly corr `dissim' `dist'   if (`id1'==`id1'[`i'])
		matrix `Ri'[1,1] = r(N)
		matrix `Ri'[1,2] = r(rho)

		quietly spearman `dissim' `dist' if (`id1'==`id1'[`i'])
		matrix `Ri'[1,3] = r(rho)

		matrix rownames `Ri' = `=`id1'[`i']'
		matrix `R' = nullmat(`R') \ `Ri'

		local i = `i' + r(N)
		if (`i' < c(N)) local rsp `rsp'&
	}
	matrix colnames `R' = N Pearson Spearman

// statistics for total

	tempname T
	matrix `T' = J(1,3,.)

	quietly corr `dissim' `dist'
	matrix `T'[1,1] = r(N)
	matrix `T'[1,2] = r(rho)

	quietly spearman `dissim' `dist'
	matrix `T'[1,3] = r(rho)

	matrix colnames `T' = N Pearson Spearman
	matrix rownames `T' = Total


	local rsp `rsp'-
	local RT `R'
	if "`total'" == "" {
		local rsp `rsp'&
		local RT (`R' \ `T')
	}

	if (`"`chars'"'  == "") local chars 12
	if (`"`format'"' == "") local format %9.4f

	dis as txt _n "Correlations of dissimilarities and fitted distances"
	matlist `RT',  row(`:word 1 of `e(id)'') rspec(`rsp') ///
	   cspec( o4& %`chars's | %5.0f & `format' & `format' o1&)

	return matrix R = `R'
	return matrix T = `T'
end


// displays the constructed dissimilarities, fitted distances, & residuals
program Pairwise
	syntax [, noTRANSform ///
	   MAXlength(numlist integer min=1 max=1 >=4 <=32) Full Separator ]

	local chars `maxlength'
	tempname d dfit F res Ta Tb Y

	matrix `Y' = e(Y)
	_mds_euclidean `F' = `Y'
	if "`transform'" == "" {
		scalar `Ta' = el(e(linearf),1,1)
		scalar `Tb' = el(e(linearf),1,2)
	}
	else {
		scalar `Ta' = 0
		scalar `Tb' = 1
	}


	if (`"`chars'"' == "") local chars 12
	local chars = min(`chars',ceil((c(linesize)-52)/2))
	local c = 2*`chars' + 8

	local nid : word count `e(id)'
	if `nid' == 1 {
		local abv1 = abbrev("`e(id)'1",`chars')
		local abv2 = abbrev("`e(id)'2",`chars')
	}
	else if `nid' == 2 {
		local abv1 = abbrev("`:word 1 of `e(id)''",`chars')
		local abv2 = abbrev("`:word 2 of `e(id)''",`chars')
	}
	else {
		_stata_internalerror
	}

	local n = rowsof(`Y' )
	local names : rownames `Y'
	forvalues i = 1/`n' {
		gettoken name`i' names : names
		local name`i' = substr("`name`i''",1,`chars')
	}

	dis
	Pairwise_Hline `chars' TT
	if "`transform'" != "" {
		dis as txt _col(`c') ///
		    "{c |}                   fitted          raw"
	}
	else {
		dis as txt _col(`c') ///
		    "{c |}  transformed      fitted       adjusted"
	}
	dis as txt _col(5) "{ralign `chars':`abv1'}"  ///
		  _skip(2) "{ralign `chars':`abv2'}"  ///
		  _skip(1) "{c | } dissimilarity  L2-distance     residual"
	Pairwise_Hline `chars' +

	forvalues i = 1/`n' {
		local low = cond("`full'"=="",`i'+1,1)
		forvalues j = `low'/`n' {
			if (`i'==`j') continue

			scalar `d'    = `Ta' + `Tb'*el(e(D),`i',`j')
			scalar `dfit' = el(`F',`i',`j')
			scalar `res'  = `d' - `dfit'

			dis as txt _col(5)  "{ralign `chars':`name`i''}" ///
			    as txt _skip(2) "{ralign `chars':`name`j''}" ///
			    as txt " {c |}" ///
			    as res _skip(3) %10.4g `d' ///
			    as res _skip(3) %10.4g `dfit' ///
			    as res _skip(3) %10.4g `res'
		}

		if "`separator'" != "" & ((("`full'" != "") & (`i' < `n')) | ///
				    (("`full'" == "") & (`i' < `n'-1))) {
			Pairwise_Hline `chars' +
		}
	}
	Pairwise_Hline `chars' BT
end


program Quantiles, rclass
	syntax [, noTRANSform ///
		  MAXlength(numlist integer min=1 max=1 >=4 <=32) ///
		  FORmat(str) noTOTal  ]

	local chars `maxlength'
	tempfile f
	tempname dissim dist res Q Qi T

	predict `dissim' `dist' `res' , ///
	   pairwise saving(`"`f'"') full `transform'

	preserve
	quietly use `"`f'"', clear

	local nid : word count `e(id)'
	if `nid' == 1 {
		local id1 `e(id)'1
		local id2 `e(id)'2
	}
	else if `nid' == 2 {
		local id1 : word 1 of `e(id)'
		local id2 : word 2 of `e(id)'
	}
	else {
		_stata_internalerror
	}
	quiet drop if `id1' == `id2'
	sort `id1'

// statistics per category

	matrix `Qi' = J(1,6,.)
	local rsp &-
	local i = 1
	while `i' <= c(N) {
		quietly summ `res' if `id1'==`id1'[`i'], detail
		matrix `Qi'[1,1] = r(N)
		matrix `Qi'[1,2] = r(min)
		matrix `Qi'[1,3] = r(p25)
		matrix `Qi'[1,4] = r(p50)
		matrix `Qi'[1,5] = r(p75)
		matrix `Qi'[1,6] = r(max)

		matrix rownames `Qi' = `=`id1'[`i']'
		matrix `Q' = nullmat(`Q') \ `Qi'
		local i = `i' + r(N)
		if (`i' < c(N)) local rsp `rsp'&
	}
	matrix colnames `Q' = N min p25 q50 q75 max

// statistics overall

	matrix `T' = J(1,6,.)

	quietly summ `res', detail
	matrix `T'[1,1] = r(N)
	matrix `T'[1,2] = r(min)
	matrix `T'[1,3] = r(p25)
	matrix `T'[1,4] = r(p50)
	matrix `T'[1,5] = r(p75)
	matrix `T'[1,6] = r(max)

	matrix rownames `T' = Total
	matrix colnames `T' = N min p25 q50 q75 max

// display

	local rsp `rsp'-
	local QT `Q'
	if "`total'" == "" {
		local rsp `rsp'&
		local QT (`Q' \ `T')
	}

	if ("`chars'" == "") local chars 12
	if (`"`format'"' == "") {
		local fmt %8.0g
	}
	else	local fmt `format'

	local rtype = cond("`transform'"=="", "adjusted", "raw")

	dis as txt _n "Quantiles of `rtype' residuals"
	matlist `QT', row(`:word 1 of `e(id)'') rspec(`rsp') ///
	   cspec( o4& %`chars's | %5.0f & ///
		  `fmt' & `fmt' & `fmt' & `fmt' & `fmt' o1&) ///

	return matrix Q = `Q'
	return matrix T = `T'
	return local  dtype `rtype'
end


program Stress, rclass
	syntax [, noTRANSform ///
	   MAXlength(numlist integer min=1 max=1 >=4 <=32) ///
	   FORmat(str) noTOTal  ]

	local id : word 1 of `e(id)'
	local chars `maxlength'
	if (`"`id'"' != "")     local ropt   row(`id')
	if (`"`chars'"' == "")  local chars 12
	if (`"`format'"' == "") local format %8.4f

	tempname linearf S T

	if "`transform'" == "" {
		matrix `linearf' = e(linearf)
	}
	else	matrix `linearf' = (0,1)
	matrix `S' = (.)
	matrix `T' = (.)

	mata: Stress("e(D)","e(Y)","`linearf'","`S'","`T'")

	matrix colnames `S' = Kruskal
	matrix colnames `T' = Kruskal
	matrix rownames `S' = `:rownames e(Y)'
	matrix rownames `T' = Total

	if "`total'" == "" {
		local ST   (`S' \ `T')
		local lopt lines(rowtotal)
	}
	else {
		local ST   `S'
		local lopt border(b)
	}
	local rtype = cond("`transform'"=="", "adjusted", "raw")

	dis _n as txt ///
	    "Stress between `rtype' dissimilarities and Euclidean distances"
	matlist `ST', left(4) twidth(`chars') `ropt' `lopt' format(`format')

	return matrix S = `S'
	return matrix T = `T'
	return local  dtype  `rtype'
end


// Summarize displays summ statistics of variables in MDS
program Summarize, rclass
	syntax [, VARlist(str) LAbel *]

	if `"`varlist'"' != "" {
		dis as err "option varlist() invalid"
		exit 198
	}

	if "`e(cmd)'" != "mds" {
		dis as err "estat summarize not valid after `e(cmd)'"
		exit 321
	}

	if "`e(coding)'" == "matrix" {
		dis as txt _n "Dissimilarities computed with " ///
			      "respect to normalized variables"
		if "`label'" == "" {
			local lft left(2)
		}
		matlist e(coding), border(b) row(Variable) `lft'
	}

	estat_summ `e(varlist)', `options' `label'
	return add
end

// UTILITY COMMANDS //////////////////////////////////////////////////////////

program Pairwise_Hline
	args chars c
	dis as txt _col(5) "{hline `=2*`chars'+3'}{c `c'}{hline 41}"
end


/* notation D(ij): (transformed) dissimilarity
	    E(ij): Euclidean distance between rows of Y

   Loss or stress functions are distance measures between D and E

		     sum (E(ij) - D(ij))^2
     Kruskal = SQRT ----------------------              (Cox & Cox, p 63)
			sum E(ij)^2                  ( = Stress1 measure)

 OTHER MEASURES

	     sum (D(ij)/(E(ij))^2
   Shepard = --------------------                 (Cox & Cox, p 51)
		sum E(ij)^-2


		    sum ((E(ij) - D(ij))^2) / D(ij)
   Sammon  = SQRT -------------------------------     (Cox & Cox, p 50)
			     sum D(ij)


   NB: Sammon's measure is commonly defined without the square root.
       We make this adjustment for commensurable with Kruskal's measure.
*/

mata
void function Stress( string scalar Dname,
		      string scalar Yname,
		      string scalar Fname,
		      string scalar Sname,
		      string scalar Tname )
{
	real scalar   Stress_n,  Stress_d,  tStress_n,  tStress_d
	real scalar   Dij, Eij, i, j, n
	real matrix   dY, D, F, S, T, Y

	D = st_matrix(Dname)
	Y = st_matrix(Yname)
	F = st_matrix(Fname)

	n = cols(D)
	S = J(n,1,0)
	T = J(1,1,0)

	// counter for "total" statistics
	tStress_n  = tStress_d  = 0

	for (i=1; i<=n; i++) {
		// statistics per category
		Stress_n  = Stress_d  = 0

		for (j=1; j<=n; j++) {
			if (i!=j) {
				Dij = (F[1,1] + F[1,2]*D[i,j])
				dY  = Y[i,.]-Y[j,.]
				Eij = sqrt(dY*dY')

				Stress_n  = Stress_n  +	(Eij-Dij)^2
				Stress_d  = Stress_d  +	Eij^2
			}
		}

		S[i,1] = sqrt(Stress_n / Stress_d)
		tStress_n  = tStress_n  + Stress_n
		tStress_d  = tStress_d  + Stress_d
	}

	T[1,1] = sqrt(tStress_n / tStress_d)

	st_matrix(Sname,S)
	st_matrix(Tname,T)
}
end
exit