You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

615 lines
17 KiB
Plaintext

*! 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