*! version 1.0.1 19apr2011 Daniel Klein
*	1.0.1	fix typo in _ft_clear (missing "loc")
*			add clear s(_false#_)
*			add parenthesis to conditions

prog filtertrace ,sclass
	version 11.2

	/*checkset
	-----------*/
	if "`s(_nfifl_)'" == "" sret loc _nfifl_ 0

	/*select subroutine
	--------------------*/
	loc _abbrev = length("`1'")
	loc 0 : list 0 - 1
	if `"`1'"' == "" _ft_list
	else if `"`1'"' == substr("define", 1, `_abbrev') _ft_def `0'
	else if `"`1'"' == substr("check", 1, `_abbrev') _ft_chk `0'
	else if `"`1'"' == substr("import", 1, `_abbrev') _ft_imp `0'
	else if `"`1'"' == substr("export", 1, `_abbrev') _ft_exp `0'
	else if inlist(`"`1'"', "clear", "drop") _ft_clear `1' `0'
	else _mess unrec `"`1'"'
end


/*filtertrace check
--------------------*/
prog _ft_chk ,sclass
	if `s(_nfifl_)' == 0 {
		_mess nofifl
		exit 0
	}

	syntax anything(id = "varlist (filter#) [exp]" equalok) ///
	[, Generate(name) FULLexp noFlag]

	/*get options as syntax is used again later
	--------------------------------------------*/
	loc fullexp `fullexp'
	loc flag `flag'

	/*return user _con
	-------------------*/
	if "`generate'" != "" {
		if "`flag'" != "" _mess notboth generate noflag
		loc _tmp `s(_user_con_hist_)'
		if "`_tmp'" != "" {
			if !`: list posof "`generate'" in _tmp' ///
				loc _tmp "`_tmp' `s(_user_con_hist_)'"
		}
		else loc _tmp `generate'
		sret loc _user_con_hist_ "`_tmp'"
		sret loc _user_con_ "`generate'"
	}

	/*set con if generate not specified
	------------------------------------*/
	if "`generate'" == "" & "`flag'" == "" loc generate _con

	/*get vfes
	-----------*/
	loc i 0
	while `"`anything'"' != "" {
		gettoken vfe`++i' anything : anything ,p(;)
		gettoken sep anything : anything ,p(;)
	}

	/*check condtions
	------------------*/
	tempvar contra
	/*borrowed from Krishnan Bhaskaran (datacheck.ado)*/
	tempname M
	loc cnt 0

	forval j = 1/`i' {

		/*check some input errors
		--------------------------*/
		if !strmatch(`"`vfe`j''"', "*(*)*") _mess invvfc `"`vfe`j''"'
		gettoken vars rest : vfe`j' ,p("(")
		gettoken fifl cnd : rest ,match(m)

		/*set cnd
		----------*/
		if `"`cnd'"' == "" loc cnd != .

		/*check fifl
		-------------*/
		if strmatch("`fifl'", "*T*") | strmatch("`fifl'", "*t*") {
			loc true 1
			foreach t in T t {
				loc fifl : subinstr loc fifl "`t'" " " ,all
			}
		}
		else loc true 0
		cap numlist "`fifl'" ,int range(>0 <=`s(_nfifl_)')
		if _rc _mess invnum filter `"`vfe`j''"'
		loc flist `r(numlist)'

		/*check vars
		-------------*/
		if strmatch("`vars'", "*:*") {
			gettoken list vars : vars ,p(:)
			loc vars : subinstr loc vars ":" "" ,all
			if !strmatch("`vars'", "*@*") _mess noplc `"`vars'"'
			loc mm : word count `flist'
			cap numlist "`list'" ,int min(`mm') max(`mm')
			if _rc {
				if _rc != 121 _mess invnum list `"`vfe`j''"'
			}
			else loc list `r(numlist)'
			loc nelements : word count `list'
			if `mm' != `nelements' _mess invnum nlist `"`vfe`j''"'
			loc _sbs 1
		}
		else {
			loc list 1 //pseudo list
			loc _sbs 0
		}

		/*assert expressions
		---------------------*/
		loc cl 0
		foreach p of loc list { //extra loop over (pseudo) list
			if `_sbs' {
				loc _cpy_vars : subinstr loc vars "@" "`p'" ,all
				loc _cpy_flist : word `++cl' of `flist'
			}
			else {
				loc _cpy_vars `vars'
				loc _cpy_flist `flist'
			}
		/*no closing brace } here
		also no tab stop hereafter
		for readability reasons*/

		foreach var of varlist `_cpy_vars' {

			/*add varname or replace placeholders
			--------------------------------------*/
			if !strmatch(`"`cnd'"', "*@*") {
				if strmatch(`"`cnd'"', "*&*") | strmatch(`"`cnd'"', "*|*") ///
				_mess noplc `"`cnd'"'
				else loc _cpy_cnd `"(`var' `cnd')"'
			}
			else {
				loc _cpy_cnd : subinstr loc cnd "@" "`var'" ,all
				loc _cpy_cnd `"(`_cpy_cnd')"'
			}

			/*add not filter
			-----------------*/
			if !`true' {
				loc _not_cnd `"!(`_cpy_cnd')"'
				loc _toflist _cpy_cnd _not_cnd
			}
			else loc _toflist _cpy_cnd

			/*loop over filters
			--------------------*/
			di _n(2) "{txt}variable: {res}`var'" _n
			foreach fn of loc _cpy_flist {
				foreach tof of loc _toflist {
					if "`tof'" == "_not_cnd" {
						loc _not !
						loc _discol 6
					}
					else {
						loc _not
						loc _discol 7
					}
					di _col(`_discol')`"{res}`_not'{txt}({res}`fn'{txt})"'
					di _col(11) `"{txt}checking {res}``tof''"'

					/*mark the sample
					------------------*/
					loc 0 `s(_ifin`fn'_)'
					syntax [if][in]
					marksample touse

					/*assert
					---------*/
					cap as ``tof'' if `_not'(`s(_fltrflg`fn'_)') & `touse'
					if _rc {
						loc ++cnt
						cap drop `contra'
						qui g byte `contra' = !(``tof'') ///
						& `_not'(`s(_fltrflg`fn'_)') & `touse'

						/*report
						---------*/
						if "`tof'" == "_not_cnd" loc trfl false
						else loc trfl true
						qui ta `contra' ,matcell(`M')
						loc r = r(r)
						if `r' == 0 loc _tmp_c .
						else loc _tmp_c = `M'[`r' ,1]
						sret loc _ncon`cnt'_ `_tmp_c'
						sret loc _Ncon`cnt'_ = r(N)
						if "`fullexp'" != "" ///
							sret loc _cndcon`cnt'_ ///
							`"`_not'(`s(_fltrflg`fn'_)') & ``tof''"'
						else ///
							sret loc _cndcon`cnt'_ `"`_not'(`fn') & ``tof''"'
						di _col(11) `"{res}`_tmp_c'"' ///
						`" {txt}`=plural(`_tmp_c', "contradiction")'"' ///
						`" in {res}`s(_`trfl'`fn'_)' {txt}observations"'

						/*create contra flags if requested
						-----------------------------------*/
						if "`generate'" != "" {
							cap drop `generate'`cnt'
							qui g byte `generate'`cnt' = `contra'
							if "`fullexp'" != "" loc varlb ///
							`"`s(_fltrflg`fn'_)' `s(_ifin`fn'_)' & ``tof''"'
							else loc varlb `"& ``tof''"'
							la var `generate'`cnt' `"`_not'(`fn') `varlb'"'
							di _col(11) `"{txt}(created indicator"' ///
							`" variable {res}`generate'`cnt'{txt})"'
						}
					}
					else di _col(11) "{txt}no contradictions"
				}
			}
		}
		} //extra loop over (pseudo) list
	}

	/*summarize contradictions
	---------------------------*/
	di _n(3) "{txt}Contradictions" _n
	if `cnt' == 0 di col(11) "{txt}no contradictions"
	forval c = 1/`cnt' {
		di _col(11) "{res}"`s(_ncon`c'_)' _col(17) ///
		"{txt}`= plural(`s(_ncon`c'_)', "contradiction")' " ///
		"in condition {res}`s(_cndcon`c'_)'"
		if "`generate'" != "" {
			di _col(17) "{txt}tagged in {res}`generate'`c' " ///
			"{txt}(N = {res}`s(_Ncon`c'_)'{txt})"
		}
	}
end


/*define filters
-----------------*/
prog _ft_def ,sclass
	syntax anything(id = "conditions" equalok) [if][in] ///
	[, Add REPLACE(numlist int > 0) Generate(name)]

	/*check options
	----------------*/
	if `s(_nfifl_)' > 0 {
		if "`add'" == "" & "`replace'" == "" _mess exist
	}
	if "`add'" != "" & "`replace'" != "" _mess notboth add replace
	if `s(_nfifl_)' == 0 & ("`add'" != "" | "`replace'" != "") {
		loc messadd = cond("`add'" != "", "add", "replace")
		_mess nofifl addreplace `messadd'
		loc add
		loc replace
	}

	/*get -ifin-
	--------------*/
	loc ifin "`if' `in'"

	/*check and return generate
	----------------------------*/
	if "`generate'" != "" {
		cap conf new v `generate'
		if _rc _mess stubexists `generate'
		loc _tmp `s(_user_fltrflg_hist_)'
		if "`_tmp'" != "" {
			if !`: list posof "`generate'" in _tmp' ///
				loc _tmp "`generate' `_tmp'"
		}
		else loc _tmp `generate'
		sret loc _user_fltrflg_hist_ "`_tmp'"
		sret loc _user_fltrflg_ "`generate'"
	}

	/*get all conditions separated by ; and check for varlists
	-----------------------------------------------------------*/
	loc i 0
	while `"`anything'"' != "" {
		gettoken cnd`++i' anything : anything ,p(;)
		gettoken sep anything : anything ,p(;)

		/*check for varlist and extract
		--------------------------------*/
		if strmatch(`"`cnd`i''"', "*:*") {
			gettoken vars cnd`i' : cnd`i' ,p(:)
			loc cnd_oneforall : subinstr loc cnd`i' ":" "" ,all
			foreach v of varlist `vars' {

				/*replace placeholders in complex condition
				--------------------------------------------*/
				loc cpy_cnd = trim(`"`cnd_oneforall'"')
				if !strmatch(`"`cpy_cnd'"', "*@*") {
					if strmatch(`"`cpy_cnd'"' ,"*&*") ///
					| strmatch(`"`cpy_cnd'"', "*|*") ///
						_mess noplc `"`cnd_oneforall'"'
					else loc cpy_cnd `"`v' `cpy_cnd'"'
				}
				else loc cpy_cnd : subinstr loc cpy_cnd "@" "`v'" ,all
				loc cnd`i' `"`cpy_cnd'"'
				loc ++i
			}
			loc --i
		}
	}

	/*define filter flags
	----------------------*/
	if "`replace'" != "" {
		if `i' != `: word count `replace'' _mess manyfew
		loc w 1
		foreach r in `replace' {
			if `"`s(_fltrflg`r'_)'"' == "" _mess notfound "`r'"
			else {
				loc cnd`w' = trim(`"`cnd`w''"')
				sret loc _fltrflg`r'_ `"(`cnd`w'')"'
				if "`ifin'" != "" sret loc _ifin`r'_ "`ifin'"
			}
			loc ++w
		}
	}
	if "`add'" != "" {
		loc lastone = `s(_nfifl_)' + `i'
		forval j = 1/`i' {
			forval k = 1/`lastone' {
				if `"`s(_fltrflg`k'_)'"' == "" {
					loc cnd`j' = trim(`"`cnd`j''"')
					sret loc _fltrflg`k'_ `"(`cnd`j'')"'
					if "`ifin'" != "" sret loc _ifin`k'_ "`ifin'"
					sret loc _nfifl_ = `s(_nfifl_)' + 1
					continue, break
				}
			}
		}
	}
	if "`add'" == "" & "`replace'" == "" {
		forval j = 1/`i' {
			loc cnd`j' = trim(`"`cnd`j''"')
			sret loc _fltrflg`j'_ `"(`cnd`j'')"'
			if "`ifin'" != "" sret loc _ifin`j'_ "`ifin'"
			sret loc _nfifl_ = `s(_nfifl_)' + 1
		}
	}

	/*create filter flags and list
	-------------------------------*/
	_ft_makefilters
	_ft_list
end


/*list defined filters
-----------------------*/
prog _ft_list ,sclass
	if `s(_nfifl_)' == 0 _mess nofifl
	else {
		forval j = 1/`s(_nfifl_)' {
			di _n _col(7) "{txt}({res}`j'{txt}) " ///
			`"{res}`s(_fltrflg`j'_)' `s(_ifin`j'_)'"'
			if "`s(_user_fltrflg_)'" != "" ///
			di _n _col(11) "{txt}variable: {res}`s(_user_fltrflg_)'`j'"
			di _n _col(11) "{txt}true {res}" `s(_true`j'_)'
			di _col(11) "{txt}(N = {res}`s(_N`j'_)'{txt})"
		}
	}
end


/*clear filters or drop flags
------------------------------*/
prog _ft_clear ,sclass
	if `s(_nfifl_)' == 0 _mess nofifl
	if `"`2'"' != "" { 						//clear or drop all
		if `"`2'"' != "all" _mess unrec clear `"`1' `2'"'
		else {
			if `"`1'"' == "clear" sret clear
			else if `"`1'"' == "drop" {
				foreach f in _con `s(_user_con_hist_)' ///
				`s(_user_fltrflg_hist_)'{
					set varabbrev off
					cap conf v `f'
					set varabbrev on
					if !_rc {
						loc rb 1
						qui rename `f' _`f'__
					}
					else loc rb 0
					cap drop `f'*
					di "{txt}drop {res}`f'#"
					if `rb' qui rename _`f'__ `f'
				}
				sret loc _user_fltrflg_
				sret loc _user_fltflg_hist_
				sret loc _user_con_
				sret loc _user_con_hist_
			}
		}
	}
	else { 									//clear or drop filters
		if `"`1'"' == "clear" {
			forval j = 1/`s(_nfifl_)' {
				foreach s in _fltrflg`j'_ _ifin`j'_ _N`j'_ _true`j'_  ///
				_false`j'_ _user_fltrflg_ _user_fltrflg_hist_ {
					sret loc `s'
				}
			}
			sret loc _nfifl_ 0
		}
		else if `"`1'"' == "drop" {
			foreach f in `s(_user_fltrflg_hist_)' {
				set varabbrev off
				cap conf v `f'
				set varabbrev on
				if !_rc {
					loc rb 1
					qui rename `f' _`f'__
				}
				else loc rb 0
				cap drop `f'*
				di "{txt}drop {res}`f'#"
				if `rb' qui rename _`f'__ `f'
			}
			sret loc _user_fltrflg_
			sret loc _user_fltrflg_hist_
		}
	}
