*! version 1.2.4  TJS  31aug98  STB-46 gr33
program define violin
	version 5.0

	local varlist "req ex min(1)"
	local if      "opt"
	local in      "opt"
	local weight  "fweight aweight"
	#delimit ;
	local options "N(integer 50) Width(real 0.0) TRUncat(str)
		BIweight COSine EPan GAUss RECtangle PARzen TRIangle
		BY(str) Gap(integer 0) ROund(real 0.0) SAving(str)
		B2title(str) *" ;
	#delimit cr

	parse "`*'"
	parse "`varlist'", parse(" ")

* trap bad options
	if index("`options'","tr") > 0 {
		di in re "option tr ambiguous, " _c
		error 199
	}

	if "`b2title'" != "" {
		di in bl "b2title not allowed; option ignored."
	}

* -> Kernel Density code stolen from kdensity.ado
	local kflag = ( ("`epan'"  != "") + ("`biweigh'" != "") + /*
			   */ ("`triangl'" != "") + ("`gauss'"   != "") + /*
			   */ ("`rectang'" != "") + ("`parzen'"  != "") )
	if `kflag' > 1 {
		di in red "specify only one kernel"
		exit 198
	}

	if "`biweigh'"       != "" { local kernel = "Biweight"     }
	else if "`cosine'"   != "" { local kernel = "Cosine"       }
	else if "`triangl'"  != "" { local kernel = "Triangle"     }
	else if "`gauss'"    != "" { local kernel = "Gaussian"     }
	else if "`rectang'"  != "" { local kernel = "Rectangular"  }
	else if "`parzen'"   != "" { local kernel = "Parzen"       }
	else                       { local kernel = "Epanechnikov" }

	tempvar use
	quietly {
		mark `use' [`weight'`exp'] `if' `in'
		markout `use' `varlist'
		count if `use'
	}
	if _result(1) == 0 { error 2000 }

	if "`by'" != "" {
		confirm var `by'
		unabbrev `by'
		local by $S_1
	}

	if "`if'" != "" {ifexp "`if'"}

	preserve   /* Note: data preserved here */

	keep `by' `varlist' `use'
	local n1 = `n' + 1
	local n2 = `n' * 2 + 1
	if `n2' > _N { qui set obs `n2' }

* Generate BY groups
	tempvar kk byg bylabel
	sort `use' `by'
	qui by `use' `by': gen byte `byg' = _n == 1 if `use'
	if "`by'" != "" { qui gen `kk' = _n if `byg' == 1 }
	qui replace `byg' = sum(`byg')

	if "`by'" != "" {
		local byn = `byg'[_N]
		sort `kk'
		if `use'[`byn'] == . { local byn = `byn' - 1}
	}
	else { local byn = 1 }

* Generate `by' labels -- if required
	if "`by'" != "" {
		capture decode `by', gen(`bylabel')
		if _rc != 0 {
			local type : type `by'
			qui gen `type' `bylabel' = `by'
		}
	}

	tempname t2flg b1flg
	global t2flg = 0
	global b1flg = 0

* Do calculations
* get # of vars
	local i 1
	while "``i''" != "" {
		local i = `i' + 1
	}
	local nvars = `i' - 1
	if `nvars' > 1 & "`by'" != "" {
		di in red "by() cannot be used with /*
			*/ multi-variable varlist"
		exit
	}

