program define firstpartial, rclass
*!	program firstpartial        Version 1.14 		31Jan2019
*	This program constructs an expression which can be used by Stata
*	to compute the first partial deriviative of a flexible function
*	which is entirely composed of Stata's continuous factor variables
*	Examples include the Generalized Leontief function and the Translog

*	The -chain- option assumes that the dependent variable is transformed
*	using the same transformation as the -wrt- variable.
	version 11.1
	syntax varname (fv), Cmdline(string)  ///
		[chain(string) chainlhs(string) chainwrt(string) boxcox(real .5) force]

	if strpos(`"`cmdline'"',"##") > 0 {
		di as err "The option -cmdline- contains the two-character combination -##- which -firstpartial- cannot parse." ///
			_n "Expand the -cmdline- so that any expression like " ///
			as res "c.x##c.y" as err " becomes " as res "c.x c.y c.x#c.y" as err " ."
			exit 198
	}

	//	Partial derivative is with respect to the first argument
	local wrt `varlist'

	local power
	local thistoken
	local termswithwrt
	local thisexpterm
	local termswowrt

	//	Break the command line up into chunks
	//	Assumes the command line can be parsed on spaces and a colon
	//	and that the first two tokens are the name of the equation
	//	and the dependent variable.
	cleancmdline, cmdline(`"`cmdline'"')
		local depvar `r(depvar)'
		local estcmd `r(estcmd)'
		local cmdline `r(cmdline)'
		local origcmdline `r(origcmdline)'

	tokenize `"`cmdline'"', parse(" ,")
	//	Discard the dependent variable
		macro shift
	//	Discard part of the command line that follows the list of rhs variables
	while `"`1'"' ~= "" & `"`1'"' ~= "in" & `"`1'"' ~= "if" & `"`1'"' ~= "," {
		local thistoken `1'

		if `"`thistoken'"'=="(" | `"`thistoken'"'==")" {
			di as err "Command line cannot contain parentheses"  ///
				_n "Here the command line is:"  ///
				_n `"  `cmdline'"'
			exit 198
		}

		if strpos(`"`thistoken'"',"*")>0  | strpos(`"`thistoken'"',"?")>0  {
			di as err "Command line cannot contain variable lists defined by the -*- or the -?- character"  ///
				_n "Here the piece of the command line containing one of these characters is:"  ///
				_n `"  `thistoken'"'
			exit 198
		}

		//	If this token contains the -wrt- variable,
		//	add a term to the 1st partial expression.
		if strpos(`"`thistoken'"',`"`wrt'"') > 0 {

			// If the -wrt- variable appears alone in this token,
			// then only its coefficient appears in the 1st partial
			if `"`thistoken'"'==`"c.`wrt'"' | `"`thistoken'"'==`"`wrt'"' {
				local thistoken = subinstr(`"`thistoken'"',`"c."',"",1)
				local thisexpterm `"_b[`thistoken']"'
			}
			else {

				// If the -wrt- variable appears in an interaction
				// with another variable or variables, remove it to
				// create a term for the 1st partial expression.
				if strpos(`"`thistoken'"',`"c.`wrt'#"') == 1 {  // If the -wrt- occurs first
					local othervars = subinstr(`"`thistoken'"',`"c.`wrt'#"',"",1)
				}
				else {    // If the -wrt- occurs later in the term
					local othervars = subinstr(`"`thistoken'"',`"#c.`wrt'"',"",1)
				}
				local thisexpterm _b[`thistoken']*`othervars'

				// Whether -wrt- appears first or later, the number of times it appears
				// constitutes an exponent which becomes a multiplicative factor
				// in front of this term in the expression for the 1st partial.
				local dummy : subinstr local othervars `"`wrt'"' "", all count(local powerm1)
				local power = `powerm1' + 1
				if `powerm1'==0 {
					local termswowrt `othervars'
				}

				local thisexpterm `power'*`thisexpterm'
			}

			local tokenswithwrt `tokenswithwrt' `thistoken'
			local expression `expression' `plus' `thisexpterm'
			local plus +
		}
		else {  // Token does not contain the -wrt- variable
			local tokenswowrt `tokenswowrt' `thistoken'
		}
		macro shift
	}

	//	Now apply the chain rule

	if "`chain'"~="" & ("`chainlhs'"~="" | "`chainwrt'"~="") {
		di as err "Specifying the option -chain- precludes specifying" ///
			_n	"either of -chainlhs- or -chainwrt- and has the same effect" ///
			_n	"as specifying them both with the same transformation choice."
		exit 198
	}
	if "`chain'"~="" & ("`chainlhs'"=="" & "`chainwrt'"=="") {
		local chainlhs `chain'
		local chainwrt `chain'
	}
	if "`chainlhs'`chainwrt'" ~= "" {
		local gen_premultiply		1.000
		local marg_premultiply		1.000
		local postdivide			1.000
		if "`chainwrt'" == "boxcox" | "`chainwrt'" == "bc" |   ///
			"`chainwrt'" == "sqrt" | "`chainwrt'" == "ln" |  ///
			"`chainwrt'" == "log10" | "`chainwrt'" == "none" {

			chktrans `wrt', trans(`chainwrt') `force'
			if "`chainwrt'" == "sqrt" {
				local postdivide (2*`wrt')  //  Remove the ^2 in versin 1.11
			}
			if "`chainwrt'" == "ln" {
				local postdivide (exp(`wrt'))
			}
			if "`chainwrt'" == "none" {
				local postdivide	1.0
			}
			if "`chainwrt'" == "boxcox" | "`chainwrt'" == "bc" {
				local postdivide	(`boxcox'*`wrt' + 1)^(-(`boxcox'-1)/`boxcox')
			}
			if "`chainwrt'" == "log10" {
				local postdivide (10^(`wrt'))
			}
		}
		else {
			if "`chainwrt'" ~= "" {
				di as err "Options -chain- or -chainwrt- must equal -ln-, -sqrt-, -log10- or -none-"
				exit 198
			}
		}

		if "`chainlhs'" == "sqrt" | "`chainlhs'" == "ln" | "`chainlhs'" == "boxcox" |"`chainlhs'" == "log10" | "`chainlhs'" == "none" {

			chktrans `depvar', trans(`chainlhs') `force'
			if "`chainlhs'" == "sqrt" {
				local gen_premultiply	2*`depvar'_hat
				local marg_premultiply	2*predict(xb)
			}
			if "`chainlhs'" == "ln" {
				local gen_premultiply	exp(`depvar'_hat)
				local marg_premultiply	exp(predict(xb))
			}
			if "`chainlhs'" == "none" {
				local gen_premultiply	1.0
				local marg_premultiply	1.0
			}
			if "`chainlhs'" == "boxcox" {
				di as err "boxcox not yet implemented for the left-hand-side"
				exit 198
			}
			if "`chainlhs'" == "log10" {
				local gen_premultiply	10^(`depvar'_hat)
				local marg_premultiply	10^(predict(xb))
			}
		}
		else {
			if "`chainlhs'" ~= "" {
				di as err "Options -chain- or -chainlhs- must equal -ln-, -sqrt-, -log10- or -none-"
				exit 198
			}
		}
		local genexpression  ((`gen_premultiply')*(`expression')/(`postdivide'))
		local margexpression ((`marg_premultiply')*(`expression')/(`postdivide'))
	}

	di 	as txt _n "Expression for the first partial deriviative wrt: " as res "`wrt'" _n ///
		as txt "is given by the return macro, r(expression):" _n ///
		as res `"`expression'"'

	if `"`genexpression'`margexpression'"' ~="" {
		di 	as txt _n "Expressions which unwind the transformations of either the -wrt- variable"  ///
				_n "or the left-hand-side variable are given by the following return macros:"   ///
				_n as txt "o  For use in a subsequent generate command, r(genexpression): "  ///
					_n as res `"`genexpression'"'   ///
				_n as txt "o  For use in the -expression- option of a subsequent margins command, r(margexpression): "  ///
					_n as res `"`margexpression'"' _n
	}

	return local chainwrt `chainwrt'
	return local chainlhs `chainlhs'
	return local tokenswowrt `tokenswowrt'
	return local wrt `wrt'
	return local depvar `depvar'
	return local eqname `eqname'
	return local tokenswithwrt `tokenswithwrt'
	return local margexpression `margexpression'
	return local genexpression `genexpression'
	return local expression `expression'

end  // End of program firstpartial

program chktrans	//	This version differs from the version in -rayplot.ado-
*	Check to see if a variable has the expected prefix
	syntax varname, trans(string) [ force ]

	local var_prefix = substr("`varlist'",1,strpos("`varlist'","_")-1)

	if ("`var_prefix'"~="`trans'") & ~("`var_prefix'"=="bc" & "`trans'"=="boxcox")   {
		di as err "A -chain- option has been selected to unwind a -`trans'- function"  ///
			_n as err "on the variable -`varlist'-.  But the prefix on the variable" ///
			_n as err "does not match the transformation function designated in the"  ///
			_n as err "-chain-, -chainlhs- or -chainwrt- option." _n
		if "`force'"=="force" {
			di as err "Because the -force- option has been specified, execution proceeds."
		}
		else {
			di as err "Execution terminates.  To force execution despite this incongruence," ///
				_n	"specify the -force- option on the call to -firstpartial-"
			exit 198
		}
	}
end	// End of program chktrans
/*
program cleancmdline, rclass
*	Version 1.2 by Mead Over 19Aug2016
*	This programs accepts the command line from either a single or a
*	multiequation estimator and returns a simplified command line which
*	begins with the dependent variable.  For a multiequaiton command like
*	-sureg- or -reg3-, this program strips e(cmdline) of the estimation command,
*	the equation name (identified because it is followed by a colon) and all
*	parentheses.

	syntax , cmdline(string)

	//	Break the command line up into chunks
	//	Assumes the command line can be parsed on spaces and a colon
	//	and that the first two tokens are the name of the equation
	//	and the dependent variable.

	local origcmdline `cmdline'
	tokenize `"`cmdline'"', parse(" (")

	// If the first or second token in the command line is a left parenthesis,
	// strip everything up to the -(- character from the beginning of the -cmdline-
	if "`1'"=="(" | "`2'"=="(" {
		local cmdline = substr(`"`cmdline'"',strpos(`"`cmdline'"',"(")+1,.)

		//	If the second token was a -(-, then the first is an estimation command
		if "`2'"=="(" {
			local estcmd `1'
		}
	}
	else {  //  Is the first token an estimation command?
		capture confirm numeric variable `1'
		if _rc==0 {
			di as err "First word in the command line should be one of Stata's"  ///
			_n "estimation commands that is linear in the parameters."  ///
			_n "Examples include {help reg}, {help sureg}, {help frontier}, etc.."  ///
			_n "Here the first word in the command line is the variable: " as res "`1'"
			exit 198
		}
		else {
			local estcmd `1'
			macro shift
			local cmdline `*'
		}
	}

	//	Now consider the command line without the estimation command or the
	//	equation binding prefixes.
	tokenize `"`cmdline'"', parse(" :")

	if "`2'"==":" {
		local eqname `1'
		local depvar `3'
		local cmdline = substr(`"`cmdline'"',strpos(`"`cmdline'"',":")+1,.)
	}
	else {
		local eqname `1'
		local depvar `1'
	}

	capture confirm numeric variable `depvar'
		if _rc~=0 {
			di as err _n "Unable to find the dependent variable in the command line" ///
				_n "Here it is: -" as res "`depvar'" as err "-"
			di as err _n "which has been extracted from the command line:" ///
				_n as res `"`origcmdline'"'
			exit 198
		}

	//	truncate the command line before the first parenthesis
	local firstparen = min(strpos(`"`cmdline'"',"("),strpos(`"`cmdline'"',")"))
	if `firstparen' >0 & `firstparen' < . {
		local cmdline = substr(`"`cmdline'"',1,`firstparen'-1)
	}

	return local cmdline `cmdline'
	return local origcmdline `origcmdline'
	return local estcmd `estcmd'
	return local eqname `eqname'
	return local depvar `depvar'

*	Version information to program -cleancmdline-
*	Version 1.0 13July2016
*	Version 1.1 13July2016		Only change is to edit the comment in line 20
*	Version 1.2 19Aug2016		Clean simple command lines like: "reg y x1 x2 x1*x2"
end /* End of program cleancmdline */
*/

*	Version 1.2 introduces options -chainlhs- and -chainwrt- to distinguish
*		the transformation on the lhs from that of the wrt variable and
*		adds error checking to compare the variable prefixes with the chain specification.
*	Version 1.3 allows chainlhs to be "none" for the Generalized Leontief
*		This option allows sqrt variables on the rhs, with the raw variable on the lhs
*	Version 1.31 requires that the second token in the command line be the dependent variable.
*	Version 1.32 7Dec2012 allows chain and chainwrt to be "none".  However this simply reproduces the
*		result obtained by omitting all of the chain, chainlhs, chainwrt options altogether.
*	Version 1.4 11Jul2016 Add line-break in displays of genexpression and margexpression
*	Version 1.5 11Jul2016 Move command line cleaning to subroutine -cleancmdline-
*	Version 1.6 15Aug2016 Fix unwinding of sqrt and add boxcox for the wrt variable option
*	Version 1.7 8Sept2016 Embed the program -cleancmdline- here inside -firstpartial-
*	Version 1.8 2Nov2016 Return the local macros -chainlhs- and -chainwrt-
*	Version 1.9 18Nov2016 Fix -force- option error msg in -chktrans-
*	Version 1.10 10Feb2017 Allow prefix -bc- for the boxcox transformation
*	Version 1.11 23Feb2017 For the -sqrt- trans, the postdivide is 2*sqrt_y, not 2*y
*	Version 1.12 6Jun2017 Add error trap to bar command lines containing variable lists specified by -*- or -?-
*	Version 1.13 23Oct2017 Change the -lambda()- option to the -boxcox- option
*	Version 1.14 Comment out internal version of -cleancmdline- to use external version 1.5