end


/*reimport filters
-------------------*/
prog _ft_imp ,sclass
	tempname R M
	if `s(_nfifl_)' != 0 _mess exist imp
	syntax name
	cap d `namelist'* ,varl
	loc _tmp : word count `r(varlist)'
	if `_tmp' == 0 _mess notfound `namelist'
	else {

		/*check all names are valid variables
		--------------------------------------*/
		forval j = 1/`_tmp' {
			conf v `namelist'`j'
		}

		/*return filters in s()
		------------------------*/
		sret loc _nfifl_ `_tmp'
		sret loc _user_fltrflg_ `namelist'
		loc _tmp `s(_user_fltrflg_hist_)'
		if "`_tmp'" != "" {
			if !`: list posof "`namelist'" in _tmp' ///
				sret loc _user_fltrflg_hist_ ///
				"`namelist' `_tmp'"
		}
		else sret loc _user_fltrflg_hist_ `namelist'
		forval j = 1/`s(_nfifl_)' {
			loc lbl : var l `namelist'`j'
			if `"`lbl'"' == "" {
				_mess notlab `j'
				loc lbl .
			}
			sret loc _fltrflg`j'_ `lbl'
			sret loc _ifin`j'_ if `namelist'`j' != .
			qui ta `namelist'`j' ,matrow(`R') matcell(`M')

			/*check dummy
			--------------*/
			if r(r) != 2 {
				if r(r) == 0 {
					_mess noobs `j'
					mat `M' = .\.
				}
				else {
					if `R'[1, 1] == 0 loc _tmp false
					else loc _tmp true
					_mess truefalse `j' `_tmp'
				}
			}
			sret loc _N`j'_ = r(N)
			sret loc _true`j'_ = `M'[2, 1]
			sret loc _false`j'_ = `M'[1, 1]
		}
	}
	_ft_list