* Note: `k' loops over multiple individual variables
*       `j' loops over the levels of a -by- variable

	local k 1
  while "``k''" != "" {
	local ix "``k''"
	local ixl: variable label ``k''
	if "`ixl'" == "" | `nvars' > 1 { local ixl "``k''" }

	local j = 1
  while `j' <= `byn' {  /* start of loop for each `by' group */
	if "`by'" != "" {
		sort `kk'
		local byl : di "`by': " `bylabel'[`j']
	}

* boxplot stats
	qui centile `ix' if `use' & `byg' == `j', c(25 50 75)
	local q25 = $S_7
	local q50 = $S_8
	local q75 = $S_4
* compute additional boxplot info
	tempvar xi
	local uav = `q75' + 1.5 * (`q75' - `q25')
	qui egen `xi' = max(`ix') /*
		*/ if `ix' <= `uav' & `use' & `byg' == `j'
	local uav = `xi'
	drop `xi'
	local lav = `q25' - 1.5 * (`q75' - `q25')
	qui egen `xi' = min(`ix') /*
		*/ if `ix' >= `lav' & `use' & `byg' == `j'
	local lav = `xi'
	drop `xi'

	if `j' == 1 {
		quietly summ `ix' [`weight'`exp'] if `use', detail
		local ismin = _result(5)
		local ismax = _result(6)
		if "`by'" != "" {
			local isn  = _result(1)
			local ismn = _result(5)
			local ismx = _result(6)
			local ism  = _result(10)
			local is25 = _result(9)
			local is75 = _result(11)
			local iss  = 0
			local isw  = 0
		}
	}

	if `j' == 1 & "`by'" != "" {
		if `width' <= 0 {
			tempname wwidth
			local ismin = `ism'
			local ismax = `ism'
			local jj 1
			while `jj' <= `byn' {
				quietly summ `ix' [`weight'`exp'] /*
					*/ if `use' & `byg' == `jj', detail
				scalar `wwidth' = 0.9 * min(sqrt(_result(4)), /*
					*/ (_result(11) - _result(9)) / 1.349)    /*
					*/ / (_result(1)^.2)
				local ismin = min(`ismin', _result(5) - `wwidth')
				local ismax = max(`ismax', _result(6) + `wwidth')
				local jj = `jj' + 1
			}
		}
		else {
			local ismin = `ismn' - `width'
			local ismax = `ismx' + `width'
		}
	}

	quietly summ `ix' [`weight'`exp'] if `use' & `byg' == `j', detail
	local ixmin = _result(5)
	local ixmax = _result(6)
	local ixn   = _result(1)
	if `gap' == 0 { local gp = 1 + max( /*
		*/ length(string(round(`ixmin',    `round'))), /*
		*/ length(string(round(_result(10),`round'))), /*
		*/ length(string(round(`ixmax',    `round')))) }
	else { local gp = `gap' }

	tempname wwidth
	scalar `wwidth' = `width'
	if `wwidth' <= 0.0 {
		scalar `wwidth' = 0.9 * min(sqrt(_result(4)),(_result(11)  /*
			*/  - _result(9)) / 1.349) / (_result(1)^.2)
	}
	local ww = `wwidth'

	tempvar d m
	qui gen double `d' = .
	qui gen double `m' = .

	kd `ix' `d' `m' `use' `byg' [`weight'`exp'], n(`n')  /*
		*/  ww(`ww') j(`j') `biweight' `cosine' `epan'   /*
		*/ `gauss' `rectangle' `parzen' `triangle'
	
	label var `d' "density"
	label var `m' "`ixl'"

* truncat option
	if "`truncat'" != "" {
		if "`truncat'" == "*" {
			local tn = `ixmin'
			local tx = `ixmax'
		}
		else {
			quietly summ `m' [`weight'`exp'] if `use', detail
			local ismn = _result(5)
			local ismx = _result(6)
			local nc 1
			while `nc' > 0 {
				local nc = index("`truncat'",",")
				if `nc' > 0 { local truncat = substr("`truncat'",1, /*
					*/ `nc' - 1) + " " + substr("`truncat'",`nc' + 1,.) }
			}
			local tn: word 1 of `truncat'
			local tx: word 2 of `truncat'
			local tn = real("`tn'")
			local tx = real("`tx'")
			if `tn' > `ismn' { local tn = min(`tn',`ixmin') }
			if `tx' < `ismx' { local tx = max(`tx',`ixmax') }
		}
		qui replace `m' = . if `m' < `tn' | `m' > `tx'
	}
	qui summ `d' in 1/`n'
	local scale = 1 / (`n' * _result(3))
	qui replace `d' = `d' * `scale' in 1/`n'

	local n21 = `n' * 2 + 1
	qui replace `d' = -`d'[`n21' - _n] in `n1'/`n2'
	qui replace `m' =  `m'[`n21' - _n] in `n1'/`n2'
	qui replace `d' =  `d'[1] in `n2'
	qui replace `m' =  `m'[1] in `n2'

	if "`truncate'" != "" {
		tempvar tm1 tm2
		qui gen `tm2' = _n
		qui gen `tm1' = sign(`d')
		gsort -`tm1' `m'
		local tm = `m'[1]
		local td = `d'[1]
		sort `tm2'
		qui replace `d' = `td' in `n2'
		qui replace `m' = `tm' in `n2'
	}

	if "`by'" != "" {
		local iss = `iss' + `scale'
		local isw = `isw' + `wwidth'
	}

