prog define mlu, rclass
*!	Ver. 2.28 7Sep2020 by Mead Over, CGD: Matrix lookup
*!  Syntax: mlu matrix_name[rowid,colid] , [local(string) global(string) scalar(string) Verbose STata MAta add replace ]
	version 11.1
	syntax anything , [Local(string) Global(string) Scalar(string) Verbose STata_matrix MAta_matrix add replace debug ]

	local argument = subinstr(`"`anything'"'," ","",.)

	tokenize `"`argument'"', parse("[,] ")

	if "`debug'"=="debug" {
		local i = 1
		while `"``i''"'~="" {
			di as txt "Token " as res "`i'" as txt " is: " as res `"``i''"'
			local i = `i' + 1
		}
	}
	// Error trap for missing comma or too many arguments before comma
	if `"`7'"'~="" {
		di as err "Too many arguments before the options."
		exit 198
	}

/*
*	This code from version 2.7 creates problems for parsing r() matrices
	if "`add'"=="add" {
		return add
		return local stata_matrix  // Clear these macros from return space
		return local mata_matrix
	}
	else {
	    return clear
	}
*/
	if "`stata_matrix'"~="" & "`mata_matrix'"~="" {
		di as err   ///
			"Specify no more than one of the two options -stata- and -mata-."
		err 198
	}
	local thismatname `1'  // The string with the identifying name of the matrix
	_mata_or_stata `1' , `stata_matrix' `mata_matrix' `add'
		local rd `r(rd)'
		local cd `r(cd)'
		if "`debug'"=="debug" return list
		if "`stata_matrix'"=="stata_matrix" | "`r(stata_matrix)'"=="stata_matrix" {
			local stata_matrix stata_matrix
		}
		if "`mata_matrix'"=="mata_matrix" | "`r(mata_matrix)'"=="mata_matrix" {
			local mata_matrix mata_matrix
		}

	//	If the argument is a Stata matrix
	if "`stata_matrix'"~="" {
		tempname thismat
		mat def `thismat' = `1'

		local ceqs  : coleq `thismat'
		local reqs  : roweq `thismat'
		local cnms  : colnames `thismat'
		local rnms  : rownames `thismat'
		local cfnms : colfullnames `thismat'
		local rfnms : rowfullnames `thismat'

		if "`debug'"=="debug" {
			mat list `thismat', title("Argument matrix: `thismatname'")
			di _n
		}

		// Identify the row and column numbers
		capt confirm integer number `3'
		if _rc>0 {  // If row specified by a string or float
			local rn = rownumb("`thismat'","`3'")
			if `rn'==. {
				di as err "In matrix -`thismatname'-, there is no row named `3'"
				exit 198
			}
		}
		else {  // If row specified by an integer number
			local rn = `3'
		}
		capt confirm integer number `5'
		if _rc>0 {  // If row specified by a string or float
			local cn = colnumb("`thismat'","`5'")
			if `cn'==. {
				di as err "In matrix -`thismatname'-, there is no column named `5'"
				exit 198
			}
		}
		else {  // If row specified by an integer number
			local cn = `5'
		}
		local rowname : word `rn' of `rnms'
		local roweq   : word `rn' of `reqs'
		local rowfullname : word `rn' of `rfnms'
		local colname : word `cn' of `cnms'
		local coleq   : word `cn' of `ceqs'
		local colfullname : word `cn' of `cfnms'
		// always return the matrix element as a local macro
		local elmnt = el("`thismat'",`rn',`cn')
		if "`verbose'"~="" {
			di as txt "Element (" as res "`rn'" as txt "," as res "`cn'"  ///
				as txt ") of Stata matrix " as res "`thismatname'[`rd',`cd']" as txt " = " as res `elmnt'
		}
	}

	//	If the argument is a Mata matrix
	if "`mata_matrix'"~="" {

		local thismat `1'

		mata: st_local("mata_mattype", eltype(`thismat'))
*		di as txt "Matrix type is: " as res "`mattype'"

		if "`debug'"=="debug" {
			di as txt "Argument matrix: " as res "`thismatname'"
			mata: `thismat'
			di _n
		}

		// Identify the row and column numbers
		capt confirm integer number `3'
		if _rc>0 {  // If row specified by a string or float
			di as err "Matrix -`thismatname'- is a Mata matrix, so its row identifier must be an integer"
			exit 198
		}
		else {  // If row specified by an integer number
			local rn = `3'
		}
		capt confirm integer number `5'
		if _rc>0 {  // If row specified by a string or float
			di as err "Matrix -`thismatname'- is a Mata matrix, so its column identifier must be an integer" _n
			exit 198
		}
		else {  // If row specified by an integer number
			local cn = `5'
		}

		// return the matrix element
		if "`mata_mattype'"=="real" {
			tempname elmnt
			mata: st_numscalar("`elmnt'", `thismat'[`rn',`cn'])
			local elmnt = string(scalar(`elmnt'))
		}
		if "`mata_mattype'"=="string" {
			tempname elmnt
			mata: st_local("`elmnt'", `thismat'[`rn',`cn'])
			local elmnt = "``elmnt''"
		}
		if "`verbose'"~="" {
			di as txt "Element (" as res "`rn'" as txt "," as res "`cn'"  ///
				as txt ") of Mata matrix " as res "`thismatname'[`rd',`cd']" as txt " = " as res "`elmnt'"
		}

	}

	if "`debug'"=="debug"  {
		di as txt "The extracted element is: " as res "`elmnt'"
	}


	if "`local'"=="" {
		return local element  `elmnt'
	}
	else {  // optionally the returned local has user-provided name
		return local `local'  `elmnt'
	}

	// optionally also return the matrix element as a scalar
	if "`scalar'"~="" {
		capt confirm scalar `scalar'
		if _rc ==0 & "`replace'"=="" {
			di as err "Specify the option -replace- to overwrite the existing scalar, scalar(`scalar') = " scalar(`scalar') "."
			exit 198
		}
		if "`stata_matrix'"=="stata_matrix" {
			scalar `scalar' = el("`thismat'",`rn',`cn')
		}
		else {
			if "`mata_mattype'"=="string" {
				di as err "The matrix `thismat' is a Mata string matrix.  Therefore the option scalar is not allowed"
				exit 198
			}
			else {
				scalar `scalar' = real("`elmnt'")
			}
		}
		return scalar `scalar' = scalar(`scalar')
	}
	// optionally also return the matrix element as a global macro
	if "`global'"~="" {
		if "`replace'"=="" {
			di as err "Specify the option -replace- to overwrite the existing global macro, \$`global' = $`global'."
			exit 198
		}
		global `global'  `elmnt'
	}

	if "`add'"=="add"  return add
	return local coldim `cd'
	return local rowdim `rd'
	return local cn `cn'
	return local rn `rn'
	return local rowname `rowname'
	return local roweq `roweq'
	return local rowfullname `rowfullname'
	return local colname `colname'
	return local coleq `coleq'
	return local colfullname `colfullname'
	return local matname `thismatname'
	return local stata_matrix  `stata_matrix'
	return local mata_matrix   `mata_matrix'
	return local mata_mattype  `mata_mattype'

end /* End of main program */

program define _mata_or_stata, rclass
*	This subroutine checks to see if the named matrix exists
*	in either Stata's or Mata's matrix directory.
	version 11.1
	syntax anything(id="matrix name" name=matname), [STata_matrix MAta_matrix add]

*	Because an -rclass- routine erases previous r() matrices ...
	if substr("`matname'",1,2)=="r(" {
		tempname r_mat
		mat def `r_mat' = `matname'
		local name_of_r_mat = subinstr("`matname'","r("," ",1)
		local name_of_r_mat = subinstr("`name_of_r_mat'",")"," ",1)
	}

	if "`stata_matrix'`mata_matrix'"=="" | "`stata_matrix'"=="stata_matrix" | substr("`matname'",1,2)=="r(" {
		capt confirm matrix `matname'
		if _rc==0 {
			tempname matnm
			mat def `matnm' = `matname'
			local is_stata is_stata
			local rd = rowsof(`matnm')
			local cd = colsof(`matnm')
			return local stata_matrix  stata_matrix
		}
	}
	if "`stata_matrix'`mata_matrix'"=="" | "`mata_matrix'"=="mata_matrix" {
		capt mata: orgtype(`matname')
		if _rc == 0 {
			local is_mata is_mata
			tempname rowdim
			mata: st_numscalar("`rowdim'", rows(`matname'))
				local rd = scalar(`rowdim')
			tempname coldim
			mata: st_numscalar("`coldim'", cols(`matname'))
				local cd = scalar(`coldim')
			return local mata_matrix  mata_matrix
		}
	}
	if "`is_stata'" ~="" & "`is_mata'"~="" {
		di as err   ///
			"Stata's memory contains both a Stata and a Mata matrix with the name -`matname'-."  _n ///
			"Use one of the two options -stata- or -mata- to specify from which matrix to extract an elemment." _n
		exit 198
	}
	if "`is_stata'`is_mata'"=="" {
		di as err   ///
			"Stata's memory contains neither a Stata nor a Mata matrix with the name -`matname'-."
		exit 198
	}
	if "`add'"=="add" return add
	return local rd `rd'
	return local cd `cd'
	return local matname `matname'
	if substr("`matname'",1,2)=="r(" {
		return matrix `name_of_r_mat' = `r_mat', copy
	}
end /* End of _mata_or_stata */

*	Ver 1.1	8May2019
*		The -add- option prevents erasing stored results from the most recent -rclass- program.
*		Allow mlu[] to work when row and column are identified by integers instead of strings.
*	ver. 1.2 1Jun2019 Add the scalar option to directly define a scalar
*	ver. 2.0 11Jun2019 Allow matrix to be a mata object
*	ver. 2.1 24Jul2019 Add options -mata_matrix- and -stata_matrix-
*		See:
*		https://www.statalist.org/forums/forum/general-stata-discussion/mata/954539-labels-on-mata-matrices
*	ver. 2.2 31Jul2019 Add options -Global(string)-, -replace-
*	ver. 2.21 2Aug2019 Add error trap in case of 7th token, move some code into subroutine
*	ver. 2.22 20Aug2019 Restore use with returned results by putting -return add- in _mata_or_stata
*	ver. 2.23 3Mar2020 Add error trap when the matrix named by the user does not exist as Stata or Mata matrix
*	ver. 2.24 18Apr2020 Change -"`1'"- to -"`thismatname'"-
*	ver. 2.25 24May2020 For Stata matrices, return the row & column names and equations, if any
*	ver. 2.26 27Jul2020 Fix bugs in -_mata_or_stata-. Replace -mata- with -mata:-
*	ver. 2.27 4Aug2020 Fix bug in returning a local returned result from Mata
*	ver. 2.28 7Sep2020 Fix a problem with reading r() matrices