*! version 1.0.1  10jul1998  statalist
program define orthog
	version 5.0
	local varlist "opt ex"
	local weight "aweight fweight"
	local if "opt"
	local in "opt"
	local options "Generate(string) MATrix(string) FLOAT"
	parse "`*'"
	if "`generat'" == "" {
		di in red "generate() required"
		exit 100
	}
	if "`matrix'" == "" {
		local o "*"
	}
	if "`float'" != "" {
		local type "float"
	}
	else local type "double"

	local nvar : word count `varlist'
	local ndim = `nvar' + 1
	parsevar `nvar' `type' `generat'
	local newvars "$S_1"

	parse "`varlist'", parse(" ")

	tempname n r
	`o' tempname r1 r2
	tempvar doit xx
	mark `doit' [`weight'`exp'] `if' `in'
	markout `doit' `*'

	quietly {
		`o' matrix `r1' = J(`ndim',`ndim',0)
		`o' matrix `r1'[`ndim',`ndim'] = 1
		`o' matrix `r2' = `r1'
		gen double `xx' = . in 1
		count if `doit'
		scalar `n' = _result(1)

		if "`weight'" != "" {
			tempvar w
			gen double `w' `exp' if `doit'
			sort `doit' `w'
			replace `xx' = sum(`w')
			replace `w' = `n'*`w'/`xx'[_N]
			local w "`w'*"
		}
		else sort `doit'

	/* First pass. */

		local i 1
		while `i' <= `nvar' {
			tempvar x`i'
			replace `xx' = sum(`w'``i'') if `doit'
			scalar `r' = `xx'[_N]/`n'
			`o' matrix `r1'[`ndim',`i'] = `r'
			gen `type' `x`i'' = ``i'' - `r' if `doit'
			local i = `i' + 1
		}

		local i 1
		while `i' <= `nvar' {
			replace `xx' = sum(`w'`x`i''^2)
			scalar `r' = sqrt(`xx'[_N]/`n')
			`o' matrix `r1'[`i',`i'] = `r'
			replace `x`i'' = `x`i''/`r'

			local j = `i' + 1
			while `j' <= `nvar' {
				replace `xx' = sum(`w'`x`i''*`x`j'')
				scalar `r' = `xx'[_N]/`n'
				`o' matrix `r1'[`i',`j'] = `r'
				replace `x`j'' = `x`j'' - `r'*`x`i''
				local j = `j' + 1
			}
			local i = `i' + 1
		}

	/* Second pass. */

		local i 1
		while `i' <= `nvar' {
			replace `xx' = sum(`w'`x`i'') if `doit'
			scalar `r' = `xx'[_N]/`n'
			`o' matrix `r2'[`ndim',`i'] = `r'
			replace `x`i'' = `x`i'' - `r' if `doit'
			local i = `i' + 1
		}

		local i 1
		while `i' <= `nvar' {
			replace `xx' = sum(`w'`x`i''^2)
			scalar `r' = sqrt(`xx'[_N]/`n')
			`o' matrix `r2'[`i',`i'] = `r'
			replace `x`i'' = `x`i''/`r'

			local j = `i' + 1
			while `j' <= `nvar' {
				replace `xx' = sum(`w'`x`i''*`x`j'')
				scalar `r' = `xx'[_N]/`n'
				`o' matrix `r2'[`i',`j'] = `r'
				replace `x`j'' = `x`j'' - `r'*`x`i''
				local j = `j' + 1
			}
			local i = `i' + 1
		}
	}

	if "`matrix'" != "" {
		matrix `matrix' = `r1'*`r2'
		matrix rownames `matrix' = `newvars' _cons
		matrix colnames `matrix' = `*' _cons
	}

	capture {
		local i 1
		while `i' <= `nvar' {
			local varname : word `i' of `newvars'
			rename `x`i'' `varname'
			label var `varname' "orthogonalized ``i''"
			local i = `i' + 1
		}
	}
	nobreak {
		if _rc {
			local rc = _rc
			local i 1
			while `i' <= `nvar' {
				local varname : word `i' of `newvars'
				capture drop `varname'
				local i = `i' + 1
			}
			error `rc'
		}
	}
end

program define parsevar
	local number "`1'"
	local type   "`2'"
	macro shift 2
	local vars "`*'"
	parse "`vars'", parse("*")
	if "`2'"=="*" & "`3'"=="" {
		if `number' > 1 {
			local vars "`1'1-`1'`number'"
		}
		else local vars "`1'1"
	}
	local varlist "req new"
	parse "`type'(`vars')"
	quietly drop `varlist'
	local nvar : word count `varlist'
	if `nvar' != `number' {
		if `number' > 1 { local s "s" }
		di in red "generate() must specify `number' new variable`s'"
		if `nvar' < `number' { error 102 }
		else                 { error 103 }
	}
	global S_1 "`varlist'"
end

exit