program define retainlbl, rclass
*!  version 2.1	11Sep2022                       by Mead Over
*	Preserves and restores variable labels, for example before and after execution of -collapse- or -reshape-
*	Does not process value labels.
*	From version 1.4, variable names may be changed by a prefix or suffix.
	version 11.2

	syntax anything , [Store REStore  ///
		OFFPrefix(string) OFFSuffix(string)  ///  Options for store
		ADDPrefix(string) ADDSuffix(string) missingok  ///  Options for restore
		WIDEnow LONGnow Ivar(varname) Jvar(string) verbose]   //  Options for store

	//  Arguments can be either variables or "stubnames"
	local stublist `anything'


	if ("`store'"=="store")+("`restore'"=="restore") ~= 1 {
		di as err "Program -retainlbl- requires one and only one of the options -store- or -restore-"
		error 198
	}

	wide_or_long `stublist', `widenow' `longnow'

		if "`verbose'"~=""  return list

		local widestubs `r(widestubs)'
		local longvars  `r(longvars)'
		if "`longvars'"=="" {
			foreach wv in `widestubs'  {
				local longvars : list longvars - wv
			}
		}
		local ivar = cond("`ivar'"=="","ivar","`ivar'")
		local jvar = cond("`jvar'"=="","jvar","`jvar'")
		local reshape_i   reshape i   `ivar'
		local reshape_j   reshape j   `jvar' `r(jvals)'
		local reshape_xi  reshape xi  `longvars'
		local reshape_xij reshape xij `widestubs'
		local shape `r(shape)'
		if "`widestubs'"~="" {
			local stublist `widestubs'
		}


	if "`store'"=="store"   {
		if "`shape'"=="wide"   {
			foreach s in `stublist' {
				qui describe `s'*
				// prune variable name suffix, if any, from back of variable name
				foreach v of varlist `s'* {
					local thisj = subinstr(substr("`v'",length("`s'")+1,.)," ","",.)
					local lvlsofj `lvlsofj' `thisj'
				}
				//  Get label from first variable in `s'*
				local firstlbl
				local lvlsofj : list uniq lvlsofj
				foreach jlvl in `lvlsofj' {
					if `"`firstlbl'"'=="" {
						local firstlbl : variable  label `s'`jlvl'
						local firstlbl = trim(subinstr(`"`firstlbl'"',"`jlvl'","",. ))
					}
				}

				//  Assign label from first variable in `s'* to the global macro for stub `s'
				if "`offprefix'"=="" & "`offsuffix'"=="" {
					global vlbl_`s' `"`firstlbl'"'
				}
				if "`offprefix'"~="" {
					local nchars = strlen(trim("`offprefix'"))
					//  Does the prefix to be removed begin the variable label?
					if strpos(trim("`firstlbl'"),trim("`offprefix'"))==1 {
						local newlbl = trim(substr("`firstlbl'",`nchars'+1,.))
					}
					else {
						local newlbl = trim(`"`firstlbl'"')
					}
					global vlbl_`s' `"`newlbl'"'
				}
				if "`offsuffix'"~="" {
					local nchars = strlen(trim("`offsuffix'"))
					//  Does the suffix to be removed end the variable label?
					if strpos(trim("`firstlbl'"),trim("`offsuffix'"))==length(trim("`firstlbl'")-`nchars') {
						local newlbl = trim(substr("`firstlbl'",1,strpos("`firstlbl'","`offsuffix'")-1))
					}
					else {
						local newlbl = trim(`"`firstlbl'"')
					}
					global vlbl_`s' `"`newlbl'"'
				}
				if "`verbose'"~="" & "${vlbl_`s'}"~=""  di as txt "Storing global macro " as res "vlbl_`s'" as txt " as -" as res "${vlbl_`s'}" as txt "-"
				if "${vlbl_`s'}"~=""  local n_xij = `n_xij' + 1
			}
			global n_xij = `n_xij'  //  Number of Xij variables named by user's call to retainlbl , store
		}
		else if "`shape'"=="long"  {
			local n_xij = 0
			foreach v of varlist `longvars' {
				local thislbl : variable  label `v'
				if `"`thislbl'"'==""  {
					if "`verbose'"~="" di as txt "The variable " as res "`v'" as txt " has no label for -retainlbl- to store."
				}
				else {
					//  Assign label from variable `v' to the global macro for stub `v'
					if "`offprefix'"=="" & "`offsuffix'"=="" {
						global vlbl_`v' `"`thislbl'"'
					}
					if "`offprefix'"~="" {
						local nchars = strlen("`offprefix'")
						//  Does the prefix to be removed begin the variable label?
						if strpos(trim("`thislbl'"),trim("`offprefix'"))==1 {
							local newlbl = trim(substr("`thislbl'",`nchars'+1,.))
						}
						else {
							local newlbl = trim(`"`thislbl'"')
						}
						global vlbl_`v' `"`newlbl'"'
					}
					if "`offsuffix'"~="" {
						local nchars = strlen(trim("`offsuffix'"))
						//  Does the suffix to be removed end the variable label?
						if strpos(trim("`thislbl'"),trim("`offsuffix'"))==length(trim("`thislbl'")-`nchars') {
							local newlbl = trim(substr("`thislbl'",1,strpos("`thislbl'","`offsuffix'")-1))
						}
						else {
							local newlbl = trim(`"`thislbl'"')
						}
						global vlbl_`v' `"`newlbl'"'
					}
					if "`verbose'"~="" & `"${vlbl_`v'}"'~=""  di as txt "Storing global macro " as res "vlbl_`v'" as txt " as -" as res `"${vlbl_`v'}"' as txt "-"
					if `"${vlbl_`v'}"'~=""  local n_xij = `n_xij' + 1
				}
			}
			global n_xij = `n_xij'  //  Number of Xij variables named by user's call to retainlbl , store
		}
	}

	if "`restore'"=="restore" {
		foreach V in `stublist' {
			qui capt describe *`V'*, varlist
			local widevarnms `r(varlist)'
			local nlvls = wordcount("`widevarnms'")
			// If the variable name is unique or missing, this was not reshape, wide
			if `nlvls' <= 1 {
				if `"${vlbl_`V'}"' == "" {
					di _n as err "Label has not been stored for variable: " in ye "`V'"  ///
						_n "and therefore cannot be -re-stored."
					if "`missingok'" =="" {
						error 198
					}
					else {
						di as err "User has specified the -missingok- option, so execution continues."
					}
				}
				local lbl : variable lab `V'
				local parenplace = strpos("`lbl'",")")
				if `parenplace'~= 0 {
					local prfx = substr("`lbl'",1,`parenplace')
					char define `V'[collapse_type] = "`prfx'"
				}
				label var `V' `"`addprefix'${vlbl_`V'}`addsuffix'"'
				if "`verbose'"~="" di _n as txt "The label of variable " as res "`V'" as txt " is now " as res `"`addprefix'${vlbl_`V'}`addsuffix'"'
			}
			//	If there are multiple variable names that begin with `V',
			//	the previous command might have been reshape, wide
			else {
				local jvar :  char _dta[ReS_j]
				foreach v of varlist `widevarnms' {
					local sfx = subinstr("`v'","`V'","",.)
*					local sfx = substr("`v'",length("`V'")+1,.)
					if `"${vlbl_`V'}"' == "" {
						di _n as err "Label has not been stored for variable: " in ye "`V'"  ///
							_n as err "and therefore cannot be -re-stored."
						if "`missingok'" =="" {
							error 198
						}
						else {
							di as err "User has specified the -missingok- option, so execution continues."
						}
					}
*					local lbl : variable lab `V'
					local lbl `"${vlbl_`V'}"'
					local parenplace = strpos(`"`lbl'"',")")
					if `parenplace'~= 0 {
						local prfx = substr(`"`lbl'"',1,`parenplace')
						char define `V'[collapse_type] = "`prfx'"
					}
