corr2data.ado

来自「是一个经济学管理应用软件 很难找的 但是经济学学生又必须用到」· ADO 代码 · 共 170 行

*! version 7.1.1  13dec2003
program corr2data
	version 8.2

	query sortseed
	local seed0 = r(sortseed)
	capture noisily  Make `0'
	set seed `seed0'
	if _rc {
		exit _rc
	}
end


program Make
	gettoken first 0: 0, parse(",")
	#del ;
	syntax [,
		n(string)
		CORR(string)
		COV(string)
		CStorage(string)
		Means(string)
		SDs(string)
		SEED(int 0)
		Double
		CLEAR
	] ;
	#del cr

	if `"`n'"' != "" {
		confirm integer n `n'
		if `n' == _N {
			local n
		}
	}
	if "`n'" == "" {	/* add newvarlist to existing dataset */
		local nobs = _N
		if `nobs' <= 0 {
			error 2000
		}
		if "`clear'" != "" {
			drop _all
			qui set obs `nobs'
			local n `nobs'
		}
	}
	else {			/* generate new dataset */
		if `n' <= 0 {
			error 2000
		}
		qui count
		if `n' != r(N) {
			qui des, short
			if r(changed) & ("`clear'" == "" ) {
				error 4
			}
			drop _all
		}
		local nobs = `n'
		qui set obs `nobs'
	}

	local 0 "`first'"
	syntax newvarlist
	local k : word count `varlist'

	if `nobs' <= `k' {
		dis as err "number of observations should exceed number of variables"
		exit 2001
	}

	tempname P
	mat `P' = I(`k')
							/* C = corr */
	if `"`corr'"' != "" {
		tempname C
		_m2matrix `C' corr `k' "`corr'" "`cstorage'"
		mat `P' = `C'
		mat `P'= cholesky(`P')
	}
							/* V = cov */
	if `"`cov'"' != "" {
		if `"`corr'"' != "" {
			dis as err "cov() and corr() may not be specified together"
			exit 198
		}
		tempname V S
		_m2matrix `V' cov `k' "`cov'" "`cstorage'"
		mat `S' = vecdiag(cholesky(`V'))
		mat `P' = `V'
		mat `P'= cholesky(`P')
	}
							/* M = means */
	tempname M
	if `"`means'"' != "" {
		_m2matrix `M' means `k' "`means'"
	}
	else {
		mat `M' = J(1,`k', 0)
	}
							/* S = stds */
	tempname S
	if "`sds'" != "" {
		if "`cov'" != "" {
			dis as err "cov() and sds() may not be specified together"
			exit 198
		}
		_m2matrix `S' sds `k' "`sds'"
	}
	else {
		mat `S' = J(1,`k',1)
	}

						/* generate new variables */
	set seed0 `seed'
	foreach var of local varlist {
		qui gen `double' `var' = invnorm(uniform0())
		qui sum `var'
		qui replace `var' = `var' - r(mean)
	}
					/* reform them to be zero corr */
	tempname T
	qui mat accum `T' = `varlist', noc dev
	mat `T' = `T'/(`nobs'-1)
	mat `T' = cholesky(syminv(`T'))
	forvalues i = 1 / `k' {
		tempname new`i' row
		mat `row' = (`T'[1..., `i'])'
		mat score `new`i'' = `row'
	}

	tokenize `varlist'
	forvalues i = 1 / `k' {
		qui replace ``i'' = `new`i''
	}
					/* transform to desired corr */
	mat roweq `P' = " "
	mat coleq `P' = " "	/* remove possible equation names from P */
	mat rownames `P' = `varlist'
	mat colnames `P' = `varlist'
	forvalues i = 1 / `k' {
		tempname new`i' row
		mat `row' = `P'[`i', 1...]
		mat score `new`i'' = `row'
	}

	// tokenize `varlist'
	forvalues i = 1 / `k' {
		qui replace ``i'' = `new`i''
	}

					/* transform to desired means and std */
	if "`cov'" != "" | "`sds'" != "" {
		forvalues i = 1 / `k' {
			qui replace ``i'' = ``i'' * `S'[1,`i']
		}
	}
	if "`means'" != "" {
		// tokenize `varlist'
		forvalues i = 1 / `k' {
			qui replace ``i'' = ``i'' + `M'[1,`i']
		}
	}

	if "`n'" != "" {
		dis as txt  "(obs `nobs')"
	}
end