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.

626 lines
20 KiB
Plaintext

7 months ago
*! 1.4.1 NJC 16 May 1999
* 1.4.0 NJC 19 March 1999
* Mike Bradburn unearthed bug marked `MB'
* 1.3.0 NJC 31 March 1998
* Fred Wolfe unearthed bugs and suggested features marked `FW'
* 1.2.0 NJC 17 June 1997
program define hplot
version 6.0
#delimit ;
syntax varlist(numeric) [if] [in]
[, BOrder SOrt(string) noXaxis noYaxis PEn(string) Symbol(string)
T1title(string) T2title(string) TItle(string) TTIck XLAbel(numlist)
XLIne(numlist) XSCale(str) XTIck(numlist) Axtol(int 600) Blank flipt
Format(string) FONTC(int 290) FONTR(int 570) FONTCB(int 444)
FONTRB(int 923) GAPMag(real 1) GAPs(numlist int) GLegend(string)
GLLJ GLPOS(int -1) t2m(int 0) Grid LAP Legend(string) LIne NIT2
t1m(int 0) PTSize(int 275) Range TIM(int 0) Vat VATFmt(string)
VATPos(int 31500) Cstart(int -1) SAving(string) PENText(int 1) ] ;
#delimit cr
qui {
tempvar touse order gleg gap dmin dmax dneg dpos z
mark `touse' `if' `in'
Markout2 `touse' `varlist'
gen `order' = _n
gsort - `touse' `sort' `order'
count if `touse'
loc nuse = r(N)
* legend on left
if "`legend'" == "" {
tempvar legend
g str1 `legend' = " "
if "`blank'" == "" {
replace `legend' = string(_n) if `touse'
}
}
else {
confirm variable `legend'
capture confirm string variable `legend'
if _rc == 7 {
tempvar legend2
capture decode `legend', g(`legend2')
if _rc {
gen str1 `legend2' = ""
replace `legend2' = string(`legend')
}
else {
replace `legend2' = string(`legend') /*
*/ if missing(`legend2')
}
loc legend "`legend2'"
}
}
loc leglen : type `legend'
loc leglen = substr("`leglen'",4,.)
if `cstart' == -1 {
loc cstart = 2000 + int(9000 * `leglen' / 25)
}
* axis scale
if "`xscale'" != "" {
tokenize "`xscale'", parse(",")
if "`4'" != "" | "`2'" != "," {
di in r "invalid xscale( ) option"
exit 198
}
loc xscmin `1'
loc xscmax `3'
}
if "`xscmin'" == "" { loc min 0 }
else loc min `xscmin'
if "`xscmax'" == "" { loc max 0 }
else loc max `xscmax'
* xlabel xtick xline might extend graph range beyond data range
if "`xlabel'`xtick'`xline'" != "" {
numlist "`xlabel' `xtick' `xline'", sort
loc nn : word count `r(numlist)'
loc xmin : word 1 of `r(numlist)'
loc xmax : word `nn' of `r(numlist)'
loc min = min(`min', `xmin')
loc max = max(`max', `xmax')
}
* gap legend?
g str1 `gleg' = " "
loc glj = cond("`gllj'" != "", -1, 1)
if "`glegend'" != "" {
tokenize "`glegend'", parse("!")
loc j 1
while "`1'" != "" {
if "`1'" != "!" {
if "`1'" == "." { loc 1 " " }
loc gleg`j' "`1'"
loc j = `j' + 1
}
mac shift
}
}
* gaps between lines?
g byte `gap' = 0
if "`gaps'" != "" {
loc j 1
numlist "`gaps'", int range(>=0)
tokenize `r(numlist)'
while "`1'" != "" {
if "`1'" == "0" {
loc gleg0 "`gleg`j''"
if "`gleg0'" == "" { loc gleg0 " " }
}
else {
replace `gap' = 1 in `1' if `1' <= `nuse'
replace `gleg' = "`gleg`j''" in `1' if `1' <= `nuse'
}
loc j = `j' + 1
mac shift
}
}
count if `gap'
loc ngaps = r(N) + ("`gleg0'" != "")
* data range
tokenize `varlist'
loc nvars : word count `varlist'
g `dmin' = `1'
g `dmax' = `1'
if `nvars' >= 2 {
loc i 2
while `i' <= `nvars' {
replace `dmin' = min(`dmin', ``i'')
replace `dmax' = max(`dmax', ``i'')
loc i = `i' + 1
}
}
su `dmin' if `touse', meanonly
loc min = min(`min', r(min))
su `dmax' if `touse', meanonly
loc max = max(`max', r(max))
loc drange = `max' - `min'
loc zero = cond(`min' >= 0, max(0,`min'), min(0,`max'))
g `z' = `zero'
g `dneg' = min(`dmin', `z')
g `dpos' = max(`dmax', `z')
}
* start of parameter block
loc t1start 1000 /* row for t1title */
loc t2start 1900 /* row for t2title */
loc ybeg 2400 /* start of y-axis */
loc ylength 17600
* `axtol' is space at ends of y-axis
* axtol too large => ystep negative FW
if `axtol' > `ylength' / 2 {
di in bl "axtol too large: reset to default 600"
loc axtol 600
}
* row where first line starts
loc ystart = `ybeg' + `axtol'
* step between lines: one gap defaults to one line
loc ystep = /*
*/ (`ylength' - 2 * `axtol')/(`nuse' - 1 + `ngaps' *`gapmag')
loc yend = `ybeg' + `ylength'
loc ynudge = 200 * (`fontr'/570)^2
/* text displaced downwards from lines */
loc ytick 400 /* tick length */
loc yleg 1000 /* labels down from axis */
loc yleg = `yend' + `yleg'
loc ytitle 1400 /* title down from labels */
loc ytitlef 900 /* title down from labels, flip titles */
loc xstart `cstart' /* col where first line begins */
loc xgap 400 /* gap between left legend and body of plot */
loc xbeg = `xstart' - `xgap'
if `glpos' == -1 { loc glpos `xbeg' }
loc xlength = 30000 - `xstart'
/* horizontal extent of data region */
loc xend = `xbeg' + `xgap' + `xlength'
loc xz = /*
*/ `xbeg' + `xgap' + `xlength' * (`zero' - `min') / `drange'
loc mcent = (`cstart' + 30000)/2 + `tim'
/* col where main title centred */
loc dotsp 150 /* spacing between dots */
if "`format'" == "" { loc format "%1.0f" }
if "`vatfmt'" == "" { loc vatfmt "%1.0f" }
loc ahl = 500 * `ptsize'/275 /* arrowhead length */
loc aha = _pi/6 /* arrowhead angle, between head and stem */
loc barht `ahl' /* bar height */
if "`symbol'" == "" {
if `nvars' < 6 { loc symbol "46253" }
else loc symbol : di _dup(`nvars') "4"
}
else if length("`symbol'") == 1 & `nvars' > 1 {
loc symbol : di _dup(`nvars') "`symbol'"
}
Gphtrans `symbol'
loc symbol "`r(symbol)'"
if "`pen'" == "" { loc pen : di _dup(`nvars') "2" }
else if length("`pen'") == 1 & `nvars' > 1 {
loc pen : di _dup(`nvars') "`pen'"
}
* end of parameter block
* start gph
if "`saving'" != "" { loc saving ", saving(`saving')" }
gph open `saving' /* FW */
gph pen `pentext'
gph font `fontr' `fontc'
* y-axis
if "`yaxis'" == "" { gph line `ybeg' `xstart' `yend' `xstart' }
* ttick => top ticks
loc ttick = "`ttick'" == "ttick"
* ttick should => border FW
if `ttick' { loc border "border" }
* x-axis and labels
if "`xaxis'" == "" {
gph line `yend' `xstart' `yend' `xend'
loc ytick2 = `ybeg' - `ytick'/2
loc ytick = `yend' + `ytick'
if "`xlabel'" == "" {
gph line `yend' `xstart' `ytick' `xstart'
gph line `yend' `xend' `ytick' `xend'
if `ttick' {
gph line `ybeg' `xstart' `ytick2' `xstart'
gph line `ybeg' `xend' `ytick2' `xend' /* FW */
}
loc text = cond("`lap'" == "lap", abs(`min'), `min')
loc text : di `format' `text'
gph text `yleg' `xstart' 0 0 `text'
loc text = cond("`lap'" == "lap", abs(`max'), `max')
loc text : di `format' `text'
gph text `yleg' `xend' 0 0 `text'
}
else {
numlist "`xlabel'"
tokenize `r(numlist)'
while "`1'" != "" {
loc xtickp = /*
*/ `xbeg' + `xgap' + `xlength' * (`1' - `min')/`drange'
gph line `yend' `xtickp' `ytick' `xtickp'
if `ttick' {
gph line `ybeg' `xtickp' `ytick2' `xtickp'
}
loc text = cond("`lap'" == "lap", abs(`1'), `1')
loc text : di `format' `text'
gph text `yleg' `xtickp' 0 0 `text'
mac shift
}
}
}
* x-ticks
if "`xtick'" != "" {
numlist "`xtick'"
tokenize `r(numlist)'
while "`1'" != "" {
loc xtickp = /*
*/ `xbeg' + `xgap' + `xlength' * (`1' - `min')/`drange'
gph line `yend' `xtickp' `ytick' `xtickp'
if `ttick' {
gph line `ybeg' `xtickp' `ytick2' `xtickp'
}
mac shift
}
}
* x-lines
if "`xline'" != "" {
numlist "`xline'"
tokenize `r(numlist)'
while "`1'" != "" {
loc xli = /*
*/ `xbeg' + `xgap' + `xlength' * (`1' - `min')/`drange'
gph line `yend' `xli' `ybeg' `xli'
mac shift
}
}
* border
if "`border'" != "" {
gph line `ybeg' `xstart' `ybeg' `xend'
gph line `ybeg' `xend' `yend' `xend'
if "`xaxis'" != "" { gph line `yend' `xstart' `yend' `xend' }
}
* gap legend above first data point
if "`gleg0'" != "" {
loc y2 = `ystart' + (`gapmag' - 1) * `ystep' + `ynudge'
gph text `y2' `glpos' 0 `glj' `gleg0'
}
* for each variable
tokenize `varlist'
loc j 1
while "`1'" != "" {
loc data "`1'"
loc sy = substr("`symbol'",`j',1)
loc pe = substr("`pen'",`j',1)
loc y `ystart'
if "`gleg0'" != "" { loc y = `y' + `ystep' * `gapmag' }
* for each observation
loc i 1
while `i' <= `nuse' {
* dots and/or lines
if `j' == 1 {
if "`range'" == "range" {
/* MB: next statement needed because largest value
could be negative, of course! */
loc xmax = `xbeg' + `xgap' + /*
*/ `xlength' * (`dmax'[`i'] - `min') / `drange'
loc xmin = `xbeg' + `xgap' + /*
*/ `xlength' * (`dmin'[`i'] - `min') / `drange'
loc xz `xmin'
}
else {
loc xmax = `xbeg' + `xgap' + /*
*/ `xlength' * (`dpos'[`i'] - `min') / `drange'
loc xmin = `xbeg' + `xgap' + /*
*/ `xlength' * (`dneg'[`i'] - `min') / `drange'
}
if "`line'" == "line" {
gph line `y' `xmax' `y' `xz'
gph line `y' `xmin' `y' `xz'
}
if "`grid'" == "" {
loc xdot `xz'
loc ndots = int(abs(`xmax' - `xz') / `dotsp')
loc idot 1
while `idot' <= `ndots' {
gph point `y' `xdot' `ptsize' 0
if "`range'" == "range" {
loc xdot = `xdot' + `dotsp'
}
else loc xdot = /*
*/ `xdot' + `dotsp' * sign(`dpos'[`i'])
loc idot = `idot' + 1
}
loc xdot `xz'
loc ndots = int(abs(`xmin' - `xz') / `dotsp')
loc idot 1
while `idot' <= `ndots' {
gph point `y' `xdot' `ptsize' 0
loc xdot = `xdot' + `dotsp' * sign(`dneg'[`i'])
loc idot = `idot' + 1
}
}
else {
loc xdot `xstart'
while `xdot' < `xend' {
gph point `y' `xdot' `ptsize' 0
loc xdot = `xdot' + `dotsp'
}
}
}
* data point
gph pen `pe'
loc x = `xbeg' + `xgap' + /*
*/ `xlength' * (`data'[`i'] - `min') / `drange'
if `data'[`i'] < . & "`sy'" != "i" {
if "`sy'" == "a" {
if `j' == 1 { loc sign 1 }
else loc sign = sign(`data'[`i'] - `prev'[`i'])
Gphhah `y' `x' `sign' `ahl' `aha'
}
else if "`sy'" == ">" { Gphhah `y' `x' 1 `ahl' `aha' }
else if "`sy'" == "<" { Gphhah `y' `x' -1 `ahl' `aha' }
else Gphpt `sy' `y' `x' `barht' `ptsize'
}
* text
gph pen `pentext'
loc y2 = `y' + `ynudge'
if "`vat'" != "" & `nvars' == 1 {
loc text : di `vatfmt' `data'[`i']
gph text `y2' `vatpos' 0 1 `text'
}
if `j' == 1 {
loc text = `legend'[`i']
gph text `y2' `xbeg' 0 1 `text'
}
* gap
if `gap'[`i'] {
loc y = `y' + `ystep' * `gapmag'
if `j' == 1 {
loc text = `gleg'[`i']
loc y2 = `y' + `ynudge'
gph text `y2' `glpos' 0 `glj' `text'
}
}
loc y = `y' + `ystep'
loc i = `i' + 1
}
* next observation
loc prev `1'
loc j = `j' + 1
mac shift
}
* next variable
* t2title, left justified (defaults to key for 2 or more variables)
if "`t2title'" != "" & trim("`t2title'") == "" {
loc t2title
}
else if "`t2title'" != "" {
gph text `t2start' `xstart' 0 -1 `t2title'
}
else if `nvars' >= 2 {
loc t2 = `t2start' - `ynudge'
loc xjump = `xlength' / `nvars'
loc xjump2 = `xjump' / 50
loc x = `xstart' + `xjump2' + `t2m'
loc j 1
while `j' <= `nvars' {
loc sy = substr("`symbol'",`j',1)
loc pe = substr("`pen'",`j',1)
gph pen `pe'
if "`sy'" == "a" {
loc ahv = index("`symbol'","a")
if `ahv' > 1 {
loc this : word `ahv' of `varlist'
loc ahvm1 = `ahv' - 1
local prev : word `ahvm1' of `varlist'
count if `this' >= `prev' & `touse'
loc majsign = cond(r(N) > `nuse'/2, 1, -1)
}
else loc majsign 1
loc x3 = `x' + 0.6 * `ptsize' * `majsign'
Gphhah `t2' `x3' `majsign' `ahl' `aha'
}
else if "`sy'" == ">" {
loc x3 = `x' + 0.6 * `ptsize'
Gphhah `t2' `x3' 1 `ahl' `aha'
}
else if "`sy'" == "<" {
loc x3 = `x' - 0.6 * `ptsize'
Gphhah `t2' `x3' -1 `ahl' `aha'
}
else if "`sy'" != "i" {
Gphpt `sy' `t2' `x' `barht' `ptsize'
}
loc x2 = `x' + `xjump2'
loc var : word `j' of `varlist'
if "`nit2'" == "" {
loc text : variable label `var'
if "`text'" == "" { loc text "`var'" }
}
else loc text "`var'"
gph pen `pentext'
gph text `t2start' `x2' 0 -1 `text'
loc x = `x' + `xjump'
loc j = `j' + 1
}
}
* title and t1title
if "`title'" == "" & `nvars' == 1 {
loc title : variable label `data'
if "`title'" == "" { loc title "`data'" }
}
else if "`title'" != "" & trim("`title'") == "" { loc title }
loc xL = `xstart' + `t1m'
if "`flipt'" == "" { /* default */
* t1title, left justified
gph text `t1start' `xL' 0 -1 `t1title'
* main title at bottom, centred
gph font `fontrb' `fontcb'
loc ytitle = `yleg' + `ytitle'
gph text `ytitle' `mcent' 0 0 `title'
}
else { /* flip titles from default */
* bottom title, centred (and closer to axis than default)
loc ytitle = `yleg' + `ytitlef'
gph text `ytitle' `mcent' 0 0 `t1title'
* main title at top, left justified
gph font `fontrb' `fontcb'
gph text `t1start' `xL' 0 -1 `title'
}
gph close
end
program define Gphhah /* horizontal arrow head */
* `1' y position of tip
* `2' x position of tip
* `3' sign determines direction: 1 = >, -1 = <
* `4' arrowhead length
* `5' arrowhead interior angle (between shaft and head)
* 1.0.1 NJC 18 February 1999
* 1.0.0 NJC 27 May 1997
version 6.0
loc ah1y = `1' - `3' * `4' * sin(`5')
loc ah1x = `2' - `3' * `4' * cos(`5')
loc ah2y = `1' + `3' * `4' * sin(`5')
loc ah2x = `2' - `3' * `4' * cos(`5')
gph line `ah1y' `ah1x' `1' `2'
gph line `ah2y' `ah2x' `1' `2'
end
program define Gphbar /* vertical bar */
* Gphbar yposition xposition bar_height
* 1.0.1 NJC 18 February 1999
* 1.0.0 NJC 27 May 1997
version 6.0
loc by1 = `1' - 0.5 * `3'
loc by2 = `1' + 0.5 * `3'
gph line `by1' `2' `by2' `2'
end
program define Gphcross /* cross X */ /* FW */
* Gphcross yposition xposition bar_height
* 1.0.1 NJC 18 February 1999
* 1.0.0 NJC 6 October 1997
version 6.0
loc Xy1 = `1' - 0.5 * `3'
loc Xy2 = `1' + 0.5 * `3'
loc Xx1 = `2' - 0.5 * `3'
loc Xx2 = `2' + 0.5 * `3'
gph line `Xy1' `Xx1' `Xy2' `Xx2'
gph line `Xy2' `Xx1' `Xy1' `Xx2'
end
program def Markout2 /* marks out obs with all missing values */
* 1.0.2 NJC 16 February 1999
* 1.0.1 NJC 25 March 1998
version 6.0
syntax varlist(min=1) [, Strok ]
tokenize `varlist'
loc nvars : word count `varlist'
if `nvars' == 1 { exit 0 }
loc nvars = `nvars' - 1
loc markvar `1'
mac shift
tempvar nmiss
gen `nmiss' = 0
qui {
while "`1'" != "" {
loc type : type `1'
if substr("`type'",1,3) == "str" {
if "`strok'" != "" {
replace `nmiss' = `nmiss' + (`1' == "")
}
else replace `nmiss' = `nmiss' + 1
}
else replace `nmiss' = `nmiss' + (`1' == .)
mac shift
}
replace `nmiss' = `nmiss' == `nvars'
replace `markvar' = 0 if `nmiss'
}
end
program def Gphtrans, rclass /* transliterate ".OSTodp" -> "0123456" */
* 1.0.2 NJC 1 March 1999
* 1.0.0 NJC 31 March 1998
version 6.0
args argin
loc length = length("`argin'")
loc i 1
while `i' <= `length' {
loc s = substr("`argin'", `i', 1)
if "`s'" == "." { loc s 0 }
else if "`s'" == "O" { loc s 1 }
else if "`s'" == "S" { loc s 2 }
else if "`s'" == "T" { loc s 3 }
else if "`s'" == "o" { loc s 4 }
else if "`s'" == "d" { loc s 5 }
else if "`s'" == "p" { loc s 6 }
loc argout "`argout'`s'"
loc i = `i' + 1
}
return loc symbol `argout'
end
program def Gphpt
* 1.2.2 NJC 24 February 1999 smaller big cross, bigger ,
* 1.2.1 NJC 18 February 1999
* 1.2.0 NJC 12 Jan 1999
* 1.1.0 NJC 24 Sept 1998
* 1.0.0 NJC 6 April 1998
version 6.0
args sy y x barht ptsize
if "`sy'" == "|" { Gphbar `y' `x' `barht' }
else if "`sy'" == "," { Gphbar `y' `x' 0.6*`barht' }
else if "`sy'" == "X" { Gphcross `y' `x' 0.707*`barht' }
else if "`sy'" == "x" { Gphcross `y' `x' 0.5*`barht' }
else if "`sy'" == "-" { Gphhbar `y' `x' 0.5*`barht' }
else gph point `y' `x' `ptsize' `sy'
end
program define Gphhbar /* horizontal bar */
* Gphhbar yposition xposition bar_length
* 1.0.1 NJC 18 February 1999
* 1.0.0 NJC 24 Sept 1998
version 6.0
loc bx1 = `2' - 0.5 * `3'
loc bx2 = `2' + 0.5 * `3'
gph line `1' `bx1' `1' `bx2'
end