*! arcplot v1.3 (31 Mar 2024)
*! Asjad Naqvi (asjadnaqvi@gmail.com)

* v1.3 (31 Mar 2024): See below for v1.3
* v1.2 (16 Feb 2023): Major speed improvements through a flat structure
* v1.1 (18 Nov 2022): Several bug fixes. Improvements to code. Gtools added.
* v1.0 (22 Jun 2022): First beta release

/* TO DO
 Collapse option: threshold(real 0)
 colorprop and labprop to scale colors and labels
*/

**********************************
* Step-by-step guide on Medium   *
**********************************

* if you want to go for even more customization, you can read the Arcplots (6 Oct 2021) guide:
* https://medium.com/the-stata-guide/stata-graphs-arc-plots-eb87015510e6


cap program drop arcplot


program arcplot, sortpreserve

version 15

	syntax varlist(min=1 max=1 numeric) [if] [in], From(varname) To(varname) 			  								///
		[ gap(real 2) ARCPoints(real 100) palette(string) LColor(string) LWidth(string) alpha(real 50) format(str)  ]	///
		[ VALGap(str) VALSize(string) VALAngle(string) VALColor(string) VALPos(string)  VALCONDition(real 0)		]  	///
		[ LABGap(str) LABSize(string) LABAngle(string) LABColor(string) LABPos(string)  							]  	///
		[ sort(string) BOXWIDth(string) BOXINTensity(real 0.7) offset(real 0) aspect(real 0.5) *  ]     // v1.3


	// check dependencies
	capture findfile colorpalette.ado
	if _rc != 0 {
		display as error "The {bf:palettes} package is missing. Click to install: {stata ssc install palettes, replace:palettes} and {stata ssc install colrspace, replace:colrspace}."
		exit
	}

	capture findfile gtools.ado
	if _rc != 0 {
		display as error "The {bf:gtools} package is missing. Click to install: {stata ssc install gtools, replace:gtools}."
		exit
	}


	marksample touse, strok

