* tmap_choropleth NJC 1.1.0 14 July 2004 
*! -tmap_choropleth-: Choropleth maps                                          
*! Version 1.2 - 23 July 2004                                                  
*! Version 1.0 - 24 January 2004                                               
*! Author: Maurizio Pisati                                                     
*! Department of Sociology and Social Research                                 
*! University of Milano Bicocca (Italy)                                        
*! maurizio.pisati@unimib.it                                                   




*  ----------------------------------------------------------------------------
*  1. Define program                                                           
*  ----------------------------------------------------------------------------

program tmap_choropleth
version 8.2



	
*  ----------------------------------------------------------------------------
*  2. Define syntax                                                            
*  ----------------------------------------------------------------------------

syntax varname(numeric) [if] [in],                 ///
       Id(varname numeric)                         ///
       Map(string)                                 ///
      [CLMethod(string)]                           ///
      [CLNumber(integer 4)]                        ///
      [CLBreaks(numlist min=3 max=10 ascending)]   ///
      [EIRange(numlist min=2 max=2 ascending)]     ///
      [Palette(string)]                            ///
      [Colors(string)]                             ///
      [OColor(string)]                             ///
      [OSize(string)]                              ///
      [LEGPos(integer 7)]                          ///
      [LEGTitle(string)]                           ///
      [LEGFormat(string)]                          ///
      [LEGBox]                                     ///
      [noLEGend]

/*
CLMethod(quantile | eqint | stdev | custom | unique)
CLNumber(min=2 max=9)
Palette(Blues | BrBG | Greens | Greys | Paired | PuRd |
        Purples | RdBu | RdGy | Reds | Set1 | Set3 |
        YlOrBr | Custom)
        Defaults: Greys  if CLMethod(quantile | eqint | custom)
                  RdBu   if CLMethod(stdev)
                  Paired if CLMethod(unique)
*/




*  ----------------------------------------------------------------------------
*  3. Check syntax                                                             
*  ----------------------------------------------------------------------------

/* Marksample */
marksample touse
qui count if `touse' 
if r(N) == 0 error 2000 

/* Check option map() */
capture confirm file `"`map'"'
if _rc {
	di as err ///
	"{p}file `map' specified in option {bf:{ul:m}ap()} does not exist{p_end}"
	exit 498
}

/* Check option clmethod() */
if "`clmethod'" != "" {
	local LIST "quantile eqint stdev custom unique"
	local EXIST : list posof `"`clmethod'"' in LIST
	if !`EXIST' {
		di as err ///
		"{p}option {bf:{ul:clm}ethod()} accepts only one of the following keywords: {bf:`LIST'}{p_end}"
		exit 198 
	}
}

/* Check option clmethod() */
if "`clmethod'" == "unique" {
	qui tab `varlist' if `touse' 
	if r(r) < 2 {
		di as err "variable `varlist' has too few values"
		exit 498 
	}
	else if r(r) > 9 {
		di as err "variable `varlist' has too many values"
		exit 498 
	}
}

/* Check option clnumber() */
if !inrange(`clnumber', 2, 9) {
	di as err ///
	"{p}option {bf:{ul:cln}umber()} accepts only values between 2 and 9{p_end}"
	exit 198 
} 	

/* Check option clbreaks() */
if "`clmethod'" == "custom" & "`clbreaks'" == "" {
	di as err "{p}if you specify option {bf:{ul:clm}ethod(custom)} you must " _c
	di as err "specify also option {bf:{ul:clb}reaks()}{p_end}"
	exit 198 
}

/* Check option palette() */
if "`palette'"!="" {
	local LIST "Blues BrBG Greens Greys Paired PuRd Purples"
	local LIST "`LIST' RdBu RdGy Reds Set1 Set3 YlOrBr Custom"
	local EXIST : list posof `"`palette'"' in LIST
	if !`EXIST' {
		di as err "{p}option {bf:{ul:p}alette()} accepts only one of the " _c
		di as err "following keywords: {bf:`LIST'}{p_end}"
		exit 198 
	}
}

/* Check option colors() */
if "`palette'" == "Custom" & "`colors'" == "" {
	di as err "{p}if you specify option {bf:{ul:p}alette(Custom)} you must " _c
	di as err "specify also option {bf:{ul:c}olors()}{p_end}"
	exit 198 
}

/* Check option colors() */
if "`palette'" == "Custom" & inlist("`clmethod'","quantile","eqint","stdev") {
	local NCOLORS : word count `colors'
	if `clnumber' != `NCOLORS' {
		di as err "you must specify `clnumber' different colors in option {bf:{ul:c}olors()}"
		exit 198 
	}
}

