program define wsanova
*! version 1.0.1   STB-47 sg103
** Author:  John R. Gleason, Syracuse University, Syracuse NY, USA
**          (loesljrg@ican.net)

   version 5.0

   local varlist "req ex min(2) max(2)"
   local if "opt"
   local in "opt"
   local weight "aweight fweight"
   local options /*
      */ "BETween(string) EPSilon ID(string) NOMatr WOnly(string)"
   parse "`*'"
   parse "`varlist'", parse(" ")
   local Wt = substr("`exp'", 2, .)
   local weight "[`weight'`exp']"
   if "`id'" == "" {
      di in red "option id() is required"
      error 499
   }
   unabb `id'
   local id : word 1 of $S_1

   quietly {
      tempvar use
      mark `use' `weight' `if' `in'
      markout `use' `varlist' $S_1
      count if `use'
      if !_result(1) { error 2000 }
      local NN = _result(1)
      mac drop WSAoV*
      xpd `between'
      local between "$S_2"
      local BFact "$S_3"
      local ErrB "`id'$S_4"
      if "`wonly'" != "" {
         xpd `wonly'
         local wonly "$S_2"
         local i 0
         local NS : word count $S_3
         while `i' < `NS' {
            local i = `i' + 1
            local a : word `i' of $S_3
            if "`a'" != "`2'" & !index("`BFact'", "`a'") {
               di in red "`a' not among the Between factors"
               error 499
            }
         }
      }
      else {
         local wonly "`2'"
         local i 0
         local NS : word count `between'
         while `i' < `NS' {
            local i = `i' + 1
            local a : word `i' of `between'
            local wonly "`wonly' `2'*`a'"
         }
      }
      local ifuse "if `use'"
      local epsilon = "`epsilon'" != ""
      if `epsilon' {
         qui tab `id' `ifuse'
         local NS = _result(2)
         qui tab `2' `ifuse'
         local NW = _result(2)
         if `NN' != `NW'*`NS' {
            di in red "epsilon option is invalid with missing data"
            error 499
         }
         local i 1
         qui cap assert _N >= 0
         while !_rc {
            local i = `i' + 1
            cap matrix drop WSAoV`i'
            cap matrix drop WSAov`i'
         }

         preserve
         keep `ifuse'
         keep `varlist' `id' `BFact' `Wt'
         local ifuse
         sort `BFact' `id' `2'
         tempvar Group
         if "`BFact'" == "" { gen byte `Group' = 1 }
         else {
            by `BFact': gen int `Group' = _n==_N
            replace `Group' = sum(`Group')
            by `BFact': replace `Group' =    /*
               */    1 + `Group' + cond(_n==_N,-1,0)
         }
         global WSAoV_VN "`1'"
         global WSAoV_WV : display %8.0g `2'[1]
         local t : type `1'
         local i 1
         while `i' < `NW' {
            local i = `i' + 1
            tempvar y`i'
            by `BFact' `id': gen `t' `y`i'' = `1'[`i'] if _n==1
            global WSAoV_VN "$WSAoV_VN `y`i''"
            local vl : display %8.0g `2'[`i']
            global WSAoV_WV "$WSAoV_WV `vl'"
         }

         tempname Adf
         local i = `NW' - 1
         matrix WSAoV_c = J(`i', `NW', 0)
         local i 1
         while `i' < `NW' {
            scalar `Adf' = sqrt(1/(`i'*(`i'+1)))
            local a 0
            while `a' < `i' {
               local a = `a' + 1
               matrix WSAoV_c[`i',`a'] = `Adf'
            }
            local a = `a' + 1
            matrix WSAoV_c[`i',`a'] = -`i'*`Adf'
            local i = `i' + 1
         }
         matrix WSAoV_ = J(`NW', `NW', 0)
         matrix WSAov_ = J(1, `NW', 0)
         global WSAoV_DF 0
         qui summ `Group', meanonly
         local NG = _result(6)  /* #(groups) */
         sort `y2'   /* put usable rows at the top */
         local i 0
         while `i' < `NG' {
            local i = `i' + 1
            GetM `i' if `Group'==`i' in 1/`NS'
            GetE WSAoV`i' WSAoV_c
         }
         scalar `Adf' = 1/$WSAoV_DF
         matrix WSAoV_ = `Adf' * WSAoV_
         matrix rownames WSAoV_ = $WSAoV_WV
         matrix colnames WSAoV_ = $WSAoV_WV
         matrix rownames WSAov_ = Means
         matrix colnames WSAov_ = $WSAoV_WV
         if "`BFact'" == "" { matrix drop WSAoV1 WSAov1 }
         else {
            global WSAoV_df "${WSAoV_df}$WSAoV_DF"
            GetE WSAoV_ WSAoV_c
         }
         matrix drop WSAoV_c
         if "`nomatr'" != "" { matrix drop $WSAoVmn WSAoV_ WSAov_ }
      }
   }

   global WSAoVcmd "`varlist' `weight' `if' `in', id(`id')"
   if "`between'" != "" {
      global WSAoVcmd "$WSAoVcmd bet(`between')"
      qui anova `1' `between' `2' `weight' `ifuse'
      GetF `between'
      qui test `between'
      local BetSS = _result(2)
      local BetDF = _result(3)
   }
   qui anova `1' `between' `ErrB' `wonly' `weight' `ifuse'
   local ErrWdf = _result(5)
   local ErrWss = _result(4)
   local TotSS = _result(2) + _result(4)
   local TotDF = _result(3) + _result(5)

   di _new _sk(27) in gr "Number of obs =" in ye %8.0g _result(1)  /*
      */    _sk(5) in gr "R-squared" _sk(5) "=" in ye %8.4f        /*
      */    _result(7) _new _sk(27) in gr "Root MSE" _sk(6)        /*
      */    "=" in ye %8.0g _result(9) _sk(5) in gr   /*
      */    "Adj R-squared =" in ye %8.4f _result(8) _new _new     /*
      */    _sk(18) in gr "Source |  Partial SS    df" _sk(7)      /*
      */    "MS" _sk(11) "F" _sk(5) "Prob > F" _new _sk(14)        /*
      */    _dup(11) "-" "+" _dup(52) "-"

   qui test `ErrB'
   local t1 = _result(2)
   local df_eB = _result(3)
   global WSAoV_Ft "${WSAoV_Ft}`t1' `df_eB'"
   local MSeB = _result(2)/_result(3)
   if "`between'" != "" {
      /* do the Between SS and df line */
      local t1 = `BetSS' / `BetDF'
      local t2 = `t1' / `MSeB'
      di _sk(4) in gr "Between subjects:    | " in ye %11.0g   /*
         */  `BetSS' %6.0g `BetDF' " " %11.0g   /*
         */  `t1' %11.2f `t2' %11.4f    /*
         */  fprob(`BetDF', _result(3), `t2')
   }
   PutF `between' `ErrB'
   qui test `wonly'
   if "`between'" != "" {
      di in gr _sk(25) "|" _new _sk(5) "Within subjects:    | "   /*
         */  in ye %11.0g _result(2) %6.0g _result(3) " " %11.0g  /*
         */  _result(2)/_result(3) %11.2f _result(6) %11.4f       /*
         */  fprob(_result(3), _result(5), _result(6))
   }
   GetF `wonly'
   global WSAoV_Ft "${WSAoV_Ft}`ErrWss' `ErrWdf'"
   PutF `wonly' Residual
   di in gr _sk(14) _dup(11) "-" "+" _dup(52) "-" _new _sk(19)    /*
      */    "Total | " in ye %11.0g `TotSS' %6.0g `TotDF' " "     /*
      */    %11.0g `TotSS'/`TotDF'
   if `epsilon' {
      #delimit ;
      di in bl _new _sk(6)
         "Note: Within subjects F-test(s) above assume sphericity of"
         " residuals;" _new _sk(12)
         "p-values corrected for lack of sphericity appear below.";
      #delimit cr
      local dfw = `NW' - 1
      local i : word count $WSAoV_E
      local eps : word `i' of $WSAoV_E
      local i = `dfw' * `eps'
      local i = min(1, (`NS'*`i' - 2)/ (`dfw'*(`df_eB' - `i')) )
      di in gr _new "Greenhouse-Geisser (G-G) epsilon:", in ye      /*
         */   %6.4f `eps' _new in gr "Huynh-Feldt (H-F) epsilon:",  /*
         */   in ye  %6.4f `i' _new in gr _sk(46) "Sphericity"      /*
         */   _sk(6) "G-G" _sk(8) "H-F" _new _sk(18) "Source |"     /*
         */   _sk(5) "df" _sk(8) "F" _sk(3) _dup(3) "   Prob > F"   /*
         */   _new _sk(14) _dup(11) "-" "+" _dup(52) "-"
      X `ErrWdf' `eps' `i' `wonly'
   }
   macro drop WSAoV_VN WSAoV_WV WSAoV_Ft WSAoVmn
end


program define unabb
   local varlist "req ex"
   parse "`*'"
   global S_1 "`varlist'"
end


program define GetM
   local I `1'
   local name "WSAoV`1'"
   local Mname "WSAov`1'"
   global WSAoVmn "${WSAoVmn}`name' `Mname' "
   mac shift
   matrix accum `name' = $WSAoV_VN `*', dev nocon means(`Mname')
   local a = _result(1) - 1
   matrix rownames `name' = $WSAoV_WV
   matrix colnames `name' = $WSAoV_WV
   matrix rownames `Mname' = Means
   matrix colnames `Mname' = $WSAoV_WV
   tempname Adf XB XB2
   scalar `Adf' = _result(1)
   matrix `XB' = `Adf' * `Mname'
   scalar `Adf' = $WSAoV_DF + `I' - 1
   matrix `XB2' = `Adf'*WSAov_
   matrix `XB' = `XB' + `XB2'
   scalar `Adf' = 1/(_result(1) + `Adf')
   matrix WSAov_ = `Adf' * `XB'
   global WSAoV_df "${WSAoV_df}`a' "
   global WSAoV_DF = $WSAoV_DF + `a'
   matrix WSAoV_ = WSAoV_ + `name'
   scalar `Adf' = 1/(_result(1)-1)
   matrix `name' = `Adf' * `name'
end


program define GetE
   tempname A a1
   matrix `A' = `2' * `1'
   matrix `A' = `A' * `2''
   scalar `a1' = trace(`A')
   matrix `A' = `A' * `A'
   local eps = `a1'*`a1'/(rowsof(`2')*trace(`A'))
   local eps : display %9.0g `eps'
   global WSAoV_E "${WSAoV_E}`eps' "
end


program define X
   local dfEw = `1'
   local E1 = `2'
   local E2 = `3'
   mac shift 3
   local i 0
   while "`1'" != "" {
      Brk `1'
      local i = `i' + 1
      local F : word `i' of $WSAoV_Ft
      local i = `i' + 1
      local df1 : word `i' of $WSAoV_Ft
      di in ye %6.0g `df1' _sk(1)    /*
         */    %10.2f `F' _sk(4) %8.4f fprob(`df1', `dfEw', `F')  /*
         */    _sk(3) %8.4f fprob(`df1'*`E1', `dfEw'*`E1', `F')   /*
         */    _sk(3) %8.4f fprob(`df1'*`E2', `dfEw'*`E2', `F')
      mac shift
   }
end


program define xpd
   macro drop S_2 S_3 S_4
   parse "`*'", parse(" *")
   local i 1
   while "``i''" != "" {
      local Sp = `i' + 1
      if "``Sp''" == "*" { local Sp }
      else { local Sp " " }
      if "``i''" != "*" {
         unabb ``i''
         if !index("$S_3", "$S_1") {
            global S_3 "${S_3}$S_1 "
            global S_4 "${S_4}*$S_1"
         }
         global S_2 "${S_2}$S_1`Sp'"
      }
      else {
         global S_2 "${S_2}*"
      }
      local i = `i' + 1
   }
end


program define GetF
   global WSAoV_Ft
   while "`1'" != "" {
      qui test `1'
      local t1 = _result(2)
      local t2 = _result(3)
      global WSAoV_Ft "${WSAoV_Ft}`t1' `t2' "
      mac shift
   }