* saving option
	if `j' * `k' == 1 & "`saving'" != "" {
		local c  = index("`saving'",",")
          local cs " "
		if index("`saving'",", ") != 0 { local cs "" }
		if `c' != 0 { local saving = substr("`saving'",1,`c' - 1) /*
			*/  + "`cs'" + substr("`saving'",`c' + 1, .) }
		local savfile : word 1 of `saving'
		local replace : word 2 of `saving'
		if "`replace'" == "replace" { capture erase "`savfile'.gph" }
		capture confirm new file "`savfile'.gph"
		if _rc == 0 { local saving ", saving(`savfile')" }
		else {
			local rc = _rc
			di in re "file `savfile'.gph exists."
			di in bl "use another filename or add 'replace' option."
			exit `rc'
		}
	}

	if "`byl'" != "" { local bylbyl byl("`byl'") }

     tempname ixlixl
     global ixlixl "`ixl'"

* do plot
	if `j' * `k' == 1 { gph open `saving' }
	viogph `d' `m', j(`j') k(`k') byn(`byn') ixmin(`ixmin')      /*
	*/	ixmax(`ixmax') q50(`q50') ismin(`ismin') ismax(`ismax')  /*
	*/	nvars(`nvars') gp(`gp') `bylbyl' uav(`uav') lav(`lav')   /*
	*/	q75(`q75') q25(`q25') rou(`round') `options'

	if `j' >= `byn' & `k' >= `nvars' { gph close }

