mdsmat.ado

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

*! version 1.0.1  10may2005
program mdsmat
	version 9

	if replay() {
		if "`e(cmd)'" != "mdsmat" {
			dis as err "mdsmat estimation results not found"
			exit 301
		}
		Display `0'
		exit
	}

	Estimate `0'
end


program Estimate, eclass

	#del ;
	syntax anything(name=m id=matrix)
	[,
	// data options
		SHape(passthru)
		NAMes(passthru)
		SIMilarity		// Not to be documented
		s2d(passthru)
		FORCE
	// model options
		METhod(str)		// Not documented (only 1 method)
		DIMensions(numlist integer >=1 max=1)  // documented as dim()
		ADDconstant
	// display options
		*
	] ;
	#del cr

	_mds_parse_method `method'
	local method  `s(method)'

	_mds_parse_dopts `options' , method(`method')
	local display_options `s(opts)'

	if "`dimensions'" != "" {
		local dim dim(`dimensions')
	}

// get dissimilarity matrix DM in full storage mode ///////////////////////////

	tempname DM X

	GetFullDissim `m' , `similarity' `names' `shape' `s2d' `force'

	matrix `DM' = r(M)
	local dtype `r(dtype)'
	local s2d   `r(s2d)'

// MDS methods ////////////////////////////////////////////////////////////////

	if "`method'" == "classical" {
		_mds_classical `DM', `addconstant' `dim'
	}
	else {
		dis as err "method `method' not available"
		exit 198
	}

//  save rclass objects into eclass ///////////////////////////////////////////
	ereturn post, prop(nob noV eigen)
	
	foreach x in `:r(macros)' {
		ereturn local `x' `r(`x')'
	}
	foreach x in `:r(scalars)' {
		ereturn	scalar `x' = r(`x')
	}
	foreach x in `:r(matrices)'  {
		matrix `X' = r(`x')
		ereturn matrix `x' = `X'
	}

	ereturn matrix D          = `DM'
	ereturn local  dtype        `dtype'
	ereturn local  s2d          `s2d'
	ereturn local  dmatrix      `m'
	ereturn local  id           Category

	ereturn local  predict      mds_p
	ereturn local  estat_cmd    mds_estat

	ereturn local  cmd          mdsmat

// display output

	Display , `display_options'
end


program Display
	syntax [, *]

	_mds_display, `options'
end

// subroutines ===============================================================

program ParseShape, sclass
	local 0 `", `0'"'
	syntax [, Full Lower LLower Upper UUpper ]

	local opt `full' `lower' `llower' `upper' `uupper'
	opts_exclusive "`opt'" shape

	sreturn clear
	sreturn local shape `opt'
end


program GetFullDissim, rclass
	#del ;
	syntax  anything(name=m id=matrix)
	[ ,
		SHape(str)
		NAMes(str)
		SIMilarity
		s2d(str)
		FORce
	] ;
	#del cr

	ParseShape   `shape'
	local shape  `s(shape)'


	if `"`s2d'"' != "" {
		_mds_parse_s2d `s2d'
		local s2d    `s(s2d)'
		local dtype  similarity
	}
	else if `"`similarity'"' != "" {
		local dtype  similarity
		local s2d  standard
	}
	else local dtype dissimilarity