end


/*export filters
-----------------*/
prog _ft_exp ,sclass
	if `s(_nfifl_)' == 0 {
		_mess nofifl
		exit 0
	}
	syntax name
	/*check names not used
	-----------------------*/
	forval j = 1/`s(_nfifl_)' {
		conf new v `namelist'`j'
	}
	sret loc _user_fltrflg_ `namelist'
	loc _tmp `s(_user_fltrflg_hist_)'
	if "`_tmp'" != "" {
		if !`: list posof "`namelist'" in _tmp' ///
			sret loc _user_fltrflg_hist_ "`namelist' `_tmp'"
	}
	else sret loc _user_fltrflg_hist_ `namelist'
	_ft_makefilters
end


/*create filter flags (make filters)
-------------------------------------*/
prog _ft_makefilters ,sclass
	tempvar _fltrflg
	tempname R M

	/*check defined filters
	------------------------*/
	forval j = 1/`s(_nfifl_)' {
		cap g byte `_fltrflg' = (`s(_fltrflg`j'_)') `s(_ifin`j'_)'
		if _rc {
			_mess invalid `j'
			continue
		}
		qui ta `_fltrflg' `s(_ifin`j'_)' ,matrow(`R') matcell(`M')

		/*check dummy
		--------------*/
		if r(r) != 2 {
			if r(r) == 0 {
				_mess noobs `j'
				mat `M' = .\.
			}
			else {
				if `R'[1, 1] == 0 loc _tmp false
				else loc _tmp true
				_mess truefalse `j' `_tmp'
			}
		}

		sret loc _N`j'_ = r(N)
		sret loc _true`j'_ = `M'[2, 1]
		sret loc _false`j'_ = `M'[1, 1]

		/*create variables if requested
		--------------------------------*/
		if "`s(_user_fltrflg_)'" != "" {
			cap drop `s(_user_fltrflg_)'`j'
			qui g byte `s(_user_fltrflg_)'`j' = `_fltrflg'
			la var `s(_user_fltrflg_)'`j' `"`s(_fltrflg`j'_)' `s(_ifin`j'_)'"'
		}
		drop `_fltrflg'
	}
end


/*error messages
-----------------*/
prog _mess
	if "`1'" == "unrec" {
		di `"{err}unrecognized subcommand: {bf:`2' `3'}"'
		exit 198
	}
	if "`1'" == "exist" {
		di "{err}filters already defined;"
		if "`2'" != "imp" {
			di "{err}use {bf:add} or {bf:replace} to add new " ///
			"filters or modify existing filters"
		}
		di "use {stata filtertrace clear} " ///
		"to clear existing flags"
		exit 110
	}
	if "`1'" == "notboth" {
		di "{err}{bf:`2'} and {bf:`3'} not both allowed"
		exit 198
	}
	if "`1'" == "manyfew" {
		di "{err}invalid {bf:replace()}: " ///
		"number of {it:conditions} does not "///
		"equal number of filters to be replaced"
		exit 198
	}
	if "`1'" == "notfound" {
		di "{err}filter (`2') not found"
		exit 111
	}
	if "`1'" == "invvfc" {
		di `"{err}invalid `2'"'
		di "{err}{it:vfe} must be {it:varlist} ({it:filter#}) [{it:exp}]"
		exit 198
	}
	if "`1'" == "noplc" {
		di `"{err}invalid `2' : no @ found"'
		exit 198
	}
	if "`1'" == "invnum" {
		if "`2'" == "filter" {
			di "{err}invalid {it:filter#} in `3'"
		}
		if "`2'" == "list" {
			di "{err}invalid {it:list} in `3'"
		}
		if "`2'" == "nlist" {
			di "{err}invalid {it:list} in `3';"
			di "number of elements must equal number of filters"
		}
		exit 198
	}

	/*non errors
	-------------*/
	if "`1'" == "nofifl" {
		di "{txt}no filters defined"
		if "`2'" == "addreplace" {
			di "{txt}ignoring option {res}`3'"
		}
		exit 0
	}
	if "`1'" == "invalid" {
		di "{txt}note: invalid {res}`s(_fltrflg`2'_)'"
		exit 0
	}
		if "`1'" == "noobs" {
		di "{txt}no observations for ({res}`2'{txt})" ///
		" {res}`s(_fltrflg`2'_)' {txt}`s(_ifin`2'_)'"
		exit 0
	}
	if "`1'" == "truefalse" {
		di "{txt}note: {txt}({res}`2'{txt}) {res}`s(_fltrflg`2'_)'" ///
		" {txt}is {res}`3' {txt}for all observations"
		exit 0
	}
	if "`1'" == "notlab" {
		di "{txt}note: no conditon found in ({res}`2'{txt})"
		exit 0
	}
	if "`1'" == "stubexists" {
		di "{txt}caution: {res}`2' {txt}already exists;"
		di "{txt}using {bf:filtertrace drop} will drop {res}`2'"
		exit 0
	}
end