fracgen.ado

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

*! version 1.4.5  17sep2004
program define fracgen, rclass
	version 6, missing

	gettoken v 0 : 0, parse(" ,")
	unab v : `v', max(1)

	local done 0
	gettoken nxt : 0, parse(" ,")
	while ("`nxt'" != "" & "`nxt'" != ",") & !`done' {
		cap confirm number `nxt'
		if !_rc {
			local powers "`powers' `nxt'"
			gettoken nxt 0 : 0, parse(" ,")
			gettoken nxt   : 0, parse(" ,")
		}
		else 	local done 1
	}
	if "`powers'"=="" {
		di in red "powers required"
		exit 198
	}

	syntax [if] [in] [, noSCAling REPLACE /*
		*/ ALL CATzero noDouble NAme(string) Index(integer 1) /*
		*/ EXPx(string) ORIgin(string) Zero noGEN /*
		*/ Adjust(string) STUBlen(int 6) SAYESAMP * ]

	if "`all'" == "" { 
		local all `"`if' `in'"'
	}
	else	local all

	if "`sayesamp'"=="" {
		local sayall `"`all'"'
	}
	else	local sayall "if e(sample)"


	local double = cond("`double'"!="", "", "double") 

	if `"`options'"' != "" { 
		di in bl `"[`options' ignored']"'
	}

	* catzero implies zero
	if "`catzero'"!="" { local zero zero }

	if "`adjust'"=="no" { local adjust }
	if "`adjust'"!="" & "`adjust'"!="mean" {
		cap confirm num `adjust'
		if _rc {
			di in red "invalid adjust(), must be # or mean"
			exit 198
		}
	}
	tempname small
	scalar `small'=1e-6

	tempvar x lnx
	frac_pq "`powers'" 1 0
	local np `r(np)'
	local i 1
	while `i'<=`np' {
		local p`i' `r(p`i')'
		local i=`i'+1
	}

* `lin' signifies only power 1 is used; but x could still be transformed.
	local lin = (`np'==1 & `p1'==1)

* identity transformation: do nothing except record name of original xvar.
	if `lin' & `"`zero'`origin'`expx'`name'`adjust'"'=="" {
		ret local names `v'
		local l : var lab `v'
		char `v'[fp] `l'
		ret scalar shift = 0 
		ret scalar scale = 1
		global S_1 `v'				/* double save */
		global S_2 0				/* double save */
		global S_3 1				/* double save */
		global S_4
		exit
	}
	local names
	local name = substr(cond("`name'"=="", "`v'", "`name'"), 1, `stublen')

	quietly {
		tempvar touse
		mark `touse' `if' `in'
		gen `double' `x' = `v' `all'

		gen `double' `lnx' = .
		frac_xo `x' `lnx' `lin' "`expx'" "`origin'" /*
		*/ "`zero'" "`scaling'" `v' `touse' "`adjust'"
		/*
			Now, `x' emerges unrestricted to the `touse' sample.
		*/
		local shift = cond(r(shifted)==0, 0, r(zeta))
		local expxest `r(expxest)'
		local scale `r(scale)'
		local adjust `r(adjust)'
		local r `v'
		if "`expx'"!="" {
			local e=substr(`"`r(expxest)'"',1,8)
			local r `"exp(`e'*`r')"'
			if "`adjust'"!="" {
				local adjust=exp(`r(expxest)'*`adjust')
			}
		}
		if "`adjust'"!="" {
			local adjust=(`adjust'+`shift')/`scale'
		}
		if `shift'!=0 { local r "(`r'+`shift')" }
		if "`scaling'"!="noscaling" {
			if `scale'<1 {
				local scale=1/`scale'
				local r "`r'*`scale'"
			}
			else {
				if `scale'>1 { local r "`r'/`scale'" }
			}
		}
		if "`r'"!="`v'" {
			local vn X
			local where ": X = `r'"
		}
		else 	local vn `v'
		if "`gen'"=="nogen" {
			ret scalar shift = `shift'
			ret scalar scale = `scale'
			ret local expxest `expxest'
			global S_2 `shift'		/* double save */
			global S_3 `scale'		/* double save */
			global S_4 `expxest'		/* double save */
			exit
		}
		local h0 1
		local plast 0
		local hlast "h0"
		local k 0
		local j 1
		while `j'<=`np' {
			if "`adjust'"!="" {
				tempname adj`j'
			}
			local hj h`j'
			local nj n`j' /*transformation for labelling purposes*/
			tempvar `hj'
			local pj `p`j''
			if abs(`pj'-`plast')>`small' { /*not a repeated power*/
				if abs(`pj')<`small' {
					gen `double' ``hj'' = `lnx'
					local `nj' ln(`vn')
					local k 1
					local nlast
					if "`adjust'"!="" {
						scalar `adj`j''=log(`adjust')
					}
				}
				else {
					if abs(`pj'-1)<`small' {
						gen `double' ``hj'' = `x'
						local `nj' `vn'
					}
					else {
						gen `double' ``hj'' = /*
						*/ cond(`x'==0,0,`x'^`pj')
						if int(2*abs(`pj'))!= /*
						*/ (2*abs(`pj')) {
							frac_ddp `pj' 4
							local `nj' `vn'^`r(ddp)'
						}
						else 	local `nj' `vn'^`pj'
					}
					if "`adjust'"!="" {
						scalar `adj`j''=`adjust'^`pj'
					}
					local k 0
					local nlast ``nj''*
				}
			}
			else {
				local k=`k'+1
				if `j'==1 {
					gen `double' ``hj'' = `lnx'
					if "`adjust'"!="" {
						scalar `adj`j''=log(`adjust')
					}
				}
				else {
					gen `double' ``hj'' = `lnx'*``hlast''
					if "`adjust'"!="" {
						scalar `adj`j''=/*
						*/ ln(`adjust')*`alast'
					}
				}
				if `k'==1 {
					local `nj' `nlast'ln(`vn')
				}
				else 	local `nj' `nlast'ln(`vn')^`k'
			}
			local hlast `hj'
			local plast `pj'
			if "`adjust'"!="" {
				local alast `adj`j''
			}
			local j = `j'+1
		}
	}
	local j 0
	if `index'+`np'>99 { local index = 99-`np' }
	while `j'<`np' {
		local k = `j'+`index'
		local j = `j'+1
		local hj h`j'
		local nj n`j'
		if `k'<10 { local k _`k' }
		local xj `name'`k'
		if "`replace'"!="" { capture drop `xj' }
		if "`adjust'"!="" {
			local adjj `adj`j''
			qui gen `double' `xj'=``hj''-`adjj'
			if `adjj'<0 {
				local s +
				local adjj=-`adjj'
			}
			else 	local s -
			local adjd: display %12.0g `adjj'
			local adjd=trim("`adjd'")
			di in gr /*
			*/ `"-> gen `double' `xj' = ``nj''`s'`adjd' `sayall'"'
			local l ``nj''`s'`adjd'`where'
		}
		else {
			qui gen `double' `xj'=``hj''
			di in gr `"-> gen `double' `xj' = ``nj'' `sayall'"'
			local l ``nj''`where'
		}
		lab var `xj' "`l'"
		char `xj'[fp] `l'
		drop ``hj''
		local names `names' `xj'
	}
	if "`v'"!="`r'" { 
		di in gr "   (where`where')"
	}
	if "`catzero'"!="" {
		local xj `name'_0
		if "`replace'"!="" { capture drop `xj' }
		qui gen byte `xj' = `v'<=0 `all'
		di in gr `"-> gen byte `xj' = `v'<=0 `sayall'"'
		local l "`v'<=0"
		lab var `xj' "`l'"
		local names `xj' `names'
		char `xj'[fp] `l'
	}
	ret local names `names'
	ret scalar shift = `shift'
	ret scalar scale = `scale'
	ret local  expxest `expxest'
	global S_1 `names'				/* double save */
	global S_2 `shift'				/* double save */
	global S_3 `scale'				/* double save */
	global S_4 `expxest'				/* double save */
	if "`adjust'"!="" {
* Save adjustments
		local j 1
		while `j'<=`np' {
			return scalar adj`j'=`adj`j''
			local j=`j'+1
		}
	}
end