/* Check option colors() */
if "`palette'" == "Custom" & "`clmethod'" == "custom" {
	local NCLASSES : word count `clbreaks'
	local NCLASSES = `NCLASSES' - 1
	local NCOLORS : word count `colors'
	if `NCLASSES' != `NCOLORS' {
		di as err "you must specify `NCLASSES' different colors in option {bf:{ul:c}olors()}"
		exit 198 
	}
}

/* Check option colors() */
if "`palette'" == "Custom" & "`clmethod'" == "unique" {
	qui tab `varlist' if `touse' 
	local NCLASSES = r(r)
	local NCOLORS : word count `colors'
	if `NCLASSES' != `NCOLORS' {
		di as err "{p}you must specify `NCLASSES' different colors in option {bf:{ul:c}olors()}{p_end}"
		exit 198 
	}
}

/* Check option legpos() */
if `legpos' < 1 | `legpos' > 12 {
	di as err "{p}option {bf:{ul:legp}os()} accepts only values between 1 and 12{p_end}"
	exit 198 
}

/* Check option legformat() */
if "`legformat'"!="" {
	capture qui format `varlist' `legformat'
	if _rc {
		di as err "{p}`legformat' in option {bf:{ul:legf}ormat()} is not a valid format{p_end}"
		exit 198 
	} 
}




*  ----------------------------------------------------------------------------
*  4. Define basic objects                                                     
*  ----------------------------------------------------------------------------

/* Preserve data */
preserve

/* Set default classification method */
if "`clmethod'" == "" local clmethod "quantile"

/* Set default color palettes */
if "`palette'" == "" {
	if "`clmethod'" == "quantile"    local palette "Greys"
	else if "`clmethod'" == "eqint"  local palette "Greys"
	else if "`clmethod'" == "custom" local palette "Greys"
	else if "`clmethod'" == "stdev"  local palette "RdBu"
	else if "`clmethod'" == "unique" local palette "Paired"
}

/* Set default outline color */
if "`ocolor'" == "" local ocolor "black"

/* Set default outline thickness */
if "`osize'" == "" local osize "thin"

/* Set default legend format */
if "`legformat'" == "" local legformat "%8.2f"

/* Keep only relevant cases */
qui keep if `touse' 
	
/* Keep only relevant variables */
keep `id' `varlist'
cap rename `id' _id
cap rename `varlist' _attribute

/* Define attribute range */
if "`clmethod'" != "eqint" {
	su _attribute, meanonly 
	local VMIN = r(min)
	local VMAX = r(max)
}
else if "`clmethod'" == "eqint" { 
	if "`eirange'" == "" {
		su _attribute, meanonly 
		local VMIN = r(min)
		local VMAX = r(max)
	}
	else { 
		local VMIN : word 1 of `eirange'
		local VMAX : word 2 of `eirange'
	}
}	




*  ----------------------------------------------------------------------------
*  5. Create class variable                                                    
*  ----------------------------------------------------------------------------

/* Set number of classes */
local NC = `clnumber'
if "`clmethod'" == "custom" {
	local NC : word count `clbreaks'
	local NC = `NC' - 1
}
else if "`clmethod'" == "unique" {
	qui tab _attribute
	local NC = r(r)
}