* display stats
	if `byn' == 1 {
		di _n in gr "Statistics for ``k'':"
		di    in gr "  LAV: " in ye `lav' _c
		di    in gr "  Q25: " in ye `q25' _c
		di    in gr "  Q75: " in ye `q75' _c
		di    in gr "  UAV: " in ye `uav'
		di    in gr "  Min: " in ye `ixmin' _c
		di    in gr "  Median: " in ye `q50' _c
		di    in gr "  Max: " in ye `ixmax' _c
		di    in gr "  n: " in ye `ixn'
		di _n in gr "For ``k'', density computed using:"
		di    in gr "  Kernel: " in ye "`kernel'" _c
		di    in gr "  N: " in ye `n' _c
		di    in gr "  Scale: " in ye %6.2f `scale' _c
		di    in gr "  Width: " in ye %6.2f `wwidth'
	}
	local j = `j' + 1
  }       /* end of loop for each `by' group */

	if "`by'" != "" {
		di _n in gr "Statistics (all groups combined): "
		di    in gr "  Min: " in ye `ismn' _c
		di    in gr "  Q25: " in ye `is25' _c
		di    in gr "  Median: " in ye `ism' _c
		di    in gr "  Q75: " in ye `is75' _c
		di    in gr "  Max: " in ye `ismx' _c
		di    in gr "  n: " in ye `isn'
		di _n in gr "Densities computed using:"
		di    in gr "  Kernel: " in ye "`kernel'" _c
		di    in gr "  N: " in ye `n' _c
		di    in gr "  Ave. Scale: " in ye %6.2f `iss' / `byn' _c
		di    in gr "  Ave. Width: " in ye %6.2f `isw' / `byn'
		local scale  = `iss' / `byn'
		local wwidth = `isw' / `byn'
		local ixmin  = `ismn'
		local lav    = .
		local q25    = `is25'
		local q50    = `ism'
		local q75    = `is25'
		local uav    = .
		local ixmax  = `ismx'
		local ixn    = `isn'
	}
	local k = `k' + 1
}
* save globals
	global S_1    "`kernel'"
	global S_2  = `n'
	global S_3  = `wwidth'
	global S_4  = `scale'
	global S_5  = `ixmin'
	global S_6  = `lav'
	global S_7  = `q25'
	global S_8  = `q50'
	global S_9  = `q75'
	global S_10 = `uav'
	global S_11 = `ixmax'
	global S_12 = `ixn'

     macro drop ixlixl b1flg t2flg
end


program define viogph
	version 5.0

	local varlist "req ex min(2) max(2)"
	#delimit ;
	local options "J(int 1) K(int 1) BYN(int 1) TItle(str) B1title(str)
		IXMIN(real 0.0) IXMAX(real 0.0) Q50(real 0.0) ISMIN(real 0.0)
		ISMAX(real 0.0) NVARS(int 0) GP(int 3) BYL(str) UAV(real 0.0)
		LAV(real 0.0) Q75(real 0.0) Q25(real 0.0) Pen(str) Symbol(str)
		Connect(str) T1title(str) T2title(str) YLAbel(str) YSCale(str)
		ROUnd(real 0.0) *" ;
	#delimit cr

	parse "`*'"
	parse "`varlist'", parse(" ")

	local d "`1'"
	local m `2'

	local t2t2 = $t2flg
	local b1b1 = $b1flg
     local ixl = "$ixlixl"

* set up the plot

	if "`pen'"     == "" { local pen "2" }
	if "`symbol'"  == "" { local symbol "i" }
	if "`connect'" == "" { local connect "l" }

	if `j' == 1 & `k' == 1 {
          if "`t1title'" == "." { local t1title t1t(" ") }
		else if "`t1title'" == "" { local t1title t1t(Violin Plot) }
		else { local t1title t1t("`t1title'") }
		if `byn' > 1 { local t1title t1t("`ixl'") }
	}
	if `j' > 1 | `k' > 1 { local t1title t1t(" ") }

	if `j' == 1 & `k' == 1 {
		if "`t2title'" != "" {
			local t2title t2t("`t2title'")
			local t2t2 1
		}
	}
	else if `t2t2' == 1 { local t2title t2t(" ") }

	if "`title'" == "" { local title "`b1title'" }
     if "`title'" != "" {
		local b1title b1t(" ")
		local b1b1 1
	}

	if "`ylabel'" == "" { local yl = "yla(" /*
		*/  + string(round(`ixmin',`round')) + "," /*
		*/  + string(round(`q50',`round'))   + "," /*
		*/  + string(round(`ixmax',`round')) + ")" }
	else { local yl yla(`ylabel') }
	if index("`options'","yla") > 0 { local yl "" }

	if "`yscale'" == "" { local ys ysc(`ismin',`ismax') }
	else { local ys ysc(`yscale') }

* do plot

*  draw density traces
	local pw = min(.33, 1 / (`byn' * `nvars') )
	local pw = 32000 * `pw'
	local p1 = (`j' * `k' - 1) * `pw'
	local p2 = `p1' + `pw'
	#delimit ;
	graph `m' `d', bbox(0,`p1',23063,`p2',923,444,0) s(`symbol')
	  c(`connect') pe(`pen') `t1title' `yl' gap(`gp') `ys' `t2title'
	  `b1title' b2t(" ") `options' ;
	#delimit cr
	tempname ysca yloc xloc
	scalar `ysca'  = _result(5)
	scalar `yloc'  = _result(6)
	scalar `xloc'  = _result(8)
*  draw label
	local r1 = 20700
	local r2 = 21700
	local c1 = 21500
	if `b1b1' == 1 {
		local r1 = `r1' - 1000
		local r2 = `r2' - 1000
		local c1 = `c1' - 1000
	}
	gph clear `r1' `p1' `r2' `p2'
	gph pen 1
	local xlo = `xloc'
	if `byn' == 1 { gph text `c1' `xlo' 0 0 `ixl' }
	else { gph text `c1' `xlo' 0 0 `byl' }
* do title
     if "`title'" != "" {
		gph font 1300 650
		gph text 22100 10 0 -1 `title'
		gph font 923 444
	 } 
*  draw adjacent values line
	local r1 = `uav' * `ysca' + `yloc'
	local r2 = `lav' * `ysca' + `yloc'
	local c1 = `xloc'
	local c2 = `c1'
	gph pen `pen'
	gph line `r1' `c1' `r2' `c2'
*  draw quartile box (shaded)
	local r1 = `q75' * `ysca' + `yloc'
	local r2 = `q25' * `ysca' + `yloc'
	local c1 = -250 + `xloc'
	local c2 =  250 + `xloc'
	gph box `r1' `c1' `r2' `c2' 1
*  draw median
	local r1 = `q50' * `ysca' + `yloc' + 100
	local r2 = `q50' * `ysca' + `yloc' - 100
	local c1 = -500 + `xloc'
	local c2 =  500 + `xloc'
	gph box `r1' `c1' `r2' `c2' 0

	global t2flg = `t2t2'
	global b1flg = `b1b1'
end


program define kd
	version 5.0
* -> Kernel Density code stolen from kdensity.ado

	local varlist "req ex min(1) max(5)"
	local weight  "fweight aweight"
	#delimit ;
	local options "N(integer 50) WW(real 0.0) J(int 1)
		BIweight COSine EPan GAUss RECtangle PARzen TRIangle" ;
	#delimit cr

	parse "`*'"
	parse "`varlist'", parse(" ")

	local ix  "`1'"
	local d   "`2'"
	local m   "`3'"
	local use "`4'"
	local byg "`5'"

	tempvar y z
	qui gen double `y' = .
	qui gen double `z' = .

	tempname delta wid wwidth
	scalar `wwidth' = `ww'
	scalar `delta'  = (_result(6) - _result(5) + 2 * `wwidth') /*
			*/ / (`n' - 1)
	scalar `wid'    = _result(1) * `wwidth'
	qui replace `m' = _result(5) - `wwidth' + (_n - 1) /*
			*/ * `delta' in 1/`n'

	local i 1
	if "`biweigh'" != "" {
		local con1 = .9375
		while `i' <= `n' {
			qui replace `z' = (`ix' - `m'[`i']) / (`wwidth') /*
				*/ if `use' & `byg' == `j'
			qui replace `y' = `con1' * (1 - (`z')^2)^2   /*
				*/ if abs(round(`z',1e-8)) < 1
			qui summ `y' [`weight'`exp'] if `y' != .
			qui replace `d' = (_result(3) * _result(1)) / `wid' in `i'
			qui replace `y' = .
			local i = `i' + 1
		}
		qui replace `d' = 0 if `d' == . in 1/`n'
	}
	else if "`cosine'" != "" {
		while `i' <= `n' {
			qui replace `z' = (`ix' - `m'[`i']) / (`wwidth') /*
				*/ if `use' & `byg' == `j'
			qui replace `y' = 1 + cos(2 * _pi * `z') /*
				*/ if abs(round(`z',1e-8)) < 0.5
			qui summ `y' [`weight'`exp'] if `y' != .
			qui replace `d' = (_result(3) * _result(1)) / `wid' in `i'
			qui replace `y' = .
			local i = `i' + 1
		}
		qui replace `d' = 0 if `d' == . in 1/`n'
	}
	else if "`triangl'" != "" {
		while `i' <= `n' {
			qui replace `z' = (`ix' - `m'[`i']) / (`wwidth') /*
				*/ if `use' & `byg' == `j'
			qui replace `y' = 1 - abs(`z') if abs(round(`z',1e-8)) < 1
			qui summ `y' [`weight'`exp'] if `y' != .
			qui replace `d' = (_result(3) * _result(1)) / `wid' in `i'
			qui replace `y' = .
			local i = `i' + 1
		}
		qui replace `d' = 0 if `d' == . in 1/`n'
	}
	else if "`parzen'" != "" {
		local con1 = 4 / 3
		local con2 = 2 * `con1'
		while `i' <= `n' {
			qui replace `z' = (`ix' - `m'[`i']) / (`wwidth') /*
				*/ if `use' & `byg' == `j'
			qui replace `y' = `con1' - 8 * (`z')^2 + 8 * abs(`z')^3 /*
				*/ if abs(round(`z',1e-8)) <= .5
			qui replace `y' = `con2' * (1 - abs(`z'))^3 /*
				*/ if abs(round(`z',1e-8)) > .5 /*
				*/  & abs(round(`z',1e-8)) < 1

			qui summ `y' [`weight'`exp'] if `y' != .
			qui replace `d' = (_result(3) * _result(1)) / `wid' in `i'
			qui replace `y' = .
			local i = `i' + 1
		}
		qui replace `d' = 0 if `d' == . in 1/`n'
	}
	else if "`gauss'" != "" {
		local con1 = sqrt(2 * _pi)
		while `i' <= `n' {
			qui replace `z' = (`ix' - `m'[`i']) / (`wwidth') /*
				*/ if `use' & `byg' == `j'
			qui replace `y' = exp(-0.5 * ((`z')^2)) / `con1'
			qui summ `y' [`weight'`exp']
			qui replace `d' = (_result(3) * _result(1)) / `wid' in `i'
			local i = `i' + 1
		}
		qui replace `d' = 0 if `d' == . in 1/`n'
	}
	else if "`rectang'" != "" {
		while `i' <= `n' {
			qui replace `z' = (`ix' - `m'[`i']) / (`wwidth') /*
				*/ if `use' & `byg' == `j'
			qui replace `y' = 0.5 if abs(round(`z',1e-8)) < 1
			qui summ `y' [`weight'`exp'] if `y' != .
			qui replace `d' = (_result(3) * _result(1)) / `wid' in `i'
			qui replace `y' = .
			local i = `i' + 1
		}
		qui replace `d' = 0 if `d' == . in 1/`n'
	}
	else {
		local con1 = 3 / (4 * sqrt(5))
		local con2 = sqrt(5)
		while `i' <= `n' {
			qui replace `z' = (`ix' - `m'[`i']) / (`wwidth') /*
				*/ if `use' & `byg' == `j'
			qui replace `y' = `con1' * (1 - ((`z')^2 / 5)) /*
				*/  if abs(round(`z',1e-8)) <= `con2'
			qui summ `y' [`weight'`exp'] if `y' != .
			qui replace `d' = (_result(3) * _result(1)) / `wid' in `i'
			qui replace `y' = .
			local i = `i' + 1
		}
		qui replace `d' = 0 if `d' == . in 1/`n'
	}
end