end


program define PutF
   local T : word count $WSAoV_Ft
   local dfe : word `T' of $WSAoV_Ft
   local T = `T' - 1
   local MSe : word `T' of $WSAoV_Ft
   local MSe = `MSe' / `dfe'
   local i 0
   while "`1'" != "" {
      Brk `1'
      local i = `i' + 1
      local SS : word `i' of $WSAoV_Ft
      local i = `i' + 1
      local df : word `i' of $WSAoV_Ft
      local MS = `SS' / `df'
      local F = `MS' / `MSe'
      di in ye %11.0g `SS' %6.0g `df', %11.0g `MS' _con
      if `F' != 1.0 {
         di in ye %11.2f `F', %10.4f fprob(`df', `dfe', `F')
         local FT "`FT'`F' `df' "
      }
      else { di " " }

      mac shift
   }
   global WSAoV_Ft "`FT'"
end


program define Brk
   local L 24
   parse "`*'", parse("*")
   local i 1
   while "``i''" != "" {
      local a
      local j = `i' + 1
      while length("`a'``i''``j''") < `L'  & "``i''" != "" {
         local a "`a'``i''``j''"
         local i = `i' + 2
         local j = `i' + 1
      }
      local j = `L' - length("`a'")
      di `New' _dup(`j') " " in gr "`a' | " _con
      local New "_new"
   }
end