*! STB-version 1.0.0 AA 7aug1998       STB-46 gr32
* graphs confidence ellipse using parametric formula in Douglas (1993)
program define ellip
 version 5.0
 local cmd "`*'"
 local varlist "req ex min(1) max(2)"
 local if "opt"
 local in "opt"
 local options ", Level(int $S_level) Generate(str) Add(str)"
 local options "`options' Pool(int -1) FYvar(str) FXvar(str)"
 local options "`options' Connect(str) SYmbol(str) SAving(str) *"
 capt parsoptp
 if _rc ~= 199 {                         /* IF PARSOPTP IS INSTALLED */        
    parsoptp title `cmd'                 /* parsoptp optname pstring */                       
    local title "$S_2"                   /* title(str) matched on () */
    local cmd "$S_3"                 /* cmd, with title(str) removed */
    parsoptp t1title `cmd'                       
    local t1title "$S_2"               
    local cmd "$S_3"                
    parsoptp t2title `cmd'                         
    local t2title "$S_2"               
    local cmd "$S_3" 
    parsoptp r1title `cmd'                         
    local r1title "$S_2"               
    local cmd "$S_3"
    parsoptp r2title `cmd'                         
    local r2title "$S_2"               
    local cmd "$S_3"                         
    parsoptp b1title `cmd'                      
    local b1title "$S_2"               
    local cmd "$S_3"                      
    parsoptp b2title `cmd'                           
    local b2title "$S_2"                   
    local cmd "$S_3"              
    parsoptp l1title `cmd'              
    local l1title "$S_2"                    
    local cmd "$S_3"              
    parsoptp l2title `cmd'              
    local l2title "$S_2"                   
    local cmd "$S_3"
 }
 else {                              /* IF PARSOPTP IS NOT INSTALLED */                
     di in bl "Install -parsoptp- (STB-40) if you need titles with ()"
     local options "`options' T1title(str) T2title(str) R1title(str)"
     local options "`options' R2title(str) B1title(str) B2title(str)"
     local options "`options' L1title(str) L2title(str) TItle(str)"
 }
 parse "`cmd'"  
 parse "`varlist'", parse(" ")                    /* LOW-LEVEL PARSE */ 
 if "$S_E_cmd" ~= "fit" {                           /* VERIFY SYNTAX */                
     di in red "Previous command must be fit"
     error 301
 }     
 if `level' < 10 | `level' > 99 {                   
     di in red "level() must be an integer between 10 and 99"
     exit _rc
 }
 if "`generate'" == "" & "`add'" ~= "" {
     di in red "add() must be used with generate()"
     exit _rc
 }
 if `pool' == -1 { local pool "" }          /* pool() has no default */
 else local pool "`pool'"
 if "`pool'" ~= "" {  
     capture which gphdt
     if _rc ~= 0 {
         di in re "pool() must have gphdt.ado installed"
         exit _rc
     } 
     capture confirm int `pool'      
     capture assert `pool' >= 1 & `pool' <= 100    
     if _rc ~= 0 {
         di in red "pool() must be an integer BETWEEN 1 and 100"
         exit _rc
     }
     if "`if'" == "" & "`in'" == "" {
         di in red "pool() must be used with [if exp] or [in range]"
         exit 198
     }
     if "`add'" == "" {  
         di in red "pool() must be used with add()"
         exit _rc
     } 
     confirm new variable _merge
     if _rc~=0 {
         di in red "_merge already defined, drop before running ellip"
         exit _rc
     }    
 } 
 tempfile orig new tmp
 tempvar touse theta new1 new2 old1 old2 yy xx id tmpy tmpx
 tempname F
 mark `touse' `if' `in'                   /* identify ellipse sample */
 markout `touse' `fitlist'
 local y `1'
 local x `2'
 if "`x'" == "" {
     local x "_cons"
 }
 else {
     local x `2'
 }
 local b1 "_b[`y']"
 local b2 "_b[`x']"
 local s1 "_se[`y']"
 local s2 "_se[`x']"
 local fitlist $S_E_vl                    /* varlist saved after fit */
 if "`t1title'" == "" { local t1title " " } 
 if "`t2title'" == "" { local t2title " " }
 if "`l1title'" == "" { local l1title "Estimated `y'" }
 if "`b2title'" == "" { local b2title "Estimated `x'" } 
 if "`title'" ~= "" { local b1title "`title'" }   /* ti overrides b1 */ 
 if "`connect'" ~= "" { local connect "connect(`connect')" }
 if "`symbol'" ~= "" { local symbol "symbol(`symbol')" } 
 if "`saving'" ~= "" { local saving "saving(`saving')" } 
 set textsize 125
 
 if "`generate'" ~= "" {                            /* PARSE OPTIONS */
     parse "`generate'", parse(" ")
     capture confirm new variable `generate' 
     if _rc ~= 0 {
         di in red "generate() must specify two NEW variables"
         error 198
     } 
     local n : word count `generate'
     if `n' ~= 2 {
         di in re "generate() must specify TWO new variables"    
         error 198
     }
     local new1 "`1'"
     local new2 "`2'"
 }
 if "`add'" ~= "" {
     parse "`add'", parse(" ")
     confirm variable `add'
     capture confirm new variable `add'
     if _rc == 0 {
         di in re "add() must specify two EXISTING variables"
         exit 198
     }
     local n : word count `add'
     if `n' ~= 2 {
         di in re "add() must specify TWO existing variables" 
         error 198
     }
     local old1 "`1'"
     local old2 "`2'"
     if "`connect'" == "" { local connect "c(ll)" }
     if "`symbol'" == "" { local symbol "s(..)" }
 }
 else {
     if "`connect'" == "" { local connect "c(l)" }
     if "`symbol'" == "" { local symbol "s(.)" }
 }
 qui gen `tmpy' = 0
 qui gen `tmpx' = 0 
 qui save "`orig'"                 /* temporarily save original data */
 preserve                                  /* PRESERVE ORIGINAL DATA */
         
 qui range `theta' 0 2*_pi 400          /* CREATE CONFIDENCE ELLIPSE */
 qui reg, level(`level')                       /* n - k = _result(5) */
 scalar `F' = invfprob(2, _result(5), (100-`level')/100) /* always 2 */
 qui cor, _coef                        /* = _result(4) */
 qui gen `new1' = `b1' + `s1'*sqrt(2*`F')*cos(`theta'+acos(_result(4)))
 label variable `new1' " "
 qui gen `new2' = `b2' + `s2'*sqrt(2*`F')*cos(`theta')
 label variable `new2' " "  
 if "`fyvar'" ~= "" { format `new1' `fyvar' }
 if "`fxvar'" ~= "" { format `new2' `fxvar' }   
 if "`generate'" == "" {                                 /* NO gen() */ 
     gra `new1' `new2', `connect' `symbol' t1("`t1title'") /*
     */ t2("`t2title'") r1("`r1title'") r2("`r2title'") /*
     */ b1("`b1title'") b2("`b2title'") l1("`l1title'") /*
     */ l2("`l2title'") ti("`title'") `options' `saving'
 }
 else {                                                   /* GEN() */
     if "`add'"=="" {
         gra `new1' `new2', `connect' `symbol' t1("`t1title'") /*
         */ t2("`t2title'") r1("`r1title'") r2("`r2title'") /*
         */ b1("`b1title'") b2("`b2title'") l1("`l1title'") /*
         */ l2("`l2title'") ti("`title'") `options' `saving' 
         restore, not                                          
     }
     else {                                           /* GEN() ADD() */
         qui save "`new'"                  /* temporarily save gen() */
         qui stack `new1' `new2' `old1' `old2', into(`yy' `xx') clear
         qui gen `new1' = `yy' if _stack==1        /* (obs 001-400) */
         qui gen `old1' = `yy' if _stack==2        /* (obs 401-800) */ 
         qui keep `new1' `old1' `xx'               /*    >= 800 obs */         
         if "`fyvar'" ~= "" { format `new1' `old1' `fyvar' }
         if "`fxvar'" ~= "" { format `xx' `fxvar' }        
         label variable `new1' " "
         label variable `old1' " "
         label variable `xx' " "
         qui gen long `id' = _n
         sort `id'
         qui save "`tmp'"                     /* save genadd data */                   
         if "`pool'" == "" { 
             gra `new1' `old1' `xx', `connect' `symbol' /*
             */ t1("`t1title'") t2("`t2title'") r1("`r1title'") /*
             */ r2("`r2title'") b1("`b1title'")  b2("`b2title'") /*
             */ l1("`l1title'") l2("`l2title'") ti("`title'") /*
             */ `options' `saving'
         }
         else {                                /* GEN() ADD() POOL() */
             local i = 0
             while `i' <= `pool' {  /* create files wt0,...,wt`pool' */            
                 use "`orig'", clear                 
                 capture {      
                     qui gen iwt`i' = 1 if `touse'==1
                 }
                 if _rc {
                     di in re "the variable _iwt`i' is already defined"
                     exit 110
                 }
                 qui replace iwt`i' = [`i']/`pool' if `touse'==0
                 qui reg `fitlist' [iw=iwt`i'], level(`level') noheader
                 qui replace `tmpy' = `b1'
                 qui replace `tmpx' = `b2'
                 qui keep iwt`i' `tmpy' `tmpx'
                 qui keep in l/l
                 tempfile wt`i'
                 qui save "`wt`i''"
                 local i = `i' + 1
             }       
             use "`wt0'", clear              
             local i = 1
             while `i' <= `pool' { /* combine into one wt`pool' file */
                 append using "`wt`i''"
                 local i = `i' + 1
             }  
             qui egen iweight = rsum(iwt0-iwt`pool')
             drop iwt0-iwt`pool'                           
             qui gen long `id' = _n
             sort `id' 
             qui save "`wt`pool''", replace        /* save locus curve */                  
             merge `id' using "`tmp'"        /* merge with gen() add() */  
             gph open, `saving'                     /* low-level graph */        
             gra `new1' `old1' `xx', `connect' `symbol' ti("`title'") /*
                 */ t1("`t1title'") t2("`t2title'") r1("`r1title'") /*
                 */ r2("`r2title'") b1("`b1title'") b2("`b2title'") /*
                 */ l1("`l1title'") l2("`l2title'") `options'
             gphsave      
             local end = `pool' + 1
             local y_b = `tmpy' in 1/1                /*  b(y;_) dot */
             local y_bp = `tmpy' in `end'/`end'       /* bp(y;_) dot */
             local x_b = `tmpx' in 1/1                /*  b(_;x) dot */
             local x_bp = `tmpx' in `end'/`end'       /* bp(_;x) dot */
             qui gphdt text `y_b' `x_b' 0 1 b 
             qui gphdt text `y_bp' `x_bp' 0 1 bp
             qui gphdt vline `tmpy' `tmpx' in 1/`end' 
             qui gphdt vpoint `tmpy' `tmpx' in 1/`end'
             gph close
             qui keep if iweight ~= .                  
             rename `tmpy' `y'      
             di                                     /* display table */
             di in gr "The Fractionally Pooled Estimates"
             di in gr "(i.e., the dots in the locus curve):" 
             if "`x'" == "_cons" {
                 rename `tmpx' constant    /* _cons is reserved name */
                 tabdisp iweight, cell(`y' constant) center                
             }
             else {
                 rename `tmpx' `x'
                 tabdisp iweight, cell(`y' `x') center
             }                     
         }
         use "`new'", clear 
         restore, not                      /* permanently save gen() */             
     }
 }
end
exit

Known problems and potential solutions:
1. pool() is slow.
      Use explicit subscripting and the prefix -by groupvar: <command>- 
      instead of -while- (looping over observations) and -egen()-?
2. Stata cannot easily obtain overlaying images.  
      Use -for- and -gph ..., bbox- rather than -stack-? 
3. pool() has a table display but cannot use the reserved name _cons.
      Use -display- (for programmers)?
4. Is there a need for multiple imaging with a by(groupvar) option?
      As of now, you can combine saved graphs with -graph using...-.
5. Cannot create temporary iwt`i' (not merely indicator variables)?
      It seems not to matter for ellip with temporary files.