*					local newlbl = trim(`"`addprefix'${vlbl_`V'}`addsuffix', `jvar'=`sfx'"')
					local newlbl = trim(`"`sfx': `addprefix'${vlbl_`V'}`addsuffix'"')
					label var `v' `"`newlbl'"'
					if "`verbose'"~="" di _n as txt "The label of variable " as res "`v'" as txt " is now " as res `"`newlbl'"'
				}
			}
			global vlbl_`V' // Clean out the globals when they are no longer needed.
			global n_xij
		}
	}

	return local reshape_i   `reshape_i'
	return local reshape_j   `reshape_j'
	return local reshape_xi  `reshape_xi'
	return local reshape_xij `reshape_xij'
	return local longvars    `longvars'
	return local widevars    `widevars'
	return local shape       `shape'

end  /* End of main program */

program define wide_or_long , rclass

	syntax anything, [widenow longnow]

	local stublist `anything'

	if "`widenow'" == "widenow" & "`longnow'"== "longnow" {
		di as err "Program -retainlbl- accepts only one of the options -widenow- or -longnow-, not both"
		error 198
	}

	//	Is the data currently wide or long?
	foreach s in `stublist' {

		//  Multiple variables with one stub?
		qui describe *`s'* , varlist
		local nvars_`s' = wordcount("`r(varlist)'")
		if `nvars_`s''> 1 {
			local widestubs `widestubs' `s'
			local widevlist `widevlist'  *`s'*
			unab widevar_`s' :  *`s'*
			foreach v of varlist `widevar_`s'' {
				local jval = subinstr("`v'","`s'","",.)
				local jvals_`s' `jvals_`s'' `jval'
				local jvals  `jvals' `jval'
			}
			local jvals_`s' : list uniq jvals_`s'
		}
		//  Single variable with a stub?
		else if `nvars_`s''== 1 {
			unab v : `s'
			local longvars `longvars' `v'
			capture tab `v'
			if _rc==0 {
				qui levelsof `v'
				local lvals_`s' `r(levels)'
			}
			local lvals `lvals' `lvals_`s''
			local lvals : list uniq lvals
		}
		// No variables with a stub?
		else {
			local novars `novars' `s'
		}
	}
	if "`longvars'"~=""   unab longvars : `longvars'
	if "`widevlist'"~=""  unab widevars : `widevlist'
	local jvals : list uniq jvals

	if "`novars'"~="" {
		di as err "The following stubs define no variables"  ///
			_n as res "`novars'"
		di as err "Each stub among the list of variable stubs must define one or more variables"
		exit 111
	}

	if "`longvars'"~="" & "`widenow'"=="widenow"  {
		di as txt "Although user has specified that the data is -wide-,"  ///
			_n as txt "each of the following stubs defines a single variable:" ///
			_n as res "`longvars'"

		describe `longvars'

			di _n as txt "Execution continues under assumption that data is -wide-"
	}

	if "`widestubs'"~="" & "`longnow'"=="longnow"  {
		di as txt "Although user has specified that the data is -long-,"  ///
			_n as txt "the following stubs define variable lists with more than one variable:"  ///
			_n as res "`widestubs'"

		describe `widevlist'

			di _n as txt  "Execution continues under assumption that data is -long-"
	}

	if ("`longvars'"~="" & "`widestubs'"=="") | "`longnow'"~="" {
		local shape long
*		di as txt "Data is `shape'"
	}

	else if ("`longvars'"=="" & "`widestubs'"~="") | "`widenow'"~="" {
		local shape wide
*		di as txt "Data is `shape'"
	}
	else {
		local shape unknown
		di as txt "Some of the specified stubs describe multiple variables and others only one variable."  ///
			_n "Stubs describing multiple variables are consistent with data in -reshape-'s -wide- format."  ///
			_n "Stubs describing a single variable are consistent with data in -reshape-'s -long- or -flat- format."  ///
			_n "User may treat the data's -shape- as -wide- with the variables -" as res "`longvars'" as txt "- designated as -xi- variables"  ///
			_n "or user may specify the data's -shape- to be -long- or -flat-, and not attempt to reshape from wide to long."

		di _n as txt  "Execution continues without assuming the shape of the data"

	}

	return local shape     `shape'
	return local widestubs `widestubs'
	return local widevlist `widevlist'
	return local widevars  `widevars'
	return local jvals     `jvals'
	return local longvars  `longvars'
	return local lvals     `lvals'
	return local novars    `novars'

