cluster_tree_8.ado

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

	local they = `gdi(ymetric)'-`bbuf' - `adjusthgt'
	gdi textvalign= baseline
	gdi textangle=0
	gdi texthalign=center
	gdi textchange
	if `"`b1title'"' != "" {
		gdi text `midcol' `they' `b1title'
	}
	else if `"`title'"' != "" {
		gdi text `midcol' `they' `title'
	}
	else if `"`title'"' == "" && `"`b1title'"' == "" {
		gdi text `midcol' `they' `btitle'
	}
	local bbuf = `bbuf' + `font1high' + `mygapv'

	if `"`t1title'"' != "" {
		local they = `tbuf'+`font1high'
		gdi textvalign=baseline
		gdi textangle=0
		gdi texthalign=center
		gdi textchange
		gdi text `midcol' `they'  `t1title'
		local tbuf = `they' + `mygapv'
	}

	if `"`b2title'"' != "" {
		local they = `gdi(ymetric)'-`bbuf'
		gdi textvalign=baseline
		gdi textangle=0
		gdi texthalign=center
		gdi textchange
		gdi text `midcol' `they'  `b2title'
		local bbuf = `bbuf' + `font2high' + `mygapv'
	}
	if `"`t2title'"' != "" {
		local they = `tbuf' + `font2high'
		gdi textvalign=baseline
		gdi textangle=0
		gdi texthalign=center
		gdi textchange
		gdi text `midcol' `they'  `t2title'
		local tbuf = `they' + `mygapv'
		local tbuf = `tbuf' + `mygapv' /* looks better with extra gap */
	}

	if `"`l1title'"' != "" {
		local thex = `lbuf' + `font1wide'
		gdi textangle=90
		gdi textvalign=middle
		gdi texthalign=center
		gdi textchange
		gdi text  `thex' `midrow' `l1title'
		local lbuf = `thex' + `mygaph'
	}
	if `"`r1title'"' != "" {
		local thex = `gdi(xmetric)'-`rbuf'-`adjusttext'+`titletext'
		gdi textangle=90
		gdi textvalign=middle
		gdi texthalign=center
		gdi textchange
		gdi text `thex' `midrow' `r1title'
		local rbuf = `rbuf' + `font1wide' + `mygaph'
	}

	/* change to inner vertical title font size */
	gdi textsize=`fontsize'+ (`fontsize'*(12/100))
	gdi textchange

	if `"`l2title'"' != "" {
		local thex = `lbuf' + `font2wide'+ `titletext'
		gdi textangle=90
		gdi textvalign=middle
		gdi texthalign=center
		gdi textchange
		gdi text `thex' `midrow'  `l2title'
		local lbuf = `thex' + `mygaph'
	}
	else if "`defaultl2'" != "" {
		local thex = `lbuf' + `font2wide'
		gdi textangle=90
		gdi textvalign=middle
		gdi texthalign=center
		gdi textchange
		gdi text `thex' `midrow'  `defaultl2'
		local lbuf = `thex' + `mygaph'
	}
	if `"`r2title'"' != "" {
		local thex = `gdi(xmetric)'-`rbuf'-`adjusttext'
		gdi textangle=90
		gdi textvalign=middle
		gdi texthalign=center
		gdi textchange
		gdi text  `thex' `midrow'  `r2title'
		local rbuf = `rbuf' + `font2wide' + `mygaph'
		local rbuf = `rbuf' + `mygaph' /* looks better with extra gap */
	}
	else if "`defaultr2'" != "" {
		local thex = `gdi(xmetric)'-`rbuf'- `adjusttext'
		gdi textangle=90
		gdi textvalign=middle
		gdi texthalign=center
		gdi textchange
		gdi text `thex' `midrow'  `defaultr2'
		local rbuf = `rbuf' + `font1wide' + `mygaph'
		local rbuf = `rbuf' + `mygaph' /* looks better with extra gap */
	}

	/* change to regular font size */

	gdi textsize=`fontsize'
	gdi textchange

	/* take care of bottom and left axis */
	if "`vertlabels'" != "" {
		tempvar lchars
		capture confirm string var `xlabel'
		if _rc ~= 0 {
			qui gen byte `lchars' = length(string(`xlabel')) /*
							*/ if `atx' < .
		}
		else {
			qui gen byte `lchars' = length(`xlabel') if `atx' < .
		}
		qui summ `lchars', meanonly
		local vrows1 = r(max)
		local vrows = r(max)
		if "`xlabel2'" != "" {
			qui replace `lchars' = length(`xlabel2') if `atx' < .
			qui summ `lchars', meanonly
			local vrows2 = r(max)
			local vrows = `vrows' + `vrows2'
		}
		local bthey = `gdi(ymetric)'-`bbuf' - (`vrows'-1)*`fonthigh'
		if "`xlabel2'" != "" {
			local bthey = `bthey' - `mygapv'
		}
		local newbbuf = `bbuf' + `vrows'*`fonthigh' + `mygapv'
		if "`xlabel2'" != "" {
			local newbbuf = `newbbuf' + `mygapv'
		}
	}
	else { /* horizontal labels */
		local bthey = `gdi(ymetric)'-`bbuf'
		local newbbuf = `bbuf' + `fonthigh' + `mygapv'
		if "`xlabel2'" != "" {
			local bthey = `bthey' - `fonthigh' - `mygapv'
			local newbbuf = `newbbuf' + `fonthigh' + `mygapv'
		}
	}

	if "`axis'"' != "noaxis" {
		gdi linergb = `textred' `textgreen' `textblue'
		gdi penchange
		/* take care of left axis */
		if "`ticks'`extraticks'" != "" {
			/* setup and make call to do left axis */
			local lbuf2 = `lbuf' + `gap'*`fontwide' - `radj'
			local lbuf3 = `lbuf2' + `mygaph' + `fontwide' - `radj'
			XXlaxis `gap' `lbuf2' `lbuf3' `maxy' `tbuf' `newbbuf' /*
				*/ `tickwidth' "`ticks'" "`ticklabs'" /*
				*/ "`extraticks'" `fonthigh'
			local lbuf = `lbuf3' + `mygaph'
		}
		if "`rticks'`rextraticks'" != "" {
			/* setup and make call to do right axis */
			local rbuf2 = `rbuf' + `gap'*`fontwide'
			local rbuf3 = `rbuf2' + `mygaph' + `fontwide'
			XXraxis `gap' `rbuf3' `rbuf2' `maxy' `tbuf' `newbbuf' /*
				*/ `tickwidth' "`rticks'" "`rticklabs'" /*
				*/ "`rextraticks'" `fonthigh'
			local rbuf = `rbuf3' + `mygaph'
		}
		gdi linergb = `treered' `treegreen' `treeblue'
		gdi penchange
	}

	if "`axis'"' != "noaxis" {
		if "`rticks'`rextraticks'" != "" {
			local tmpbthey = `bthey'+ 310
		}
		else {
			local tmpbthey = `bthey'
		}

		XXbaxis `xlabel' "`xlabel2'" `maxx' `atx' `lbuf' /*
			*/ `rbuf' `tmpbthey' "`vrows1'" "`vrows2'" `fonthigh' `mygapv' 
	}
	else {
		/* take care of bottom "axis" labeling */
		XXbaxis `xlabel' "`xlabel2'" `maxx' `atx' `lbuf' `rbuf' `bthey' /*
			*/ "`vrows1'" "`vrows2'" `fonthigh' `mygapv'
	}
	local bbuf = `newbbuf'

	/* Now the tree drawing begins */
	gdi linergb = `treered' `treegreen' `treeblue'
	gdi penchange

	if "`quick'" != "" {
		QuickTree `maxx' `maxy' `atx' `y' `lbuf' `rbuf' `tbuf' `bbuf'
	}
	else {
		DrawTree `maxx' `maxy' `atx' `y' `lbuf' `rbuf' `tbuf' `bbuf'
	}
    } /* end: capture noisily */
	local rc = _rc
	gdi end

	if "`saving'" != "" {
		_asis save `saving'
	}

	exit `rc'
end


program define QuickTree
	args maxx maxy atx y lbuf rbuf tbuf bbuf

	XXLine `atx'[`maxx'] 0 `atx'[`maxx'] `maxy' /*
				*/ `maxx' `maxy' `lbuf' `rbuf' `tbuf' `bbuf'

	local maxxm1 = `maxx' - 1
	forvalues i = 1/`maxxm1' {
		XXLine `atx'[`i'] 0 `atx'[`i'] `y'[`i'] /*
				*/ `maxx' `maxy' `lbuf' `rbuf' `tbuf' `bbuf'
		local ip1 = `i' + 1
		forvalues j = `ip1'/`maxx' {
			if `y'[`j'] >= `y'[`i'] {
				local tox `j'
				continue, break
			}
		}
		XXLine `atx'[`i'] `y'[`i'] `atx'[`tox'] `y'[`i'] /*
				*/ `maxx' `maxy' `lbuf' `rbuf' `tbuf' `bbuf'
	}

end


program define DrawTree
	args maxx maxy atx y lbuf rbuf tbuf bbuf

	tempvar aty diff
	qui gen double `aty' = 0 if `atx' < .
	qui gen double `diff' = `y' if `atx' < .

	local change 1
	local dotcnt 0
	while `dotcnt' < `maxx' - 1 {
		local atj 0
		local i 1
		while `i' <= `maxx' {
			if `atx'[`i'] < . {
				if ((`atj' == 0)|(`y'[`i'] < `y'[`atj'])) & /*
							*/ (`diff'[`i'] != 0) {
					XXLine `atx'[`i'] `aty'[`i'] /*
						*/ `atx'[`i'] `y'[`i'] /*
						*/ `maxx' `maxy' /*
						*/ `lbuf' `rbuf' `tbuf' `bbuf'
					qui replace `aty' = `y'[`i'] in `i'
				}
				else if (`diff'[`i'] != 0) & /*
						*/ (`aty'[`i'] != `y'[`atj']) {
					XXLine `atx'[`i'] `aty'[`i'] /*
						*/ `atx'[`i'] `y'[`atj'] /*
						*/ `maxx' `maxy' /*
						*/ `lbuf' `rbuf' `tbuf' `bbuf'
					qui replace `aty' = `y'[`atj'] in `i'
				}
				local atj `i'
			}
			local i = `i' + 1
		}
		qui replace `diff' = `y' - `aty'
		local atj 0
		local i 1
		while `i' <= `maxx' {
			if `atx'[`i'] < . {
				if (`diff'[`i'] != 0) & (`diff'[`atj'] == 0) {
					XXLine `atx'[`atj'] `aty'[`atj'] /*
						*/ `atx'[`i'] `aty'[`i'] /*
						*/ `maxx' `maxy' /*
						*/ `lbuf' `rbuf' `tbuf' `bbuf'
					qui replace `atx' = (`atx'[`i'] + /*
						*/ `atx'[`atj'])/2 in `i'
					qui replace `atx' = . in `atj'
					local dotcnt = `dotcnt' + 1
				}
				local atj `i'
			}
			local i = `i' + 1
		}
	}
end


program define XXLine

	local x1 = `1'
	local y1 = `2'
	local x2 = `3'
	local y2 = `4'
	local maxx = `5'
	local maxy = `6'
	local lbuf = `7'	/* left buffer   */
	local rbuf = `8'	/* right buffer  */
	local tbuf = `9'	/* top buffer    */
	local bbuf = `10'	/* bottom buffer */
	local adj  = 140

	/* Stata -gdi- dimension limits

		upper left corner is  (0             , 0            )
		lower left corner is  (`gdi(ymetric)' , 0            )
		upper right corner is (0             , `gdi(xmetric)')
		lower right corner is (`gdi(ymetric)' , `gdi(xmetric)')

	   But we will only use from

		upper left corner  (`tbuf'              ,`lbuf'        )
		lower left corner  (`gdi(ymetric)'-`bbuf',`lbuf'        )
		upper right corner (`tbuf'              ,`gdi(xmetric)'-`rbuf')
		lower right corner (`gdi(ymetric)'-`bbuf',`gdi(xmetric)'-`rbuf')
	*/
	local nrows `gdi(ymetric)' /* Stata max row dimension */
	local ncols `gdi(xmetric)' /* Stata max column dimension */

	local r1 = `nrows'-`bbuf'-(`nrows'-`bbuf'-`tbuf')*`y1'/`maxy'
	local r2 = `nrows'-`bbuf'-(`nrows'-`bbuf'-`tbuf')*`y2'/`maxy'
	local c1 = `lbuf' + (`ncols'-`rbuf'-`lbuf')*`x1'/`maxx' - `adj'
	local c2 = `lbuf' + (`ncols'-`rbuf'-`lbuf')*`x2'/`maxx' - `adj'

	gdi line  `c1' `r1' `c2' `r2'
end


program define XXbaxis
	args xlab xlab2 maxx atx lbuf rbuf they vrows1 vrows2 fonthigh mygapv
	local nrows = `gdi(ymetric)' /* Stata max row dimension */
	local ncols = `gdi(xmetric)' /* Stata max column dimension */
	local adjusthgt = 265
	local adjx = 140

	tempvar rind cind
	qui gen double `cind' = `lbuf' + (`ncols'-`rbuf'-`lbuf')*`atx'/`maxx' /*
								*/ if `atx' < .
	capture confirm string var `xlab'
	if _rc ~= 0 {
		tempvar zzz
		qui gen str1 `zzz' = ""
		qui replace `zzz' = string(`xlab') if `atx' < .
	}
	else {
		local zzz `xlab'
	}
	gdi texthalign=center
	gdi textangle=0
	gdi textchange

	if "`vrows1'" != "" {
		tempvar azz
		qui gen str1 `azz' = ""
		qui gen int `rind' = .
		forvalues i = 1/`vrows1' {
			qui replace `rind' = `they' if `atx' < .
			qui replace `azz' = " " if `atx' < .
			qui replace `azz' = substr(`zzz',`i',1) /*
			*/ if substr(`zzz',`i',1) != "" & `atx' < .
			local N = _N
			forvalues j = 1/`N' {
				if (`atx'[`j'] < .) {
					local y = `rind'[`j'] - `adjusthgt'
					local x = `cind'[`j'] - `adjx'
					local str = `azz'[`j']
					gdi text `x' `y' `str'
				}
			}
			local they = `they' + `fonthigh'
		}
	}
	else {
		qui gen int `rind' = `they' if `atx' < .
		local N = _N
		forvalues j = 1/`N' {
			if (`atx'[`j'] < .) {
				local y = `rind'[`j']-`adjusthgt'
				local x = `cind'[`j'] - `adjx'
				local str = `zzz'[`j']
				gdi text `x' `y' `str'
			}
		}
		local they = `they' + `fonthigh'
	}

	if "`xlab2'" != "" {
		local zzz `xlab2'
		local they = `they' + `mygapv'
		if "`vrows2'" != "" {
			forvalues i = 1/`vrows2' {
				qui replace `rind' = `they' if `atx' < .
				qui replace `azz' = " " if `atx' < .
				qui replace `azz' = substr(`zzz',`i',1) if /*
					*/ substr(`zzz',`i',1) != "" & `atx'< .
				local N = _N
				forvalues j = 1/`N' {
					if (`atx'[`j'] < .) {
						local y=`rind'[`j']-`adjusthgt'
						local x = `cind'[`j'] - `adjx'
						local str = `azz'[`j']
						gdi text `x' `y' `str'
					}
				}
				local they = `they' + `fonthigh'
			}
		}
		else {
			qui replace `rind' = `they' if `atx' < .
			local N = _N
			forvalues j = 1/`N' {
				if (`atx'[`j'] < .) {
					local y = `rind'[`j']-`adjusthgt'
					local x = `cind'[`j'] - `adjx'
					local str = `zzz'[`j']
					gdi text `x' `y' `str'
				}
			}

		}
	}
