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.
219 lines
6.5 KiB
Plaintext
219 lines
6.5 KiB
Plaintext
10 months ago
|
*! baplot.ado version 1.21 written by PTS (p.seed@umds.ac.uk) (STB-55: sbe33)
|
||
|
|
*! Produces Bland-Altman plots for two variables
|
||
|
|
*! See Bland & Altman Lancet Feb 8 1986, pp 307-310
|
||
|
|
*!
|
||
|
|
*! syntax: baplot var1 var2 if in, symbol(symbol) format(%6.3f) avlab("Average") difflab("Difference") yline(str) textsize(#) other graph options
|
||
|
|
|
||
|
|
* Now allows choice of symbol, and extra ylines Feb 8 1996
|
||
|
|
* larger plotting symbols for overlapping points
|
||
|
|
* Silly comparisons taken out
|
||
|
|
|
||
|
|
|
||
|
|
cap prog drop baplot
|
||
|
|
prog define baplot
|
||
|
|
version 6.0
|
||
|
|
|
||
|
|
* set trace off
|
||
|
|
|
||
|
|
syntax varlist(min=2 max=2 numeric) [if] [in], /*
|
||
|
|
*/ [Symbol(string) format(string) avlab(string) difflab(string) /*
|
||
|
|
*/ novars noGRaph ci zero mean yline(string) diag saving(string) /*
|
||
|
|
*/ text(real 100) ratio(real 1) *]"
|
||
|
|
|
||
|
|
parse "`varlist'", parse(" ")
|
||
|
|
local m1 "`1'"
|
||
|
|
local m2 "`2'"
|
||
|
|
|
||
|
|
if "`symbol'" == "" { local symbol "o" }
|
||
|
|
if "`format'" == "" {local format "%6.3f" }
|
||
|
|
if "`saving'" ~= "" { local saving "saving(`saving')"}
|
||
|
|
if "`ci'" ~= "" {local mean = "mean" }
|
||
|
|
|
||
|
|
|
||
|
|
preserve
|
||
|
|
tempvar touse
|
||
|
|
mark `touse' `if' `in'
|
||
|
|
markout `touse' `m1' `m2'
|
||
|
|
qui keep if `touse'
|
||
|
|
|
||
|
|
tempvar av diff
|
||
|
|
if "`avlab'" == "" { local avlab "Average"}
|
||
|
|
if lower("`avlab'") == "nolab" { local avlab " "}
|
||
|
|
|
||
|
|
if "`difflab'" == "" { local difflab "Difference" }
|
||
|
|
if lower("`difflab'") == "nolab" { local difflab " "}
|
||
|
|
qui gen `av' = (`m1' + `m2')/2
|
||
|
|
qui gen `diff' = `m1' - `m2'
|
||
|
|
label var `av' "`avlab'"
|
||
|
|
label var `diff' "`difflab'"
|
||
|
|
|
||
|
|
qui summ `diff' if `touse'
|
||
|
|
local xbar = _result(3)
|
||
|
|
local sd = _result(4)^.5
|
||
|
|
local n = _result(2)
|
||
|
|
local se = `sd'/`n'^.5
|
||
|
|
local t = invt(_result(2)-1, .95)
|
||
|
|
local lrr = `xbar' - 2*`sd'
|
||
|
|
local urr = `xbar' + 2*`sd'
|
||
|
|
local min = _result(5)
|
||
|
|
local max = _result(6)
|
||
|
|
local lcb = `xbar' - `t'*`se'
|
||
|
|
local ucb = `xbar' + `t'*`se'
|
||
|
|
|
||
|
|
summ `av', meanonly
|
||
|
|
local xmin = _result(5)
|
||
|
|
local xmax = _result(6)
|
||
|
|
|
||
|
|
local yline "`lrr', `urr'"
|
||
|
|
if "`ci'" ~= "" {
|
||
|
|
local yline "`yline', `lcb', `ucb'"
|
||
|
|
}
|
||
|
|
if "`mean'" ~= "" | "`zero'" == "" {local yline "`yline', `xbar'"}
|
||
|
|
if "`zero'" ~= "" {local yline "`yline', 0"}
|
||
|
|
|
||
|
|
qui corr `av' `diff'
|
||
|
|
local r = _result(4)
|
||
|
|
local n = _result(1)
|
||
|
|
local sig = tprob(`n'-2, `r'*((`n'-2)/(1-`r'^2))^.5)
|
||
|
|
|
||
|
|
|
||
|
|
#delim ;
|
||
|
|
di in gr _n "Bland-Altman comparison of `m1' and `m2'";
|
||
|
|
di in gr "Limits of agreement (Reference Range for difference): " in ye `format' `lrr'
|
||
|
|
in gr " to " in ye `format' `urr' ;
|
||
|
|
di in gr "Mean difference: " in ye `format' `xbar'
|
||
|
|
in gr " (CI " in ye `format' `lcb'
|
||
|
|
in gr " to " in ye `format' `ucb'
|
||
|
|
in gr ") ";
|
||
|
|
di in gr "Range : " in ye `format' `xmin'
|
||
|
|
in gr " to " in ye `format' `xmax';
|
||
|
|
di in gr "Pitman's Test of difference in variance: r = " in ye `format' `r'
|
||
|
|
in gr ", n = " in ye `n'
|
||
|
|
in gr ", p =" in ye `format' `sig' ;
|
||
|
|
#delim cr
|
||
|
|
|
||
|
|
if "`vars'" ~= "" {
|
||
|
|
qui corr `m1' `m2', cov
|
||
|
|
local tau = _result(4)
|
||
|
|
qui summ `m1'
|
||
|
|
local err1 = _result(4) - `tau'
|
||
|
|
qui summ `m2'
|
||
|
|
local err2 = _result(4) - `tau'
|
||
|
|
di in gr "Estimated variance of true measure: " in ye `format' `tau'
|
||
|
|
di in gr "Estimated error variance (`1'): " in ye `format' `err1'
|
||
|
|
di in gr "Estimated error variance (`2'): " in ye `format' `err2'
|
||
|
|
di in gr "Very low or negative error variances may indiate that modelling assumptions are violated."
|
||
|
|
}
|
||
|
|
|
||
|
|
global S_1 `xbar'
|
||
|
|
global S_2 `lrr'
|
||
|
|
global S_3 `urr'
|
||
|
|
|
||
|
|
if "`graph'" == "" & "`diag'" == "" {
|
||
|
|
sort `diff' `av'
|
||
|
|
tempvar f n
|
||
|
|
qui by `diff' `av': gen `f' = _N if `diff' ~= . & `av' ~= .
|
||
|
|
qui by `diff' `av': gen `n' = _n if `diff' ~= . & `av' ~= .
|
||
|
|
graph `diff' `av' if `touse' & `n' == 1 [fw=`f'], symbol(`symbol') `xlabel' `ylabel' yline(`yline') `saving' `options'
|
||
|
|
}
|
||
|
|
|
||
|
|
else if "`diag'" ~= "" {
|
||
|
|
|
||
|
|
local nobs = _N + 1
|
||
|
|
qui set obs `nobs'
|
||
|
|
qui replace `m2' = 0 if `m2' == .
|
||
|
|
|
||
|
|
* loa
|
||
|
|
tempvar lb ub
|
||
|
|
qui gen `ub' = `m2' + `xbar' + 2*`sd'
|
||
|
|
qui replace `ub' = . if `ub' < 0
|
||
|
|
summ `ub', mean
|
||
|
|
qui replace `ub' = . if `ub' > _result(5) & `ub' < _result(6)
|
||
|
|
|
||
|
|
qui gen `lb' = `m2' + `xbar' - 2*`sd'
|
||
|
|
summ `lb', mean
|
||
|
|
if _result(5) < 0 {
|
||
|
|
qui replace `lb' = . if `lb' < 0
|
||
|
|
local nobs = _N + 1
|
||
|
|
qui set obs `nobs'
|
||
|
|
qui replace `lb' = 0 if _n == _N
|
||
|
|
qui replace `m2' = 2*`sd' - `xbar' if _n == _N
|
||
|
|
}
|
||
|
|
summ `lb', mean
|
||
|
|
qui replace `lb' = . if `lb' > _result(5) & `lb' < _result(6)
|
||
|
|
|
||
|
|
* ci
|
||
|
|
if "`ci'" ~= "" {
|
||
|
|
tempvar lci uci
|
||
|
|
qui gen `lci' = `m2' + `xbar' - invt(`n'-1,0.95)*`sd'/`n'^.5
|
||
|
|
qui gen `uci' = `m2' + `xbar' + invt(`n'-1,0.95)*`sd'/`n'^.5
|
||
|
|
summ `lci', mean
|
||
|
|
if _result(5) < 0 {
|
||
|
|
qui replace `lci' = . if `lci' < 0
|
||
|
|
local nobs = _N + 1
|
||
|
|
qui set obs `nobs'
|
||
|
|
qui replace `lci' = 0 if _n == _N
|
||
|
|
qui replace `m2' = invt(`n'-1,0.95)*`sd'/`n'^.5 - `xbar' if _n == _N
|
||
|
|
}
|
||
|
|
summ `uci', mean
|
||
|
|
if _result(5) < 0 {
|
||
|
|
qui replace `uci' = . if `uci' < 0
|
||
|
|
local nobs = _N + 1
|
||
|
|
qui set obs `nobs'
|
||
|
|
qui replace `uci' = 0 if _n == _N
|
||
|
|
qui replace `m2' = - invt(`n'-1,0.95)*`sd'/`n'^.5 - `xbar' if _n == _N
|
||
|
|
}
|
||
|
|
summ `lci', mean
|
||
|
|
qui replace `lci' = . if `lci' > _result(5) & `lci' < _result(6)
|
||
|
|
summ `uci', mean
|
||
|
|
qui replace `uci' = . if `uci' > _result(5) & `lci' < _result(6)
|
||
|
|
}
|
||
|
|
|
||
|
|
summ `m2' if `m2' ~= ., mean
|
||
|
|
tempvar diag
|
||
|
|
|
||
|
|
* zero
|
||
|
|
if "`zero'" ~= "" | "`mean'" == "" {
|
||
|
|
qui gen `diag' = `m2' if `m2' == _result(5) | `m2' == _result(6)
|
||
|
|
}
|
||
|
|
|
||
|
|
* mean
|
||
|
|
else {
|
||
|
|
qui gen `diag' = `m2' + `xbar' if `m2' == _result(5) | `m2' == _result(6)
|
||
|
|
summ `diag', mean
|
||
|
|
if _result(5) < 0 {
|
||
|
|
qui replace `diag' = . if `diag' < 0
|
||
|
|
local nobs = _N + 1
|
||
|
|
qui set obs `nobs'
|
||
|
|
qui replace `diag' = 0 if _n == _N
|
||
|
|
qui replace `m2' = - `xbar' if _n == _N
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sort `m1' `m2'
|
||
|
|
tempvar f n
|
||
|
|
qui by `m1' `m2': gen `f' = _N
|
||
|
|
qui by `m1' `m2': gen `n' = _n
|
||
|
|
|
||
|
|
if ("`xlabel'" == "" | "`ylabel'" == "") & index("`options'","xlab") == 0 & index("`options'","ylab") == 0 {
|
||
|
|
nicenum labels = 0 `m1' `m2'
|
||
|
|
local xlabel xlab($labels)
|
||
|
|
local ylabel ylab($labels)
|
||
|
|
}
|
||
|
|
|
||
|
|
local r_tx = int(923 * `text'/100)
|
||
|
|
local c_tx = int(444 * `text'/100)
|
||
|
|
local c_min = int(16000 - (23063*`ratio'/2))
|
||
|
|
local c_max = int(16000 + (23063*`ratio'/2))
|
||
|
|
di "bbox(0,`c_min',23063,`c_max',`r_tx',`c_tx',0) "
|
||
|
|
|
||
|
|
gph open, `saving'
|
||
|
|
graph `m1' `diag' `ub' `lb' `lci' `uci' `m2' if `n' == 1 [fw=`f'], /*
|
||
|
|
*/ `xlabel' `ylabel' s(oiiiii) c(.lllll) sort /*
|
||
|
|
*/ bbox(0,`c_min',23063,`c_max',`r_tx',`c_tx',0) `options'
|
||
|
|
gph close
|
||
|
|
}
|
||
|
|
|
||
|
|
end
|
||
|
|
exit
|