*! version 4.0.0  23oct1997  statalist
program define sdtesti
        version 5.0

        global S_1  /* will contain total #obs                             */
        global S_2  /*              numerator df for F (or empty for chi2) */
        global S_5  /*              denominator df for F or df for chi2    */
        global S_6  /*              F or chi2                              */
        global S_7  /*              two-sided p-value                      */
        global S_8  /*              left  one-sided p-value                */
        global S_9  /*              right one-sided p-value                */
        global S_10 /*              std. dev. 1 for F or for chi2          */
        global S_11 /*              std. dev. 2 for F (or empty for chi2)  */

/* Parse. */

        parse "`*'", parse(", ")

        if "`5'"=="" | "`5'"=="," { /* Do chi-squared test */

                local args "`1' `2' `3' `4'"
                macro shift 4
                local options "Xname(string) Level(integer $S_level)"
                parse "`*'"
                if `level' < 10 | `level' > 99 {
                        local level 95
                }

                _ttest check sdtest one `args' /* check numbers */

                ChiSqi `args' `level' "`xname'"

                exit
        }

/* Here only if two-sample variance ratio test. */

        local arg1 "`1' `2' `3'"
        local arg2 "`4' `5' `6'"
        macro shift 6
        local options "Xname(string) Yname(string) Level(integer $S_level)"
        parse "`*'"
        if `level' < 10 | `level' > 99 {
                local level 95
        }

        _ttest check sdtest first  `arg1' /* check numbers */
        _ttest check sdtest second `arg2' /* check numbers */

        VRTi `arg1' `arg2' `level' "`xname'" "`yname'"
end

program define ChiSqi
        local n     "`1'"
        local m     "`2'"
        local s     "`3'"
        local s0    "`4'"
        local level "`5'"
        local xname "`6'"

/* Compute statistics. */

        if `n' == 1 { local s . } /* error check allows std dev to be 0 */

        global S_1   `n'
        global S_5 = `n' - 1
        global S_6 = $S_5*(`s')^2/(`s0')^2
        global S_10  `s'

        global S_9 = chiprob($S_5, $S_6)  /* one-sided: P > chi2 */
        global S_8 = 1 - $S_9             /* one-sided: P < chi2 */

        if $S_8 < $S_9 {
                global S_7 = 2*$S_8
                local ptwo "2*(P < chi2)"
        }
        else {
                global S_7 = 2*$S_9
                local ptwo "2*(P > chi2)"
        }

/* Display table of mean, std err, etc. */

        di _n in gr "One-sample test of variance"
        _ttest header `level' "`xname'"

        if "`xname'"=="" { local xname "x" }

        _ttest table `level' "`xname'" `n' `m' `s'
        di in gr _dup(78) "-" _n

/* Display Ho. */

        local chi2 : di %9.3f $S_6
        local chi2 = trim("`chi2'")

        if length("`s0'") > 6 {
                local s0 : di %7.0g `s0'
                local s0 = trim("`s0'")
        }

        _ttest center "Ho: sd(@`xname'@) = @`s0'@ "

        _ttest center "chi2(@$S_5@) = @`chi2'@"

/* Display Ha. */

        local p1 : di %6.4f $S_8
        local p2 : di %6.4f $S_7
        local p3 : di %6.4f $S_9

        di
        _ttest center "Ha: sd(@`xname'@) < @`s0'@"  /*
        */            "Ha: sd(@`xname'@) ~= @`s0'@" /*
        */            "Ha: sd(@`xname'@) > @`s0'@"

        _ttest center "P < chi2 = @`p1'@" "`ptwo' = @`p2'@" "P > chi2 = @`p3'@"
end

program define VRTi
        local n1    "`1'"
        local m1    "`2'"
        local s1    "`3'"
        local n2    "`4'"
        local m2    "`5'"
        local s2    "`6'"
        local level "`7'"
        local xname "`8'"
        local yname "`9'"

/* Compute statistics. */

        if `n1' == 1 { local s1 . } /* error check allows std dev to be 0 */
        if `n2' == 1 { local s2 . }

        global S_1 = `n1' + `n2'
        global S_2 = `n1' - 1
        global S_5 = `n2' - 1
        global S_6 = (`s1'/`s2')^2
        global S_10  `s1'
        global S_11  `s2'

        global S_9 = fprob($S_2,$S_5,$S_6)  /* P > Fobs */
        global S_8 = 1 - $S_9               /* P < Fobs */

        if $S_6 > 1 {
                local Flo = 1/$S_6
                local Flolab "1/F_obs"
                local Fup $S_6
                local Fuplab "F_obs  "
                global S_7 = 1 - fprob($S_2,$S_5,`Flo') + $S_9
        }
        else {
                local Flo $S_6
                local Flolab "F_obs  "
                local Fup = 1/$S_6
                local Fuplab "1/F_obs"
                global S_7 = $S_8 + fprob($S_2,$S_5,`Fup')
        }

/* Display table of mean, std err, etc. */

        di _n in gr "Variance ratio test"

        _ttest header `level' "`xname'"

        if "`xname'"=="" { local xname "x" }
        if "`yname'"=="" { local yname "y" }

        _ttest table `level' "`xname'" `n1' `m1' `s1'
        _ttest table `level' "`yname'" `n2' `m2' `s2'
        di in gr "---------+" _dup(68) "-"

        local n = `n1' + `n2'

        tempname m s /* use scalars to get every possible digit of accuracy */

        scalar `m' = (`n1'*`m1'+`n2'*`m2')/`n'
        scalar `s' = sqrt(( (`n1'-1)*(`s1')^2 + `n1'*(`m'-`m1')^2 /*
        */                + (`n2'-1)*(`s2')^2 + `n2'*(`m'-`m2')^2)/(`n'-1))

        _ttest table `level' combined `n' `m' `s'
        di in gr _dup(78) "-" _n

/* Display Ho. */

        local Fobs : di %8.3f $S_6
        local Flo  : di %8.3f `Flo'
        local Fup  : di %8.3f `Fup'

        _ttest center "Ho: sd(@`xname'@) = sd(@`yname'@) "
        di
        _ttest center "F(@$S_2@,@$S_5@) observed   = F_obs           =
        @`Fobs'@"
        _ttest center "F(@$S_2@,@$S_5@) lower tail = F_L   = `Flolab' =
        @`Flo'@"
        _ttest center "F(@$S_2@,@$S_5@) upper tail = F_U   = `Fuplab' =
        @`Fup'@"

/* Display Ha. */

        local p1 : di %6.4f $S_8
        local p2 : di %6.4f $S_7
        local p3 : di %6.4f $S_9

        if length("`xname'`yname'") > 8 {
                local xname 1
                local yname 2
        }

        di
        _ttest center "Ha: sd(@`xname'@) < sd(@`yname'@)"  /*
        */            "Ha: sd(@`xname'@) ~= sd(@`yname'@)" /*
        */            "Ha: sd(@`xname'@) > sd(@`yname'@)"

        _ttest center "P < F_obs = @`p1'@"         /*
        */            "P < F_L + P > F_U = @`p2'@" /*
        */            "P > F_obs = @`p3'@"
end
exit