end


program define XXlaxis
	args gap numspot axspot maxy tbuf bbuf tickw ticks ticklabs /*
		*/ extraticks fonthigh
	/* gap is the value of the gap() option (number of spaces the numbers
		are given to display in)
	   numspot is the rightmost place for the numbers
	   axspot is the place for the axis line and any ticks should
		extend to the left of that
	   maxy is the maximum y value in the graph
	   tbuf is the top title buffer area (need to stay out of)
	   bbuf is the bottom title buffer area (need to stay out of)
	   tickw is the width of a tick mark
	   ticks is a list of tick locations
	   ticklabs is a list of the real labels for the ticks
	   extraticks is a list of extra tick marks to make without labels
	   fonthigh is the height of the font (for centering tick labels)
	*/

	local nrows `gdi(ymetric)' /* Stata max row dimension */
	local tickbeg = `axspot' - `tickw'

	/* draw the line */
	local ybot = `nrows'-`bbuf'

	gdi line `axspot' `ybot' `axspot' `tbuf'

	/* take care of ticks with labels */
	local tickn : word count `ticks'
	gdi texthalign=right
	gdi textangle=0
	gdi textchange

	forvalues i = 1/`tickn' {
		local atick : word `i' of `ticks'
		local tmpy = `ybot' - (`ybot'-`tbuf')*`atick'/`maxy'
		gdi line `tickbeg' `tmpy' `axspot' `tmpy'
		local atlab : word `i' of `ticklabs'
		local atlab = string(`atlab',"%`gap'.0g")
		gdi text  `numspot' `tmpy'  `atlab'
	}

	/* take care of extra ticks */
	foreach atick of local extraticks {
		local tmpy = `ybot' - (`ybot'-`tbuf')*`atick'/`maxy'
		gdi line `tickbeg' `tmpy' `axspot' `tmpy'
	}
end


program define XXraxis
	args gap axspotd numspotd maxy tbuf bbuf tickw ticks ticklabs /*
		*/ extraticks fonthigh
	/* gap is the value of the gap() option (number of spaces the numbers
		are given to display in)
	   axspotd is the amount to come in from far left to place the axis
		line and any ticks should extend to the right of that
	   numspotd is the amount to come in from far left to place leftmost
		place for the numbers
	   maxy is the maximum y value in the graph
	   tbuf is the top title buffer area (need to stay out of)
	   bbuf is the bottom title buffer area (need to stay out of)
	   tickw is the width of a tick mark
	   ticks is a list of tick locations
	   ticklabs is a list of the real labels for the ticks
	   extraticks is a list of extra tick marks to make without labels
	   fonthigh is the height of the font (for centering tick labels)
	*/

	local nrows `gdi(ymetric)' /* Stata max row dimension */
	local ncols `gdi(xmetric)' /* Stata max col dimension */

	local axspot = `ncols' - `axspotd'
	local tickend = `ncols' - `axspotd' + `tickw'
	local numspot = `ncols' - `numspotd'

	/* draw the line */
	local ybot = `nrows'-`bbuf'
	gdi line `axspot' `ybot' `axspot' `tbuf'

	/* take care of ticks with labels */
	local tickn : word count `ticks'
	gdi textvalign= baseline
	gdi textangle=0
	gdi texthalign=left
	gdi textchange
	forvalues i = 1/`tickn' {
		local atick : word `i' of `ticks'
		local tmpy = `ybot' - (`ybot'-`tbuf')*`atick'/`maxy'
		gdi line `axspot' `tmpy' `tickend' `tmpy'
		local atlab : word `i' of `ticklabs'
		local atlab = string(`atlab',"%`gap'.0g")
		local tmpy = `tmpy' + `fonthigh'/2
		gdi text  `numspot' `tmpy'  `atlab'
	}

	/* take care of extra ticks */
	foreach atick of local extraticks {
		local tmpy = `ybot' - (`ybot'-`tbuf')*`atick'/`maxy'
		gdi line `axspot' `tmpy' `tickend' `tmpy'
	}
end


program define GetSigDigits, rclass
	/* returns -x- truncated (not rounded) to -digits- significant digits */
	args x digits

	if `x' == 0 {
		return local answer 0
	}
	else {
		local z = int(log10(abs(`x')))
		if `z' > 0 {
			local z = `z' + 1
		}
		local z = 10^(`z' - `digits')
		local z = int(`x'/`z')*`z'
		return local answer `z'
	}
end