end  /* End of program wide_or_long  */

program define getrsmacros , rclass
*	Currently (9Nov2020), this subroutine is unused

*	Have reshape macros been previously added to the data?
*		They might be wrong though.  In fact the macros stored with
*		Chuck Huber's webuse file "reshape6.dta" are wrong

	foreach rm in ReS_i ReS_j ReS_jv ReS_Xij ReS_Xij_n {
		local `rm' : char _dta[`rm']
		local allrm `allrm' ``rm''
	}
	if "`allrm'"=="" {
		di as txt "Reshape macros are empty"
		local allrm empty
	}
	else {
		di as txt "Reshape macros are present"
		local allrm present
		local ReS_jv    : char _dta[ReS_jv]
		local ReS_Xi    : char _dta[ReS_Xi]
		local ReS_Xij   : char _dta[ReS_Xij]
		local ReS_atwl  : char _dta[ReS_atwl]
		local ReS_str   : char _dta[ReS_str]
		foreach s in `ReS_Xij' {
		    //  Variable labels retained by -reshape-: _dta[__XijVarLab`s']
			//  -reshape- stores these macros in -wide- data when reshaping from -long- to -wide-.
			//  If these macros are present, reshape automatically restores
			//  variable labels on -reshape- from -wide- to -long-
		    local ReS_XijVarLab  : char _dta[__XijVarLab`s']
			return local ReS_XijVarLab`s' `ReS_XijVarLab`s''
		}
	}

	di as txt "Reshape macros are " as res "`allrm'"
	return local reshapemacros `allrm'    //  equal to -empty- or list of those present
	return local ReS_Xij   `ReS_Xij'      //  Variables to be reshaped
	return local ReS_Xij_n `ReS_Xij_n'    //  Number of variables to be reshaped

end  /* End of program -getrsmacros-  */

*	Version 1.0.1 30Sep2008
*	Version 1.1	9Jul2017	Add the options, prefix and suffix
*	Version 1.2	6Dec2017	Changes version requirement from 9.2 to 11.2
*		to accommodate longer global macros
*	Version 1.3	30Jan2018	Enable removal of suffix & prefixes with offprefix, offsuffix options
*	Version 1.4	20Oct2018	For reshape wide, each reshaped Xij variable is converted to K
*		variables, the name of each of which has a suffix equal to one of the K values of the -j- variable.
*		With version 1.4 of -retainlbl-, after -reshape,wide-, the variable label
*		from the long variable is assigned to all the newly created variables and a sfx is appended.
*	Version 1.5	22Dec2018	Fix bug in -unab- logic in line 10.
*	Version 1.5	22Dec2018	Clarify in this program and in help file the distinction between adding
*		and removing pre/suffixes to the variable names and to the variable labels.
*		Collapse requires manipulating prefixes and suffixes to the labels.
*		Reshape requires manipulating them from the variables NAMES.
*		The -retainlbl- help file is hopelessly confusing.
*	Version 2.0	31May2022  Re-written from scratch back in Nov, 2020.
*		Fixed bug in -unab- logic in line 10.
*		Accomodate -reshape- from wide to long
*		Add subroutine -getrsmacros-, but it's not yet used.
*	Version 2.1	11Sep2022  Changes after testing by reshaping -docvars- file with "@" suntax.
*		Prefix varlist with -*- in:
*			line 222:  qui describe *`s'* , varlist
*			line 226:  local widevlist `widevlist'  *`s'*
*			line 227:  unab widevar_`s' :  *`s'*
*			line 139:  qui capt describe *`V'*, varlist

*	TODO:  (last updated 16Jan2020)
*		See the program retainlbl_new.ado in .\meadfiles
*		What to do about -reshape's option to place -jvalue- elsewhere than at end of variable name?
*			Possibly outlaw any other placement...
*		After reshape from -wide- to -long-, allow use of the reshape-provided
*			characteristics _dta[__XijVarLab`s' when present.  Use sub -getrsmacros-
*		Fully certify with:
*			Use the demo data files in the new -retainlbl- help file, version 2.0
*			Use Robert Picars's -clean_char- to remove characteristics when a clean data set is required.
*			Start from either a clean long or clean wide file
*			Retain labels when iterating from one to the other and back
*			Add and remove suffixes and prefixes
*			Check that -retainblbl- works with -fastreshape-
*				e.g. Does -fastreshape- use the same characteristics & macros?
*		Among the downloadable demo data files prepared by -clnrsdata.ado- are:
*			reshape1:  Wide with inc, ue and sex is numeric
*			reshape3:  Wide with inc, ue and sex is numeric, but income names are inc@r
*			reshape5:  Long with inc, NOT ue and sex is string
*			reshape6:  Long with inc, ue and sex is numeric

*		Should these be used for certification in addition to those in the retainlbl help file?

*		-retainlbl- was originally designed to work with a collapse command that
*			keeps the same variable names as in:
*				collapse (mean) x y z, by(id)
*			The command will not work with the alternative -collapse- syntax:
*				collapse (mean) mn_x=x mn_y=y mn_z=z, by(id)
*			How could the command work with both syntaxes?
*				Perhaps the syntax mn_x=x could be permitted in retainlbl
*				and used to signal that the original label for x
*				should be applied to mn_x (with the optional addition of a prefix such as (mean))
*
*		Should -retainlbl- have options to retain value labels, or not. To retain -notes- or not?
*
*
*		N.B.  16Aug2022  In Stata 17 and possibly before, Stata has two undocumented commands
*		which might replace the functionality of -retainalbl- for value labels in some circumstances:
*		See help _strip_labels and help _restore_labels.  Also see user contributed -elabel.