*! version 1.1.0 , 18apr2022
*! Author: Mustafa Coban, Institute for Employment Research (Germany)
*! Website: mustafacoban.de
*! Support: mustafa.coban@iab.de


/****************************************************************/
/*     rbiprobit margdec: rbiprobit postestimation command		*/
/****************************************************************/


	
/* MARGINS */
program define rbiprobit_margdec, eclass
	
	version 11
	syntax [anything] [if] [in] [pw fw iw] [, *]
	
	if ("`e(cmd)'" != "rbiprobit") error 301
	
	*! safe `0'
	local origin  "`0'"		
	
	
	*!	parse original rbiprobit
	local rbipr_cmdl = "`e(cmdline)'"
	local rbipr_cmdl: 	list retokenize rbipr_cmdl
	local pfxpos: 		list posof "rbiprobit" in rbipr_cmdl
	
	local pfxsub ""
	forvalue x = 1(1)`pfxpos'{
		local wd: word `x' of `rbipr_cmdl'
		local pfxsub = "`pfxsub' `wd'"
	}
	local pfxsub: 	list retokenize pfxsub
	
	local 0 = subinstr("`rbipr_cmdl'","`pfxsub'","",1)
	local pfxcmd = subinstr("`pfxsub'","rbiprobit","",1)
	
	gettoken dep1 0 : 0, parse(" =,[")


	*!	Allow "=" after depvar	
	gettoken equals rest : 0, parse(" =")
	if "`equals'" == "=" { 
		local 0 `"`rest'"' 
	}	
	
	
	*! parse indepvars
	syntax [varlist(numeric default=none ts fv)] [if] [in] [pw fw iw], /*
			*/ ENDOGenous(string) [ * ]
			
	local indep1 	`varlist'
	local option0 	`options'
	local ifcmd		`if'
	local incmd		`in'
	
	tempvar rbipr_touse
	qui gen		`rbipr_touse' = 1		if e(sample)
	qui replace `rbipr_touse' = 0		if `rbipr_touse' == .
	
	local wtypecmd `weight'
	local wtexpcmd `"`exp'"'
	if "`weight'" != "" { 
		local wgtcmd `"[`weight'`exp']"'  
	}
	
	
	*! parse indepvars_en
	EndogEqMarg dep2 indep2 option2 : `"`endogenous'"'
	

	tsunab dep1: `dep1'
	tsunab dep2: `dep2'
				
	rmTS `dep1'
	confirm var	`rmTSvar'
	local dep1n	`rmTSvar'
	
	rmTS `dep2'
	confirm var `rmTSvar'
	local dep2n `rmTSvar'
	
	
	*!	parse rbiprobit margdec
	local 0 `origin'	
	syntax [anything] [if] [in] [pw fw iw], [/*
		*/	effect(string) PRedict(string) post		/* 
		*/	dydx(passthru) eyex(passthru) eydx(passthru) dyex(passthru)	/*
		*/	VCE(passthru) NOWEIGHTs	NOEsample force	Level(cilevel)	/*
		*/	*]
	
			
	if "`anything'" != ""{
		dis as err "{it: marginlist} not allowed."
		exit 198
	}
	
	local margopts0 `options'
	_get_diopts diopts margopts0, `margopts0'
	
	if "`margopts0'" != ""{
		dis as err "Following options or their multiples are not allowed: {bf: `margopts0'}"
		dis as res	"See {help rbiprobit margdec}." 
		exit 198
	}
	
	local wtype `weight'
	local wtexp `"`exp'"'
	if "`weight'" != "" { 
		local wgt `"[`weight'`exp']"'  
	}
	
	if "`level'" != ""{
		local level "level(`level')"
	}
	
	
	*! effect()
	if inlist("`effect'","direct","indirect") & inlist("`predict'","pmarg1","pmarg2","xb1","xb2"){
		dis as err "{bf:effect} option {bf:`effect'} not approriate with {bf:`predict'}; use {bf:effect(total)}."
		exit 322
	}
	if "`effect'" == ""{
		local effect "total"
	}
	else if !inlist("`effect'","total","direct","indirect"){
		dis in red "option effect() incorrectly specified."
		error 198
	}
		
		
	*! predict()
	if 	inlist("`predict'","p11","p10","p01","p00","pmarg1") | ///
		inlist("`predict'","pmarg2","pcond1","pcond2","xb1","xb2"){
			local predict "`predict'"
	}
	else if inlist("`predict'","stdp1","stdp2"){
		dis as err "{bf:predict} option {bf:`predict'} not approriate with {bf:margdec}"
		exit 322
	}
	else if "`predict'" == ""{
		local predict "p11"
	}
	else{
		dis as err "option {bf:`predict'} not allowed"
		exit 198 
	}
	
	
	*! parse dydx(), eyex(), dyex(), or eydx()
	if "`dydx'`eyex'`dyex'`eydx'" != ""{
	
		opts_exclusive `"`dydx' `eyex' `dyex' `eydx'"'
		
		tempname rbipr_beta
		matrix `rbipr_beta' = e(b)
		
		if "`effect'" != ""{
			local dydxeffect "dydxeffect(`effect')"
		}
		
		ParseDyDx, `dydx' `eyex' `dyex' `eydx' ///
					dep2(`dep2') dep2n(`dep2n') matrix(`rbipr_beta') `dydxeffect'
	}
	

	
	*! total marginal effect	
	if "`effect'" == "total"{
		
		qui `rbipr_cmdl'
		
		tempname margfailed
		
		if inlist("`predict'","p11","p10","p01","p00","pcond1","pcond2"){
			
			tempvar dep2orig
			qui: clonevar `dep2orig' = `dep2n'
			
			if inlist("`predict'","p11","p01","pcond1","pcond2"){
			
				qui: replace `dep2n' = 1
				
				cap noi margins `if' `in' `wgt', /*
							*/	predict(`predict') `dydx' `vce'	/*
							*/	`noweights'	`noesample' `force' /*
							*/	`level' `post' `diopts'	
				
				scalar `margfailed' = _rc
				
				qui: replace `dep2n' = `dep2orig'
			}
			else{	
				qui: replace `dep2n' = 0
				
				cap noi margins `if' `in' `wgt', /*
							*/	predict(`predict') `dydx' `vce'	/*
							*/	`noweights'	`noesample' `force' /*
							*/	`level' `post' `diopts'	
				
				scalar `margfailed' = _rc
				
				qui: replace `dep2n' = `dep2orig'
			}
		}
		else{		
			cap noi margins `if' `in' `wgt', /*
							*/	predict(`predict') `dydx' `vce'	/*
							*/	`noweights'	`noesample' `force' /*
							*/	`level' `post' `diopts'	
			
			scalar `margfailed' = _rc	
		}
		
		if `margfailed' == 0{
			
			*! adjust e() and r()
			local marg_bascmd 	= "margins"
			local marg_cmdl		= "rbiprobit margdec `0'"
				
			if "`post'" == "post"{
				MargErt ,  bascmd(`marg_bascmd') cmdl(`marg_cmdl')
			}
		
			MargRt , bascmd(`marg_bascmd') cmdl(`marg_cmdl')
			
		}
			
		exit `margfailed'
	}
	
	
	*! clone indepvars and indepvars_en
	tempname rbipr_beta
	matrix `rbipr_beta' = e(b)
	
	*! get indepvars and indepvars_en
	ParseOrigIndep, matrix(`rbipr_beta') dep2(`dep2')
	
	forvalue x = 1(1)2{	
		local clonelist`x' = ""
		foreach varn of local indep`x'_varn{
			tempvar `varn'`x'
			qui: clonevar ``varn'`x'' = `varn'	
			local clonelist`x' "`clonelist`x'' ``varn'`x''"
		}
	}
	
	
	*! clone indepvars and indepvars_en with tempvars
	ParseClonIndep, indep1(`indep1') indep2(`indep2') ///
					indep1varn(`indep1_varn') indep2varn(`indep2_varn') ///
					clone1(`clonelist1') clone2(`clonelist2')
	

	
	*! direct marginal effect
	if "`effect'" == "direct"{		
				
		qui{
			`pfxcmd' rbiprobit	`dep1' = `indep1' `ifcmd' `incmd' `wgtcmd', ///
								endog(`dep2' = `indep2new', `option2') `option0'
		}
		
		tempname margfailed

		if inlist("`predict'","p11","p10","p01","p00","pcond1","pcond2"){
		
			tempvar dep2orig
			qui: clonevar `dep2orig' = `dep2n'
			
			if inlist("`predict'","p11","p01","pcond1","pcond2"){
			
				qui: replace `dep2n' = 1
				
				cap noi margins `if' `in' `wgt', /*
							*/	predict(`predict') `dydx' `vce'	/*
							*/	`noweights'	`noesample' `force' /*
							*/	`level' `post' `diopts'	
				
				scalar `margfailed' = _rc
				
				qui: replace `dep2n' = `dep2orig'
			}
			else{
				qui: replace `dep2n' = 0
				
				cap noi margins `if' `in' `wgt', /*
							*/	predict(`predict') `dydx' `vce'	/*
							*/	`noweights'	`noesample' `force' /*
							*/	`level' `post' `diopts'	
				
				scalar `margfailed' = _rc
				
				qui: replace `dep2n' = `dep2orig'
			}
		}
		else{
		
			cap noi margins `if' `in' `wgt', /*
							*/	predict(`predict') `dydx' `vce'	/*
							*/	`noweights'	`noesample' `force' /*
							*/	`level' `post' `diopts'	
			
			scalar `margfailed' = _rc	
		}
	}
	else if "`effect'" == "indirect"{

		*! indirect marginal effect	
		qui{
			`pfxcmd' rbiprobit	`dep1' = `indep1new' `ifcmd' `incmd' `wgtcmd', ///
								endog(`dep2' = `indep2', `option2') `option0'
		}
		
		tempname margfailed
		
		if inlist("`predict'","p11","p10","p01","p00","pcond1","pcond2"){
			
			tempvar dep2orig
			qui: clonevar `dep2orig' = `dep2n'
			
			if inlist("`predict'","p11","p01","pcond1","pcond2"){
			
				qui: replace `dep2n' = 1
				
				cap noi margins `if' `in' `wgt', /*
							*/	predict(`predict') `dydx' `vce'	/*
							*/	`noweights'	`noesample' `force' /*
							*/	`level' `post' `diopts'	
				
				scalar `margfailed' = _rc
				
				qui: replace `dep2n' = `dep2orig'
			}
			else{
				qui: replace `dep2n' = 0
				
				cap noi margins `if' `in' `wgt', /*
							*/	predict(`predict') `dydx' `vce'	/*
							*/	`noweights'	`noesample' `force' /*
							*/	`level' `post' `diopts'	
				
				scalar `margfailed' = _rc
				
				qui: replace `dep2n' = `dep2orig'
			}
		}
		else{

			cap noi margins `if' `in' `wgt', /*
							*/	predict(`predict') `dydx' `vce'	/*
							*/	`noweights'	`noesample' `force' /*
							*/	`level' `post' `diopts'	
			
			scalar `margfailed' = _rc	
		}			
	}
	
	
	*! adjust e() and r()
	if "`effect'" == "direct" {
		local clonelist `clonelist2'
		local origlist `indep2_varn'
	}
	else if "`effect'" == "indirect"{
		local clonelist `clonelist1'
		local origlist `indep1_varn'	
	}
	
	if `margfailed' != 0{
				
		tempname bvec gradvec jacvec
		
		mat `bvec' 		= e(b)
		mat `gradvec'	= e(gradient)
		
		MargErt, 	clonelist(`clonelist') origlist(`origlist') /*
					*/ bvec(`bvec') gradvec(`gradvec') /*
					*/ cmdl(`rbipr_cmdl')
		
		exit `margfailed'
	}				
	else{
	
		*!	MARGDEC WORKED
		
		if "`post'" == "post"{
			
			tempname jacvec
			
			*!	e(cmd) and r(cmd) called margins to make marginsplot work
			local marg_bascmd	= "margins"		
			local marg_cmdl		= "rbiprobit margdec `0'"
			
			mat `jacvec' 	= e(Jacobian)

			
			MargErt, 	clonelist(`clonelist') origlist(`origlist') /*
						*/ jacvec(`jacvec') /*
						*/ cmdl("`marg_cmdl'") estcmdl(`rbipr_cmdl') bascmd(`marg_bascmd')

			MargRt,		clonelist(`clonelist') origlist(`origlist') /*
						*/ jacvec(`jacvec') /*
						*/ cmdl(`marg_cmdl') estcmdl(`rbipr_cmdl') bascmd(`marg_bascmd')
		}
		else{
		
			tempname bvec gradvec jacvec
			
			mat `bvec' 		= e(b)
			mat `gradvec'	= e(gradient)
			mat `jacvec' 	= r(Jacobian)
			
			*!	e(cmd) and r(cmd) called margins to make marginsplot work
			local marg_bascmd	= "margins"	
			local marg_cmdl		= "rbiprobit margdec `0'"
									
			MargErt, 	clonelist(`clonelist') origlist(`origlist') /*
						*/ bvec(`bvec') gradvec(`gradvec') /*
						*/ cmdl(`rbipr_cmdl')
												
			MargRt,		clonelist(`clonelist') origlist(`origlist') /*
						*/ jacvec(`jacvec') /*
						*/ cmdl(`marg_cmdl') estcmdl(`rbipr_cmdl') bascmd(`marg_bascmd')
		}
	}
end


program define rmTS
	
	local tsnm = cond( match("`0'", "*.*"),  		/*
			*/ bsubstr("`0'", 			/*
			*/	  (index("`0'",".")+1),.),     	/*
			*/ "`0'")

	c_local rmTSvar `tsnm'
end




/* PARSING */

*! parse dydx(), eyex(), dyex(), and dyex()
program define ParseDyDx, rclass
	version 11
	syntax [, dydx(string) eyex(string) dyex(string) eydx(string) /*
			*/ dep2(varname numeric ts) dep2n(varname) matrix(name) dydxeffect(string) ]
	
	return add
	
	if `"`dydx'"' != ""{
		local pfx "dydx"
	}
	else if `"`eydx'"' != ""{		
		local pfx "eydx"
	}
	else if `"`dyex'"' != ""{		
		local pfx "dyex"
	}
	else if `"`eyex'"' != ""{		
		local pfx "eyex"
	}	
	
	local lis_or 	= `"`dydx'`eyex'`dyex'`eydx'"'
	local lis_exp	= "`lis_or'"
	local lis_agg 	= ""
	
	foreach part of local lis_or{
		if "`part'" == "*"{
			local lis_agg = "`lis_agg' `part'"
			local lis_exp: subinstr local lis_exp "`part'" "", word
		}
		else if "`part'" == "_all"{
			local lis_agg = "`lis_agg' `part'"
			local lis_exp: subinstr local lis_exp "`part'" "", word
		}
		else if "`part'" == "_cons"{
			local lis_agg = "`lis_agg' `part'"
			local lis_exp: subinstr local lis_exp "`part'" "", word
		}
		else if strpos("`part'","_cont") == 1{
			local lis_agg = "`lis_agg' `part'"
			local lis_exp: subinstr local lis_exp "`part'" "", word
		}
		else if strpos("`part'","_fac") == 1{
			local lis_agg = "`lis_agg' `part'"
			local lis_exp: subinstr local lis_exp "`part'" "", word
		}
	}
			
	
	fvexpand `lis_exp'
	local lis_exp = "`r(varlist)'"
	
	fvrevar `lis_exp', list
	local indep_varn "`r(varlist)'"
	local dep2hlp = "`dep2n'"
	
	local test: list indep_varn & dep2hlp
	if "`test'" != ""{
		dis as err 	"Treatment variable {bf:`dep2'} in " ///
					"{bf:dydx(), eyex(), dyex(), and eydx()} options not allowed. "
		dis as res	"Please use {help rbiprobit tmeffects} for estimation of treatment effects."
		exit 198
	}				
	

	foreach spec of local lis_exp{
		_ms_parse_parts `spec'
		if `"`r(type)'"' == "interaction"{
			dis in red "invalid {bf:dydx(), eyex(), dyex(), or eydx()} option;"
			dis in red "levels of interactions not allowed"
			error 198
		}
	}	
	
	if `"`dydx'"' != ""{
		_ms_dydx_parse `lis_agg'
		local lis_agg = "`r(varlist)'"
	}
	else if `"`eydx'"' != ""{		
		_ms_dydx_parse `lis_agg', ey
		local lis_agg = "`r(varlist)'"
	}
	else if `"`dyex'"' != ""{		
		_ms_dydx_parse `lis_agg', ex
		local lis_agg = "`r(varlist)'"
	}
	else if `"`eyex'"' != ""{		
		_ms_dydx_parse `lis_agg', ey ex
		local lis_agg = "`r(varlist)'"
	}
	
	fvexpand i.`dep2'
	local dep2hlp = "`r(varlist)'"
	local dydx: list lis_exp | lis_agg
	local dydx: list dydx - dep2hlp
	
	

	*! cleaning and binding lists
	_ms_lf_info, matrix(`matrix')
	
	local indepall = ""
	forvalue x = 1(1)`r(k_lf)'{
		local indep`x' = "`r(varlist`x')'"
		local indepall = "`indepall' `indep`x''"
	}
	
	forvalue x = 1(1)`r(k_lf)'{
		fvrevar `indep`x'', list
		local indep`x'_varn "`r(varlist)'"
		local indep`x'_varn: list uniq indep`x'_varn
	}
	fvrevar `indepall', list
	local indepall_varn "`r(varlist)'"
	local indepall_varn: list uniq indepall_varn	
	
	local dydx_new = "`dydx'"
	foreach spec of local dydx{
		_ms_parse_parts `spec'
		
		local nam = "`r(name)'"
		local inlis: list indepall_varn & nam
		if "`inlis'" == ""{
			local dydx_new: subinstr local dydx_new "`spec'" "", word
		}
	}
	local dydx = "`dydx_new'"
	

	*! deletion based on effect()
	if "`dydxeffect'" == "direct"{
		
		local dydx_new = "`dydx'"
		
		foreach spec of local dydx{
			_ms_parse_parts `spec'
		
			local nam = "`r(name)'"
			local inlis: list indep1_varn & nam
			if "`inlis'" == ""{
				local dydx_new: subinstr local dydx_new "`spec'" "", word
			}
		}
		local dydx = "`dydx_new'"
	}
	else if "`dydxeffect'" == "indirect"{
		
		local dydx_new = "`dydx'"
		
		foreach spec of local dydx{
			_ms_parse_parts `spec'
		
			local nam = "`r(name)'"
			local inlis: list indep2_varn & nam
			if "`inlis'" == ""{
				local dydx_new: subinstr local dydx_new "`spec'" "", word
			}
		}
		local dydx = "`dydx_new'"	
	}	
	
	c_local dydx "`pfx'(`dydx')"
end






*! parse indepvars and indepvars_en
program define ParseOrigIndep, rclass

	syntax [, dep2(varname numeric ts) matrix(name) ]

	return add

	_ms_lf_info, matrix(`matrix')
	
	forvalue x = 1(1)`r(k_lf)'{
		local indep`x' = "`r(varlist`x')'"
	}

	fvexpand i.`dep2'
	local dep2hlp = "`r(varlist)'"
	local indep1: list indep1 - dep2hlp

	_ms_lf_info, matrix(`matrix')
	
	forvalue x = 1(1)`r(k_lf)'{
		fvrevar `indep`x'', list
		local indep`x'_varn "`r(varlist)'"
		local indep`x'_varn: list uniq indep`x'_varn
	}
	
	c_local indep1 		`indep1'
	c_local indep2 		`indep2'
	c_local indep1_varn `indep1_varn'
	c_local indep2_varn `indep2_varn'
	
end




*! parse cloned indeps with tempvars
program define ParseClonIndep, rclass

	syntax [, 	indep1(string) indep2(string) indep1varn(string) indep2varn(string) /*
			*/	clone1(string) clone2(string) ]
	
	return add
	
	local indep1new = ""
	local indep2new = ""
	
	forvalue x = 1(1)2{
		
		foreach spec of local indep`x'{
				
			_ms_parse_parts `spec'
				
			if "`r(type)'" == "interaction"{
				local change = ""
				forvalue k = 1(1)`r(k_names)'{
					local posin:	list posof "`r(name`k')'" in indep`x'varn
					local varncln:	word `posin' of `clone`x''
					local change = "`change'#`r(op`k')'.`varncln'"
				}

				local change: subinstr local change "#" "" 
				local indep`x'new = "`indep`x'new' `change'"
			}
			else if inlist("`r(type)'","variable","factor"){
			
				if "`r(op)'" != ""{
					local posin:	list posof "`r(name)'" in indep`x'varn
					local varncln:	word `posin' of `clone`x''
					
					local change = "`r(op)'.`varncln'"
					local indep`x'new = "`indep`x'new' `change'"
				}
				else{
					local posin:	list posof "`r(name)'" in indep`x'varn
					local varncln:	word `posin' of `clone`x''
					
					local change = "`varncln'"
					local indep`x'new = "`indep`x'new' `change'"
				}
			}
		}
	}
	
	c_local indep1new `indep1new'
	c_local indep2new `indep2new'	
end




*! parse indepvars_en
program define EndogEqMarg
	
	args dep2 indep2 option2 colon endog_eq	
	
	gettoken dep rest: endog_eq, parse(" =")

	c_local `dep2' `dep'		
	
	*!	allow "=" after depvar_en
	gettoken equals 0 : rest, parse(" =")
	if "`equals'" != "=" { 
		local 0 `"`rest'"' 			
	}		
	
	
	*! parse indepvars_en
	syntax [varlist(numeric default=none ts fv)], [*] 
			
	c_local `indep2' `varlist'
	c_local `option2' `options'	
end




/* STORED RESULTS */

*! adjust e()
program define MargErt, eclass
	
	syntax [, 	cmdl(string) bascmd(string) estcmd(string) estcmdl(string) /*
			*/	clonelist(string) origlist(string) /*
			*/	bvec(name) gradvec(name) jacvec(name) ]
	
	
	if "`bvec'" != ""{
		tempname b
		mat `b' = `bvec'
		local namecols: colfullnames `bvec'
		local varcnt: word count `origlist'
		
		forvalue z = 1(1)`varcnt'{
			local old: word `z' of `clonelist'
			local new: word `z' of `origlist'
				
			local namecols: subinstr local namecols "`old'" "`new'", all
		}
		mat colnames `b' = `namecols'
			
		ereturn repost b = `b', rename
	}
		
	if "`gradvec'" != ""{
		tempname grad
		mat `grad' = `gradvec'
		local namecols: colfullnames `gradvec'
		local varcnt: word count `origlist'
		
		forvalue z = 1(1)`varcnt'{
			local old: word `z' of `clonelist'
			local new: word `z' of `origlist'
			
			local namecols: subinstr local namecols "`old'" "`new'", all
		}
		mat colnames `grad' = `namecols'	
		
		ereturn matrix gradient = `grad'
	}
	
	if "`jacvec'" != ""{
		tempname jacob
		mat `jacob' = `jacvec'
		local namecols: colfullnames `jacvec'
		local varcnt: word count `origlist'
		
		forvalue z = 1(1)`varcnt'{
			local old: word `z' of `clonelist'
			local new: word `z' of `origlist'
			
			local namecols: subinstr local namecols "`old'" "`new'", all
		}
		mat colnames `jacob' = `namecols'	
		
		ereturn matrix Jacobian = `jacob'	
	}
	
	if "`estcmdl'" != ""{
		ereturn local est_cmdline 	= "`estcmdl'"
	}
	if "`cmdl'" != ""{
		ereturn local cmdline 		= "`cmdl'"
	}
	if "`bascmd'" != ""{
		ereturn local cmd 			= "`bascmd'"
	}
								
end






*! adjust r()
program define MargRt, rclass
	
	syntax [, 	cmdl(string) bascmd(string) estcmd(string) estcmdl(string) /*
			*/	clonelist(string) origlist(string) /*
			*/	jacvec(name) margreturn(name) ] 
	
	return add
	
	if "`jacvec'" != ""{
		tempname jacob
		mat `jacob' = `jacvec'
		local namecols: colfullnames `jacvec'
		local varcnt: word count `origlist'
		
		forvalue z = 1(1)`varcnt'{
			local old: word `z' of `clonelist'
			local new: word `z' of `origlist'
			
			local namecols: subinstr local namecols "`old'" "`new'", all
		}
		mat colnames `jacob' = `namecols'	
		
		return matrix Jacobian = `jacob'	
	}
	
	if "`estcmdl'" != ""{
		return local est_cmdline 	= "`estcmdl'"
	}
	if "`cmdl'" != ""{
		return local cmdline 		= "`cmdl'"
	}
	if "`bascmd'" != ""{
		return local cmd 			= "`bascmd'"
	}
	
end