*! 4.2.0 Jan 03, 1997 Jeroen Weesie/ICS   STB-35:  sg66
*     -- added min(#) option  
*     -- fixed a bug in computating item-rest correlations  
*  4.1.0 12/05/96 jw/ics
*     -- added item-rest correlations
*     -- added variable labeled output
*  4.0.0 11/04/96 jw/ics
*     -- adopted to version 5.0
*     -- for efficiency : split computations for complete and incomple data
*     -- added computation of alpha-minus-item
*     -- added coo
*     -- adopted the help screen
*! 3.1.0 02/27/93 (StataCorp)

program define alpha2
    version 5.0

    local varlist "req ex min(2)"
    local if "opt"
    local in "opt"
    local options "Asis Coo Detail Gen(str) Item Label Min(int 1) Reverse(str) Std" 
    parse "`*'"
    
    parse "`varlist'", parse(" ")
    local k : word count `varlist'

    if `min' < 1 | `min' > `k' {
        di in re "invalid option -min-"
        exit 198
    }

  * scratch
  
    tempvar cnt nobs rest score test touse x 
    tempname ac acor alph av avar C mIIC MEAN nc ncor nv nvar Obs IRC ITC r VAR

/* begin */ quietly { 

  * select and count cases; treatment of missing values 
  *   N = #obs selected via if/in/min
  *  NC = #complete obs 

    mark `touse' `if' `in'
    if "`coo'" == "" & `min' < `k' {      /* incomplete cases allowed */
        egen `nobs' = robs(`varlist') if `touse'
        replace `touse' = (`nobs' != . & `nobs' >= `min')
        count if `touse'
        local N = _result(1)            /* # if in */
        count if `nobs'==`k' & `touse'
        local NC = _result(1)           /* # if in & complete */
    }
    else {                              /* only complete cases */    
        markout `touse' `varlist'
        count if `touse'
        local N = _result(1)
        local NC `N'
    }    


  * signs of variables sgn1, sgn2, ... 

    local i 1
    while `i' <= `k' {
        local sgn`i' 1
        local i = `i' + 1
    }

    if "`reverse'" != "" {
        unabbrev "`reverse'"
        local reverse "$S_1"
        parse "`reverse'", p(" ")
        local revlist
        while "`1'" != "" {
            listindx "`varlist'" "`1'"
            if $S_1 > 0  { 
                local sgn$S_1 -1 
                local revlist "`revlist' `1'"
            }
            else noisily di in bl "`1' is not included in varlist"
            mac shift
        }
        * the code below assumes parsing of the varlist
        parse "`varlist'", parse(" ")
    }
    else if "`asis'" == "" { 
        factor `varlist' if `touse'
        score `score'
        local i 1
        while `i' <= `k' {
            corr ``i'' `score' if `touse'
            if _result(4) < 0 { 
                local revlist "`revlist' ``i''"
                local sgn`i' -1
            }
            local i = `i' + 1
        }
    }
    
  * matrix C    = corr/cov for signed variables; 
  * matrix Obs  = pairwise number of non-missing cases  
  * matrix MEAN = unsigned means of variables 
  * matrix VAR  = variance of variables 
  * var cnt     = #non-mv's

    if `N' != `NC' {                    /* some cases contain missing values */

        mat `Obs'  = J(`k',`k',0)       
        mat `C'    = `Obs'              
        mat `MEAN' = J(1,`k',0)         
        mat `VAR'  = J(1,`k',0)         
        gen int `cnt' = 0               

        if "`std'" == "" { local coption "cov"  }
        local i 1
        while `i' <= `k' {
            summ ``i'' if `touse'
            mat `Obs'[`i',`i'] = _result(1)
            mat `MEAN'[1,`i']  = _result(3)
            mat `VAR'[1,`i']   = _result(4)
            if "`std'" == "" { mat `C'[`i',`i'] = _result(4) }
            else               mat `C'[`i',`i'] = 1 
            replace `cnt' = `cnt' + 1 if `touse' & ``i''!=.

            local j 1
            while `j' < `i' {
                corr ``i'' ``j'' if `touse', `coption'
                if _result(3) != . {
                    mat `C'[`i',`j'] = `sgn`i'' * `sgn`j'' * _result(4)
                    mat `C'[`j',`i'] = `C'[`i',`j'] 
                }
                mat `Obs'[`i',`j'] = _result(1)
                mat `Obs'[`j',`i'] = `Obs'[`i',`j'] 
                local j = `j' + 1
            }
            local i = `i' + 1
        } /* for i */
    }
    else {                                     /* all cases complete */

        mat acc `C' = `varlist' if `touse', dev mean(`MEAN') nocons
        scalar `r' = 1/(_result(1)-1)
        mat `C' = `r' * `C'
        mat `VAR' = vecdiag(`C')
        
        * adapt C for the signs of variables
        if "`revlist'" != "" {
            local i 1
            while `i' <= `k' {
                local j 1
                while `j' < `i' {
                    mat `C'[`i',`j'] = `C'[`i',`j'] * `sgn`i'' * `sgn`j''
                    mat `C'[`j',`i'] = `C'[`i',`j'] 
                    local j = `j' + 1
                }
                local i = `i' + 1
            }
        }

        * correlations 
        if "`std'" != "" { mat `C' = corr(`C') }
        mat `Obs' = J(`k',`k',`N')
        gen int `cnt' = `k'
    }    

  * test scores

    gen `test' = 0 if `touse'      
    local i 1
    while `i' <= `k' {
        if "`std'" == "" {
            replace `test' = `test' + `sgn`i'' * ``i'' if `touse' & ``i''!=.
        }
        else {
            replace `test' = `test' +                                     /*
                */  `sgn`i'' * (``i''-`MEAN'[1,`i']) / sqrt(`VAR'[1,`i']) /*
                */  if `touse' & ``i''!=.
        }
        local i = `i' + 1
    }
    replace `test' = `test' / `cnt' if `touse'

  * compute statistics for the additive scale in all items

    if "`std'" != "" { 
        scalar `avar' = 1
        scalar `nvar' = 1
    }
    else {
        scalar `avar' = 0
        scalar `nvar' = 0
        local i 1
        while `i' <= `k' {
            scalar `avar' = `avar' + `Obs'[`i',`i'] * `C'[`i',`i']
            scalar `nvar' = `nvar' + `Obs'[`i',`i']
            local i = `i' + 1
        }
    }

    scalar `acor' = 0                         /* weighted sum of variances */
    scalar `ncor' = 0                         /* sum of weights */
    local i 1
    while `i' <= `k' {
        local j 1
        while `j' < `i' {
            scalar `acor' = `acor' + `Obs'[`i',`j'] * `C'[`i',`j']
            scalar `ncor' = `ncor' + `Obs'[`i',`j']        
            local j = `j' + 1
        }
        local i = `i' + 1
    }
    
    global S_4 = `acor'/`ncor'
    global S_5  `k'
    global S_6 = (`k'*$S_4) / ((`avar'/`nvar')+(`k'-1)*$S_4)
    if $S_6 < 0 { global S_6 . }

  * compute statistics for additive scales formed by removing single items

    if "`item'" != "" {

        mat `ITC'  = J(1,`k',0)          /* item-test correlations */
        mat `IRC'  = J(1,`k',0)          /* item-rest correlations */
        mat `mIIC' = J(1,`k',0)          /* mean InterItem corr/cov */
        mat `alph' = J(1,`k',0)          /* alpha */

        if "`std'" != "" {
            scalar `av' = 1        
            scalar `nv' = 1
        }
        local i 1
        while `i' <= `k' {
            scalar `ac' = `acor'
            scalar `nc' = `ncor'
            local j 1
            while `j' <= `k' {
                if `i' != `j' {
                    scalar `ac' = `ac' - `Obs'[`i',`j'] * `C'[`i',`j']
                    scalar `nc' = `nc' - `Obs'[`i',`j']        
                }
                local j = `j' + 1
            }
            if "`std'"=="" {
                scalar `av' = `avar' - `Obs'[`i',`i'] * `C'[`i',`i']
                scalar `nv' = `nvar' - `Obs'[`i',`i']
            }

            mat `mIIC'[1,`i'] = `ac'/`nc'
            mat `alph'[1,`i'] = /*
                  */ ((`k'-1)*`ac'/`nc') / ((`av'/`nv')+(`k'-2)*`ac'/`nc')
    
            * Item-Test correlations 
            corr ``i'' `test' if `touse'
            mat `ITC'[1,`i'] = `sgn`i'' * _result(4) 

            * Item-Rest (=Test-Item) correlations 
            if "`std'" == "" {
                gen `x' = `sgn`i'' * ``i'' if `touse' & ``i''!=.
            }        
            else { 
                gen `x' = `sgn`i''*(``i''-`MEAN'[1,`i'])/sqrt(`VAR'[1,`i']) /*
                                                      */ if `touse' & ``i''!=.
            }    
            gen `rest' = (`cnt'*`test'-`x') / (`cnt'-1) /*
                                            */ if `touse' & ``i''!=. & `cnt'>1
            corr ``i'' `rest' if `touse'
            mat `IRC'[1,`i'] = `sgn`i'' * _result(4)
            drop `x' `rest'    

            local i = `i' + 1
        }
    }
 
/* end quietly */ } 

  * --------------------------------------------------------------------------
  * display   
  * --------------------------------------------------------------------------

    if "`std'" == "" { local un "un" }
    di _n in gr "Test scale = mean(`un'standardized items)"

  * compact output 

    if "`item'" == "" {       
        if "`std'" == "" { 
            local lab "covariance"
            local fmt "%9.0g"
        }
        else {
            local lab "correlation"
            local fmt "%9.4f"
        }        
        if "`revlist'" != "" { di in gr "Reversed items:" in ye "`revlist'" }
	di _n in gr "Average interitem `lab':"       _col(34) in ye `fmt' $S_4
	di    in gr "Number of items in the scale:"  _col(34) in ye %9.0f `k'
	di    in gr "Scale Reliability Coefficient:" _col(34) in ye %9.4f $S_6
    }    

  * wide detailed output 

    if "`item'" != "" & "`label'" == "" {        
        if "`std'" == "" { 
            local lab "covariance "
            local fmt "%9.0g"
        }
        else {
            local lab "correlation"
            local fmt "%8.4f"
        }        
    
        di _n in gr "                         item-test     item-rest     " /*
                 */ "inter-item"
        di    in gr "Item     |  Obs  Sign   correlation   correlation    " /*
                 */ "`lab'      alpha"   
        di    in gr "---------+" _dup(68) "-"
        local i 1
        while `i' <= `k' {
            if "`sgn`i''" == "1" { local c "+" }
            else                 { local c "-" }
            di in gr "``i''" _col(10) "|" in ye            /*
                          */ _col(12) %4.0f `Obs'[`i',`i'] /*
                          */ _col(20)       "`c'"          /*
                          */ _col(27) %7.4f `ITC'[1,`i']   /*
                          */ _col(41) %7.4f `IRC'[1,`i']   /*
                          */ _col(55) `fmt' `mIIC'[1,`i']  /*
                          */ _col(69) %7.4f `alph'[1,`i'] 
            local i = `i' + 1
        }
        di in gr "---------+" _dup(68) "-"
        di in gr "Test" in ye _col(55) `fmt' $S_4 _col(69) %7.4f $S_6 
        di in gr "---------+" _dup(68) "-"
    }

  * compact detailed & labeled output 

    if "`item'" != "" & "`label'" != "" { 
        if "`std'" == "" { 
            local lab "cov"    
            local fmt "%7.3g" 
        }
        else {
            local lab "cor"    
            local fmt "%7.3f" 
        }

        di _n in gr "Items    | S  it-cor  ir-cor   ii-`lab'   alpha   label"
        di    in gr "---------+" _dup(68) "-"
        local i 1
        while `i' <= `k' {
            local vl : var label ``i''
            if "`sgn`i''" == "1" { local c "+" }
            else                 { local c "-" }
            di in gr "``i''" _col(10) "| " in ye "`c'"     /*
                          */ _col(15) %6.3f `ITC'[1,`i']   /*
                          */ _col(23) %6.3f `IRC'[1,`i']   /*
                          */ _col(31) `fmt' `mIIC'[1,`i']  /*
                          */ _col(40) %6.3f `alph'[1,`i']  /*
                          */ _col(49) in wh "`vl'"
            local i = `i' + 1
        }
        di in gr "---------+" _dup(68) "-"
        di in gr "Test" in ye _col(31) `fmt' $S_4 _col(40) %6.3f $S_6 /*
                  */ _col(49) in wh "mean(`un'standardized items)"
        di in gr "---------+" _dup(68) "-"
    }        

  * --------------------------------------------------------------------------
  * table with inter-item correlations / covariances  
  * --------------------------------------------------------------------------

    if "`detail'" != "" {

        if `N' == `NC' { local o "(obs=`N' in all pairs)" }
        else           { local o "(obs=pairwise, see below)" }
        mat rowname `C' = `varlist'
        mat colname `C' = `varlist'
        if "`std'" != "" {    
            di _n in gr "Inter-item (reversed) correlations `o'"
            mat list `C', noheader format(%6.4f)
        }
        else {
            di _n in gr "inter-item (reversed) covariances `o'"
            mat list `C', noheader format(%9.4g)
        }
        if `N' != `NC' {
            di _n in gr "Pairwise number of observations"
            mat rowname `Obs' = `varlist'
            mat colname `Obs' = `varlist'
            mat list `Obs', noheader format(%5.0f)
        }    
    }

    if "`gen'" != "" {
        confirm new var `gen'
        gen `gen' = `test' if `touse'
        label var `gen' "mean(`un'standardized items)"
    }   
end

capture program drop listindx
program define listindx
        version 5.0
        local v "`1'"           /* list of words */
        local w = trim("`2'")   /* word to locate */

        parse "`v'", p(" ")
        local i 1
        local found 0
        while "``i''" != ""  & `found' == 0 {
                if "``i''" == "`w'" { local found `i' }
                local i = `i'+1   
        }    
        global S_1 "`found'"
end
exit

LAYOUT-1

         1         2         3         4         5         6         7
1234567890123456789012345678901234567890123456789012345678901234567890123456789


                         item-test     item-rest     inter-item
Item     |  Obs  Sign   correlation   correlation    correlation      alpha   
---------+-----------------------------------------------------------------
12345678 | 1234    -       0.0000        0.0000       0000.0000      0.0000   
12345678 |         -       0.0000        0.0000         0.0000       0.0000   
---------+------------------------------------------------------------------
all items                                             0000.0000      0.0000   


LAYOUT-2 

         1         2         3         4         5         6         7
1234567890123456789012345678901234567890123456789012345678901234567890123456789

Items    | S  it-cor  ir-cor  aii-cor   alpha   label
---------+---------------------------------------------------------------------
12345678 | -   0.000   0.000    0.000   0.000   1234567890123456789012345678901
12345678 | +   0.000   0.000    0.000   0.000   1234567890123456789012345678901
---------|---------------------------------------------------------------------
all items                       0.000   0.000   

aii = average inter-item covariance/correlation  
ir  = item-rest correlations (rest = test-item)
it  = item-test correlations 

Future developments
 * We could, of course, compute the item-test and item-test correlations
   from the correlation/covariance matrix C, rather than from the raw data.
   Given Stata's limited matrix language, this is no fun.
 * Bartlet's test for homogeneity of variances
 * ...