permute.ado

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

*! version 2.2.7  01mar2005
program permute
	version 9
	local version : di "version " string(_caller()) ":"

	// Stata 8 syntax
	capture _on_colon_parse `0'
	if c(rc) | `"`s(after)'"' == "" {
		local zero `"`0'"'
		gettoken permvar zero : zero
		capture confirm var `permvar'
		if !c(rc) {
			gettoken old : zero , qed(qed)
			if `qed' {
				`version' permute_8 `0'
				exit
			}
		}

		capture syntax [anything] [using] [, * ]
		if !c(rc) {
			if _by() {
				error 190
			}
			Results `0'
			exit
		}
	}

	preserve
	`version' Permute `0'
end

program Permute
	version 9
	local version : di "version " string(_caller()) ":"

	// get name of variable to permute
	gettoken permvar 0 : 0, parse(" ,:")
	confirm variable `permvar'
	unab permvar : `permvar'

	// <my_stuff> : <command>
	_on_colon_parse `0'
	local command `"`s(after)'"'
	local 0 `"`s(before)'"'

	// quick check for -force- and -nodrop- options
	// NOTE: exp_list is required
	syntax anything(name=exp_list			///
		id="expression list" equalok)		///
		[fw iw pw aw] [if] [in] [,		///
			FORCE				///
			noDROP				///
			Level(passthru)			///
			*				/// other options
		]

	if "`weight'" != "" {
		local wgt [`weight'`exp']
	}

	// parse the command and check for conflicts
	`version' _prefix_command permute `wgt' `if' `in' , ///
		`efopt' `level': `command'

	if "`force'" == "" & `"`s(wgt)'"' != "" {
		// permute does not allow weights
		local 0 `s(wgt)'
		syntax [, NONOPTION ]
	}

	local version	`"`s(version)'"'
	local cmdname	`"`s(cmdname)'"'
	local cmdargs	`"`s(anything)'"'
	local wgt	`"`s(wgt)'"'
	local wtype	`"`s(wtype)'"'
	local wexp	`"`s(wexp)'"'
	local cmdopts	`"`s(options)'"'
	local rest	`"`s(rest)'"'
	local efopt	`"`s(efopt)'"'
	local level	`"`s(level)'"'
	// command initially executed using entire dataset
	local xcommand	`"`s(command)'"'
	if "`drop'" != "" {
		// command with [if] [in]
		local command	`"`s(command)'"'
	}
	else {
		// command without [if] [in]
		local command	`"`cmdname' `cmdargs' `wgt'"'
		if `"`cmdopts'"' != "" {
			local command `"`:list retok command', `cmdopts'`rest'"'
		}
		else	local command `"`:list retok command'`rest'"'
		local cmdif	`"`s(if)'"'
		local cmdin	`"`s(in)'"'
	}

	local exclude permute statsby
	if `:list cmdname in exclude' ///
	 | ("`force'" == "" & substr("`cmdname'",1,3) == "svy") {
		di as err "`cmdname' is not supported by permute"
		exit 199
	}

	// now check the rest of the options
	local 0 `", `options'"'
	syntax [,			///
		noDOTS			///
		Reps(integer 100)	///
		SAving(string)		///
		DOUBle			/// not documented
		STRata(varlist)		///
		SEED(string)		///
		noDROP			///
		NOIsily			/// "prefix" options
		TRace			///
		REJECT(string asis)	///
		nowarn			///
		EPS(real 1e-7)		/// -Results- options
		LEft RIght		///
		noHeader		///
		noLegend		///
		Verbose			///
		TItle(passthru)		///
		notable			/// not documented
	]

	// set the seed
	if "`seed'" != "" {
		set seed `seed'
	}
	local seed `c(seed)'

	if "`trace'" != "" {
		local noisily noisily
		local traceon	set trace on
		local traceoff	set trace off
	}
	if "`noisily'" != "" {
		local dots nodots
	}
	local nodots `dots'
	local dots = cond("`dots'" != "", "*", "_dots")
	local noi = cond("`noisily'"=="", "*", "noisily")

	// preliminary parse of <exp_list>
	_prefix_explist `exp_list', stub(_pm_)
	local eqlist	`"`s(eqlist)'"'
	local idlist	`"`s(idlist)'"'
	local explist	`"`s(explist)'"'
	local eexplist	`"`s(eexplist)'"'

	_prefix_note `cmdname', `nodots'
	if "`noisily'" != "" {
		di "permute: First call to `cmdname' with data as is:" _n
		di as inp `". `xcommand'"'
	}

	// run the command using the entire dataset
	preserve
	_prefix_clear, e r
	`traceon'
	capture noisily quietly `noisily'		///
		`version' `xcommand'
	`traceoff'
	local rc = c(rc)
	// error occurred while running on entire dataset
	if `rc' {
		_prefix_run_error `rc' permute `cmdname'
	}
	// check for rejection of results from entire dataset
	if `"`reject'"' != "" {
		_prefix_reject permute `cmdname' : `reject'
		local reject `"`s(reject)'"'
	}

	// check e(sample)
	_prefix_check4esample permute `cmdname'
	if "`drop'" == "" {
		local keepesample `"`s(keep)'"'
	}
	if "`warn'" == "" {
		local diwarn	`"`s(diwarn)'"'
	}

	// expand eexp's that may be in eexplist, and build a matrix of the
	// computed values from all expressions
	tempname b
	_prefix_expand `b' `explist',		///
		stub(_pm_)			///
		eexp(`eexplist')		///
		colna(`idlist')			///
		coleq(`eqlist')			///
		// blank
	local k_eq	`s(k_eq)'
	local k_exp	`s(k_exp)'
	local k_eexp	`s(k_eexp)'
	local K = `k_exp' + `k_eexp'
	local k_extra	`s(k_extra)'
	local names	`"`s(enames)' `s(names)'"'
	local coleq	`"`s(ecoleq)' `s(coleq)'"'
	local colna	`"`s(ecolna)' `s(colna)'"'
	forval i = 1/`K' {
		local exp`i' `"`s(exp`i')'"'
	}
	// setup list of missings
	forvalues j = 1/`K' {
		local mis `mis' (.)
		if missing(`b'[1,`j']) {
			di as err ///
			`"'`exp`j''' evaluated to missing in full sample"'
			exit 322
		}
	}


	local ropts	eps(`eps')		///
			`left' `right'		///
			level(`level')		///
			`header'		///
			`verbose'		///
			`title'			///
			`table'

	// check options
	if `reps' < 1 {
		di as err "reps() must be a positive integer"
		exit 198
	}
	if `"`saving'"'=="" {
		tempfile saving
		local filetmp "yes"
	}
	else {
		_prefix_saving `saving'
		local saving	`"`s(filename)'"'
		if "`double'" == "" {
			local double	`"`s(double)'"'
		}
		local every	`"`s(every)'"'
		local replace	`"`s(replace)'"'
	}

	// keep only the estimation sample
	if `"`keep'"' != "" {
		quietly `keep'
		restore, not
		preserve
	}
	else {
		restore, preserve
		if "`cmdif'`cmdin'" != "" {
			quietly keep `cmdif' `cmdin'
		}
	}

	if `"`strata'"' != "" {
		if `:list permvar in strata' {
			di as err ///
"permutation variable may not be specified in strata() option"
			exit 198
		}
		tempvar sflag touse
		mark `touse'
		markout `touse' `strata'
		sort `touse' `strata', stable
		by `touse' `strata': gen `sflag' = _n==1 if `touse'
		qui replace `sflag' = sum(`sflag')
		local nstrata = `sflag'[_N]
		local ustrata `strata'
		local strata `sflag'
		sort `strata' , stable
	}

	local obs = _N
	if "`strata'"!="" {
		local bystrata "by `strata':"
	}
	if `eps' < 0 {
		di as err "eps() must be greater than or equal to zero"
		exit 198
	}

	// display the resample warning
	`diwarn'

	// temp variables for post
	local stats
	forvalues j = 1/`K' {
		tempname x`j'
		local stats `stats' (`b'[1,`j'])
		local xstats `xstats' (`x`j'')
	}

	// prepare post
	tempname postnam
	postfile `postnam' `names' using `"`saving'"', ///
		`double' `every' `replace'
	post `postnam' `stats'

	// check if `permvar' is a single dichotomous variable
	tempvar v
	qui summarize `permvar'
	local binary 0
	capture assert r(N)==_N & (`permvar'==r(min) | `permvar'==r(max))
	if c(rc)==0 {
		tempname min max
		scalar `min' = r(min)
		scalar `max' = r(max)

		qui `bystrata' gen long `v' = sum(`permvar'==`max')
		qui `bystrata' replace `v' = `v'[_N]

		local binary 1
	}
	else	gen long `v' = _n

	if "`dots'" == "*" {
		local noiqui noisily quietly
	}

	// do permutations
	if "`nodots'" == "" | "`noisily'" != "" {
		di
		_dots 0, title(Permutation replications) reps(`reps') `nodots'
	}
	local rejected 0
	forvalues i = 1/`reps' {
		if `binary' {
			PermDiV "`strata'" `v' `min' `max' `permvar'
		}
		else {
			PermVars "`strata'" `v' `permvar'
		}

		// analyze permuted data
		`noi' di as inp `". `command'"'
		`traceon'
		capture `noiqui' `noisily' `version' `command'
		`traceoff'
		if (c(rc) == 1) error 1
		local bad = c(rc) != 0
		if c(rc) {
			`noi' di in smcl as error ///
`"{p 0 0 2}an error occurred when permute executed `cmdname', "' ///
`"posting missing values{p_end}"'
			post `postnam' `mis'
		}
		else {
			if `"`reject'"' != "" {
				capture local rejected = `reject'
				if c(rc) {
					local rejected 1
				}
			}
			if `rejected' {
				local bad 1
				`noi' di as error ///
`"{p 0 0 2}rejected results from `cmdname', "' ///
`"posting missing values{p_end}"'
				post `postnam' `mis'
			}
			else {
				forvalues j = 1/`K' {
					capture scalar `x`j'' = `exp`j''
					if (c(rc) == 1) error 1
					if c(rc) {
						local bad 1
						`noi' di in smcl as error ///
`"{p 0 0 2}captured error in `exp`j'', posting missing value{p_end}"'
						scalar `x`j'' = .
					}
					else if missing(`x`j'') {
						local bad 1
					}
				}
				post `postnam' `xstats'
			}
		}
		`dots' `i' `bad'
	}
	`dots' `reps'

	// cleanup post
	postclose `postnam'

	// load file `saving' with permutation results and display output
	capture use `"`saving'"', clear
	if c(rc) {
		if c(rc) >= 900 & c(rc) <= 903 {
			di as err ///
"insufficient memory to load file with permutation results"
		}
		error c(rc)
	}
	label data `"permute `permvar' : `cmdname'"'

	// save permute characteristics and labels to data set
	forvalues i = 1/`K' {
		local name : word `i' of `names'
		local x = `name'[1]
		char `name'[permute] `x'
		local label = substr(`"`exp`i''"',1,80)
		label variable `name' `"`label'"'
		char `name'[expression] `"`exp`i''"'
		if `"`coleq'"' != "" {
			local na : word `i' of `colna'
			local eq : word `i' of `coleq'
			char `name'[coleq] `eq'
			char `name'[colname] `na'
			if `i' <= `k_eexp' {
				char `name'[is_eexp] 1
			}
		}
	}
	char _dta[k_eq] `k_eq'
	char _dta[k_eexp] `k_eexp'
	char _dta[k_exp] `k_exp'
	char _dta[N_strata] `nstrata'
	char _dta[strata] `ustrata'
	char _dta[N] `obs'