preserve
qui {

	keep if `touse'

	keep `varlist' `from' `to'

	drop if `varlist' < 0
	drop if `varlist' ==.



	// drop unmarked entries
	cap confirm numeric `from'
	if _rc {
		drop if `from'==""
	}
	else {
		drop if `from'==.
	}

	cap confirm numeric `to'
	if _rc {
		drop if `to'==""
	}
	else {
		drop if `to'==.
	}


	// rename for consistency
	cap ren `from' lab1
	cap ren `to'   lab2



	collapse (sum) `varlist', by(lab1 lab2)

	sort lab2 lab1

	gen id = _n


	greshape long lab, i(id) j(layer)

	*replace lab1 = "Other" if `varlist' <= `threshold'
	*replace lab2 = "Other" if `varlist' <= `threshold'


	if "`sort'" == "name" {
		sort lab layer `varlist'
		gen _sum = 1
	}
	if "`sort'" == "value"  | "`sort'" == "" {

		bysort lab: egen _sum = sum(`varlist')

	}

	gsort -_sum lab layer -value

	egen tag = tag(lab)
	gen lab2 = sum(tag)
	labmask lab2, val(lab)

	*encode lab, gen(lab2)

	gsort lab2 layer -value

	bysort lab2: gen order = _n


	expand 2 if tag==1, gen(tag2)
	replace `varlist' = 0 if tag2==1 // duplicate entries are labeled as zero
	replace order = 0 if tag2==1
	replace id    = 0 if tag2==1

	*sort lab2 layer order
	drop tag tag2


	// generate cumulative values
	sort lab2 layer order
	bysort lab2: gen double valsum = sum(`varlist')


	gen double valsumtot = sum(`varlist')
	sort lab2 layer order



	// add gaps between arcs
	egen gap = group(lab2)


	summ valsumtot, meanonly
	replace gap = (gap - 1) * r(max) * (`gap' / 100)
	gen double valsumtotg = valsumtot + gap



	gen _y = 0

	sum valsumtotg, meanonly
	gen double _x = valsumtotg / r(max)


	// get the spikes
	sort id layer _x

	gen double _x1 = .
	gen double _y1 = .

	gen double _xsplit = .
	gen double _ysplit = .

	gen double _x2 = .
	gen double _y2 = .

	egen tag = tag(lab)



	levelsof lab2, local(lvls)

	foreach x of local lvls {
		summ _x if lab2==`x', meanonly
		replace _x1 = r(min) if lab2==`x' & tag==1
		replace _x2 = r(max) if lab2==`x' & tag==1

		summ _x if lab2==`x' & layer==1, meanonly
		replace _xsplit = r(max) if lab2==`x' & tag==1
	}


	replace _y1 	= 0 if tag==1
	replace _ysplit = 0 if tag==1
	replace _y2 	= 0 if tag==1

	gen double xmid = (_x1 + _x2) / 2
	gen double ymid = (_y1 + _y2) / 2



	***************************
	*** generate the arcs   ***
	***************************

	// set obs
	if _N < `arcpoints' {
		set obs `=`arcpoints' + 1'
	}
	else {
		local arcpoints  = `=_N - 1'
	}


	sort lab2 layer order
	levelsof id if layer==1 & order!=0, local(lvls)

	foreach x of local lvls {

		gen boxx`x' = _x if id==`x'
		gen boxy`x' = _y if id==`x'

		// layer 1
		gen     seq`x' = 1 if id==`x' & layer==1
		replace seq`x' = 2 if id==`x' & layer==2

		summ lab2  if id==`x' & layer==1, meanonly
		local labcat1 = r(mean)

		// start future block. these are used much later in the last step after reshape
		gen double from`x' = r(mean)		// from node

		summ `varlist' if id==`x' & layer==1, meanonly
		gen double fval`x' = r(mean)		// from value

		summ order if id==`x' & layer==1, meanonly
		local prel1 = `r(mean)' - 1

		// end future block here
		replace boxx`x' = _x if lab2==`labcat1' & order==`prel1'
		replace boxy`x' = _y if lab2==`labcat1' & order==`prel1'


		*** one more item for the future. the mid point for labels on the from values
		summ boxx`x' if layer==1, meanonly
		gen double fmid`x' = r(mean)

		// layer 2
		summ lab2  if id==`x' & layer==2, meanonly
		local labcat2 = r(mean)

		summ order if id==`x' & layer==2, meanonly
		local prel2 = `r(mean)' - 1

		replace boxx`x' = _x if lab2==`labcat2' & order==`prel2'
		replace boxy`x' = _y if lab2==`labcat2' & order==`prel2'


		replace seq`x' = seq`x'[_n+1] if seq`x'[_n+1]!=.
	}

		gen seq = _n
		local increment = _pi / `=`arcpoints' - 1'
		gen double t = `increment' * (seq - 1) in 1/`arcpoints'  // keep last observation free



		levelsof id if layer==1 & order!=0, local(lvls)

		foreach x of local lvls {

			//  calculate the mid point of each box

			summ boxx`x' if seq`x'==2, meanonly
				local xout1 = r(min)
				local  xin1 = r(max)

			summ boxx`x' if seq`x'==1, meanonly
				local xout2 = r(max)
				local  xin2 = r(min)


			local midx = (`xout1' + `xout2')/2
			local midy = 0


			gen double radius`x'_in  = sqrt((`xin1'  - `midx')^2 + (0 - `midy')^2)  in 1/`arcpoints'
			gen double radius`x'_out = sqrt((`xout1' - `midx')^2 + (0 - `midy')^2)  in 1/`arcpoints'

			gen double arcx_in`x'   = `midx' + radius`x'_in * cos(t) in 1/`arcpoints'
			gen double arcy_in`x'   = `midy' + radius`x'_in * sin(t) in 1/`arcpoints'

			gen double arcx_out`x'  = `midx' + radius`x'_out * cos(t) in 1/`arcpoints'
			gen double arcy_out`x'  = `midy' + radius`x'_out * sin(t) in 1/`arcpoints'

		}

		cap drop tag*
		egen tag = tag(_y _x)
		egen taglab = tag(ymid xmid)


		keep _y1 _x1 _xsplit _ysplit _y2 _x2 ymid xmid arc* from* layer `varlist' lab2 fval* fmid* seq
		greshape long arcx_in arcy_in arcx_out arcy_out from fval fmid, i(seq _x1 _y1 _x2 _y2 xmid ymid layer `varlist' lab2) j(num)

		ren arcx_in arcx1
		ren arcy_in arcy1

		ren arcx_out arcx2
		ren arcy_out arcy2

		greshape long arcx arcy, i(seq _x1 _y1 _xsplit _ysplit _x2 _y2 num lab2 layer `varlist') j(level)

		sort num level seq



		// control variables
		egen tag = tag(num)
		gen _y = 0 if tag==1


		*** order the layers

		gen order = .
		sort num level seq
		replace order = `arcpoints' + 1 - seq if level==1
		replace order = `arcpoints'     + seq if level==2


		cap drop tag2
		egen tag2 = tag(num ymid xmid)

		sort num level order


		*******************************
		*** put everything together	***
		*******************************


		if "`palette'" == "" {
			local palette tableau
		}
		else {
			tokenize "`palette'", p(",")
			local palette  `1'
			local poptions `3'
		}
		if "`lcolor'"      == "" local lcolor black
		if "`lwidth'"      == "" local lwidth none

		if "`labcolor'"    == "" local labcolor black
		if "`labangle'"    == "" local labangle 0
		if "`labgap'"      == "" local labgap 0.5
		if "`labpos'"      == "" local labpos 6
		if "`labsize'"     == "" local labsize 2

		if "`valangle'" == "" local valangle 90
		if "`valcolor'" == "" local valcolor none
		if "`valgap'"   == "" local valgap 2
		if "`valsize'"  == "" local valsize 1.2
		if "`valpos'"   == "" local valpos 12

		if "`boxwidth'"   == "" local boxwidth 1.6

		if "`format'" 	   == "" local format %15.0fc

		gen fval2 = string(fval, "`format'") if _y!=. & fval >= `valcondition'

		local spikes

		levelsof lab, local(lvls)
		local items = `r(r)'

		foreach x of local lvls {

			colorpalette `palette', n(`items') nograph `poptions'
			local spikes1 `spikes1' (pcspike _y1 _x1 _ysplit _xsplit if num==1 & lab==`x', lc( "`r(p`x')'") lwidth(`boxwidth'))



			colorpalette `palette', n(`items') intensity(`boxintensity') nograph  `poptions'
			local spikes2 `spikes2' (pcspike _ysplit _xsplit _y2 _x2 if num==1 & lab==`x', lc( "`r(p`x')'") lwidth(`boxwidth'))

		}

		local arcs

		levelsof from, local(lvls)
		local items = `r(r)'

		local i = 1

		foreach x of local lvls {

			colorpalette `palette', n(`items') nograph  `poptions'

			local arcs `arcs' (area arcy arcx if from==`x', cmissing(n) fi(100) fc( "`r(p`i')'%`alpha'") lw(`lwidth') lc(`lcolor')) ||

			local i = `i' + 1

		}


		local ystart  = 0 - (1 * (`offset' / 100))

		*** final graph

		twoway ///
			`arcs' ///
			`spikes1' ///
			`spikes2' ///
			(scatter ymid xmid if num==1 & tag2==1, mcolor(none) mlabsize(`labsize')  mlab(lab2) mlabpos(`labpos') mlabangle(`labangle') mlabgap(`labgap') mlabcolor(`labcolor') ) ///	                           ///
			(scatter _y fmid   if 		   tag2==1, mcolor(none) mlabsize(`valsize') mlab(fval2) mlabpos(`valpos') mlabangle(`valangle') mlabgap(`valgap') mlabcolor(`valcolor') ) ///
				, legend(off) ///
					ylabel(`ystart' 0.5, nogrid) xlabel(0 1, nogrid) aspect(`aspect')	///
					xscale(off) yscale(off)	`options'

	*/

}
restore

end



*********************************
******** END OF PROGRAM *********
*********************************