/* Quantile method */
if "`clmethod'" == "quantile" {
	qui pctile _cutpoints = _attribute, nq(`NC')
	qui xtile _class = _attribute, cutpoints(_cutpoints)
	local CBREAKS "`VMIN'"
	forval i = 1/`=`NC'-1' {
		local CB = _cutpoints[`i']
		local CBREAKS "`CBREAKS' `CB'"
	}
	local CBREAKS "`CBREAKS' `VMAX'"
}

/* Equal interval method */
if "`clmethod'" == "eqint" {
	local INTERVAL = (`VMAX' - `VMIN') / `NC'
	local CBREAKS "`VMIN'"
	forval i = 1 / `=`NC'-1' {
		local CB = `: word `i' of `CBREAKS'' + `INTERVAL'
		local CBREAKS "`CBREAKS' `CB'"
	}
	local CBREAKS "`CBREAKS' `VMAX'"
	qui gen _class = .
	local LOWER : word 1 of `CBREAKS'
	local UPPER : word 2 of `CBREAKS'
	qui replace _class = 1 if inrange(float(_attribute), float(`LOWER'), float(`UPPER'))
	forval ii = 3 /`= `NC' + 1' {
		local i = `ii' - 1
		local LOWER : word `i' of `CBREAKS'
		local UPPER : word `ii' of `CBREAKS'
		qui replace _class = `i' if float(_attribute)>float(`LOWER') & float(_attribute)<=float(`UPPER')
	}
}

/* Standard deviation method */
if "`clmethod'"=="stdev" {
	qui su _attribute
	local VMEAN = r(mean)
	local VSD   = r(sd)
	if `NC' == 2 local CBLIST "`VMIN' `VMEAN' `VMAX'"
	if `NC' > 2 {
		local LIM  "0.6 1.0 1.2 1.6 2.0 1.8 2.1"
		local WID "1.2 1.0 0.8 0.8 0.8 0.6 0.6"
		local K=`NC'-2
		local L : word `K' of `LIM'
		local W : word `K' of `WID'
		numlist "-`L'(`W')`L'"
		local NLIST "`r(numlist)'"
		local CBLIST "`VMIN'"
		forval i = 1/`=`NC'-1' {
			local CB = `: word `i' of `NLIST''*`VSD'+`VMEAN'
			local CBLIST "`CBLIST' `CB'"
		}
		local CBLIST "`CBLIST' `VMAX'"
	}
	qui gen _class = .
	local LOWER : word 1 of `CBLIST'
	local UPPER : word 2 of `CBLIST'
	qui replace _class = 1 if inrange(float(_attribute), float(`LOWER'), float(`UPPER'))
	forval ii = 3 / `= `NC' + 1' {
		local i = `ii' - 1
		local LOWER : word `i' of `CBLIST'
		local UPPER : word `ii' of `CBLIST'
		qui replace _class = `i' if float(_attribute)>float(`LOWER') & float(_attribute)<=float(`UPPER')
	}
	local CBREAKS ""
	forval i = 1/`=`NC'+1' {
		local CB : word `i' of `CBLIST'
		if `CB' < `VMIN' local CB = `VMIN'
		if `CB' > `VMAX' local CB = `VMAX'
		local CBREAKS "`CBREAKS'`CB' "
	}
}

/* Custom class breaks */
if "`clmethod'" == "custom" {
	local CBREAKS "`clbreaks'"
	qui gen _class = .
	local LOWER : word 1 of `CBREAKS'
	local UPPER : word 2 of `CBREAKS'
	qui replace _class = 1 if inrange(float(_attribute), float(`LOWER'), float(`UPPER'))
	forval ii = 3 / `= `NC' + 1' {
		local i = `ii' - 1
		local LOWER : word `i' of `CBREAKS'
		local UPPER : word `ii' of `CBREAKS'
		qui replace _class = `i' if float(_attribute)>float(`LOWER') & float(_attribute)<=float(`UPPER')
	}
}

/* Unique values */
if "`clmethod'" == "unique" {
	qui egen _class = group(_attribute), label lname(_class)
}

/* Drop cases with missing class */
qui drop if missing(_class)




*  ----------------------------------------------------------------------------
*  6. Create list of units to be mapped                                        
*  ----------------------------------------------------------------------------

tempname UNITS
qui tab _id, matrow(`UNITS')
local N = r(r)

local INT = int(`N' / 50)
local MOD = mod(`N', 50)
local C = `INT' + 1
forval i = `INT'(-1)1 {
	local FROM = `N' - `MOD' - (`i' * 50) + 1
	local TO = (`N' - `MOD') / `i'
	local c = `INT' + 1 - `i'
	local INLIST`c' 
	forval j = `FROM' / `= `TO' -1' {
		local X = `UNITS'[`j',1]
		local INLIST`c' "`INLIST`c''`X',"
	}
	local X = `UNITS'[`TO',1]
	local INLIST`c' "`INLIST`c''`X'"
}
	
local FROM = (`INT' * 50) + 1
local TO = `N' - 1
local INLIST`C'
forval j = `FROM' / `TO' {
	local X = `UNITS'[`j',1]
	local INLIST`C' "`INLIST`C''`X',"
}
	
local X = `UNITS'[`N',1]
local INLIST`C' "`INLIST`C''`X'"




*  ----------------------------------------------------------------------------
*  7. Set colors                                                               
*  ----------------------------------------------------------------------------

if "`palette'" != "Custom" {
	tempname RGB
	matrix `RGB' = J(`NC',3,0)
	get_palette "`palette'" "`RGB'" `NC'
	forval i=1 / `NC' {
		local R = `RGB'[`i',1]
		local G = `RGB'[`i',2]
		local B = `RGB'[`i',3]
		local COLORS `"`COLORS' "`R' `G' `B'""'
	}
}
else if "`palette'" == "Custom" local COLORS `"`colors'"'




*  ----------------------------------------------------------------------------
*  8. Make up legend                                                           
*  ----------------------------------------------------------------------------

qui sort _class _attribute
qui gen temp1 = _n
by _class: gen temp2 = _n == 1
local KEYS 
local YES 
forval i = 1 / `N' {
	local X = temp1[`i'] * temp2[`i']
	if `X' > 0 local KEYS "`KEYS'`X' "
	local X = _class[`i'] * temp2[`i']
	if `X' > 0 local YES "`YES'`X' "
}

forval ii = 2 / `= `NC' + 1' {
	local i = `ii' - 1
	if "`clmethod'" != "unique" {
		local LOWER : word `i' of `CBREAKS'
		local UPPER : word `ii' of `CBREAKS'
		local LOWER = string(`LOWER', "`legformat'")
		local UPPER = string(`UPPER', "`legformat'")
		if `i' == 1 {
			local RANGE `"`RANGE'`"[`LOWER',`UPPER']"' "'
		}
		else if `i' > 1 {
			local RANGE `"`RANGE'`"(`LOWER',`UPPER']"' "'
		}
	}
	else if "`clmethod'"=="unique" {
		local LBL : label (_class) `i'
		local RANGE `"`RANGE'"`LBL'" "'
	}
}

local w = 1
forval i = 1 / `NC' {
	local Y : list i in YES
	if `Y' == 1 {
		local K : word `w' of `KEYS'
		local R : word `i' of `RANGE'
		local LABEL `"`LABEL'lab(`K' `"`R'"') "'
		local w = `w' + 1
	}
}

local BOX = cond("`legbox'" == "", "none", "0 0 0") 
	
if "`legtitle'" != "" local TITLE `"subtitle("`legtitle'", size(*0.5))"'

if "`legend'" == "" {
	local LEGEND `"legend( cols(1) order(`KEYS') `LABEL' size(*0.5)"'
	local LEGEND `"`LEGEND' region(lc("`BOX'") fc(none)) `TITLE'"'
	local LEGEND `"`LEGEND' symy(1.7) symx(3) keygap(1) rowgap(0.5) forces"'
	local LEGEND `"`LEGEND' ring(0) position(`legpos') )"'
}
else local LEGEND "legend(off)"

tempname ID
qui mkmat _id _class, matrix(`ID')




*  ----------------------------------------------------------------------------
*  9. Draw map                                                                 
*  ----------------------------------------------------------------------------

/* Calculate plot region */
qui use `"`map'"', clear
forval c = 1 / `= `C' - 1' {
	local INLIST "`INLIST'inlist(_ID,`INLIST`c'') | "
}
qui keep if `INLIST' inlist(_ID,`INLIST`C'')

su _Y, meanonly 
local ymin = r(min)
local ymax = r(max)
su _X, meanonly
local xmin = r(min)
local xmax = r(max)
local JY = (`ymax' - `ymin') * 0.03
local JX = (`xmax' - `xmin') * 0.03
local ymin = `ymin' - `JY'
local ymax = `ymax' + `JY'
local xmin = `xmin' - `JX'
local xmax = `xmax' + `JX'
local RATIO = (`ymax' - `ymin') / (`xmax' - `xmin')
local YS = 4
local XS = 4 / `RATIO'

/* Draw map */
local OS "`osize'"
forval i = 1 / `N' {
	local U = `ID'[`i',1]
	local C = `ID'[`i',2]
	local FC : word `C' of `COLORS'
	local OC "`ocolor'"
   if "`OC'" == "none" local OC "`FC'*0.8"
   local GRAPHS "`GRAPHS'(area _Y _X if _ID==`U', nodropbase blc("`OC'") blw(`OS') bfc("`FC'")) "
}

cap graph twoway `GRAPHS', ysize(`YS') xsize(`XS')                    ///
          yscale(r(`ymin' `ymax') off) xscale(r(`xmin' `xmax') off)   ///
	       ylabel(`ymin' `ymax') xlabel(`xmin' `xmax')                 ///
        	 ytitle("") xtitle("")                                       ///
	       plotregion(style(none)) scheme(s1mono) `LEGEND' `options' 

if _rc {
	di as err "{p}invalid syntax{p_end}"
	exit _rc 
}




*  ----------------------------------------------------------------------------
*  10. End program                                                             
*  ----------------------------------------------------------------------------

restore
end




*  ----------------------------------------------------------------------------
*  A1. Subprogram -get_palette-                                                
*  ----------------------------------------------------------------------------

program get_palette
version 8.2
args PALETTE RGB NC


preserve
qui { 
	cap findfile "colorschemes.dta"
	use `"`r(fn)'"', clear
	keep if scheme == "`PALETTE'" & classnum == `NC'
	mkmat rgb*, matrix(`RGB')
} 	
restore


end