// verify shape() vs matrix ///////////////////////////////////////////////////

	confirm matrix `m'
	local nr = rowsof(`m')
	local nc = colsof(`m')

	if `nr' == `nc' {
		if `nc' > 1 & !inlist("`shape'","","full") {
			dis as err "shape() inconsistent with shape matrix"
			exit 503
		}
		local n = `nc'
		local shape full
	}
	else if `nc' > 1 & `nr' > 1 {
		dis as err "matrix invalid; neither square nor vector"
		exit 503
	}
	else {
		assert `nr' == 1 | `nc' == 1
		if "`shape'" == "" {
			dis as err "shape() should be specified"
			exit 198
		}
		else if "`shape'" == "full" {
			dis as err "shape() invalid; matrix is a vector"
			exit 198
		}

		if `nr' > `nc' {
			local mattype colvector
			local nrc = `nr'
		}
		else {
			local mattype rowvector
			local nrc = `nc'
		}

		local n = chop((1+sqrt(1+8*`nrc'))/2, 1e-8)
		if `n' != round(`n') {
			dis as err "length of `mattype' not feasible for " ///
			    "a triangle of a square matrix"
			exit 503
		}

		if inlist("`shape'","lower", "upper") {
			local --n
		}
	}

// verify names() /////////////////////////////////////////////////////////////

	if "`names'" == "" & "`shape'" != "full" {
		dis as err "names() required with triangular matrix input"
		exit 198
	}

	if "`names'" == "" & "`shape'" == "full" {
		local names : rownames `m'
		if "`names'" != "`:colnames `m''" {
			dis as txt "(row names differ from column names; " ///
				   "row names used)"
		}
	}

	if `:list sizeof names' != `n' {
		dis as err "names() invalid; incorrect number of names"
		exit 198
	}

	if "`:list dups names'" != "" {
		dis as err "names() invalid; duplicates found"
		exit 198
	}

// create square matrix DM ////////////////////////////////////////////////////

	tempname DM

	if "`shape'" == "full" {
		matrix `DM' = `m'

		if !issym(`DM') {
			if "`force'" == "" {
				dis as err "(dis)similarity matrix `m' " ///
				    "should be symmetric; " ///
				    "specify option force to symmmetrize"
				exit 198
			}
			matrix `DM' = 0.5*(`DM'+`DM'')
		}
	}
	else {
		matrix `DM' = J(`n',`n',0)

		if `nc'==1 {
			tempname M
			matrix `M' = `m''
		}
		else {
			local M `m'
		}

		local ij = 1
		forvalues i = 1/`n' {
			if "`shape'" == "lower" {
				local lj = 1
				local hj = `i'
			}
			else if "`shape'" == "llower" {
				local lj = 1
				local hj = `i'-1
			}
			else if "`shape'" == "upper" {
				local lj = `i'
				local hj = `n'
			}
			else if "`shape'" == "uupper" {
				local lj = `i'+1
				local hj = `n'
			}

			forvalues j = `lj'/`hj' {
				matrix `DM'[`i',`j'] = `M'[1,`ij']
				matrix `DM'[`j',`i'] = `M'[1,`ij']
				local ++ij
			}
		}
	}

	if "`dtype'" == "similarity" {
		if inlist("`shape'", "llower", "uupper") | "`force'" != "" {
			forvalues i = 1/`n' {
				matrix `DM'[`i',`i'] = 1
			}
		}
		else {
			forvalues i = 1/`n' {
				if `DM'[`i',`i'] != 1 {
					dis as err "diagonal of similarity" ///
					    " matrix should be 1"
					exit 198
				}
			}
		}

		forvalues i = 1/`n' {
			forvalues j = 1/`=`i'-1' {
				if !inrange(`DM'[`i',`j'],0,1) {
					dis as err "entries of similarity " ///
					 "matrix should be in the range [0,1]"
					exit 198
				}
			}
		}
	}

	if "`dtype'" == "dissimilarity" {
		if "`force'" != "" {
			forvalues i = 1/`n' {
				matrix `DM'[`i',`i'] = 0
			}
		}
		else if !inlist("`shape'", "llower", "uupper") {
			forvalues i = 1/`n' {
				if `DM'[`i',`i'] != 0 {
					dis as err "diagonal of " ///
					    "dissimilarity matrix should be 0"
					exit 198
				}
			}
		}

		forvalues i = 1/`n' {
			forvalues j = 1/`=`i'-1' {
				if `DM'[`i',`j'] < 0 {
					dis as err "entries of similarity " ///
					   "matrix should be >= 0"
					exit 198
				}
			}
		}
	}

	matrix rownames `DM' = `names'
	matrix colnames `DM' = `names'

// convert to dissimilarities ////////////////////////////////////////////////

	if "`dtype'" == "similarity" {
		_mds_s2d `DM' , `s2d'
	}

	return matrix M  =  `DM'
	return local s2d    `s2d'
	return local dtype  `dtype'
end
exit