*! version 1.1.0 09oct1997  STB-40 sg74
program define symmetry
	version 5.0
	local varlist "req ex min(2) max(2)"
	local if "optional" 
	local in "optional" 
	local weight "fweight"
	local options "CONtrib EXact MH NOTable "
	parse "`*'"

	qui {

	parse "`varlist'", parse(" ")

	/* ROUTINE FOR DISPLAYING CROSS TABULATION" */
	tempvar cnt
	if "`weight'" != "" { 
		gen double `cnt' `exp'
		compress `cnt'
	}
	else	gen byte `cnt' = 1
	tempvar touse
	mark `touse' `if' `in'
	markout `touse' `varlist' `cnt', strok
	preserve
	keep if `touse'
	stack `1'  `2' , into(`2' ) clear
	keep `2' 
	sort `2'
	qui by `2': keep if _n==1 
	tempfile tt
	save "`tt'"
	rename `2' `1'
	Mcross using "`tt'"
	sort `1' `2'
	save "`tt'",replace
	restore,pres
	keep if `touse'
	keep `1' `2' `touse' `cnt'
	sort `1' `2'
	merge `1' `2' using "`tt'"
	drop _merge
	replace `cnt'=0 if `cnt'==.
	if "`notable'"~="notable" {
		noi table `1' `2',c(sum `cnt') row col center f(%5.0f)
	}

	tempvar scnt
	sort `1' `2'     
	by `1' `2': gen `scnt'=sum(`cnt')
	by `1' `2':keep if _n==_N

	/*END OF CROSS TABULATION ROUTINE*/ 

	/* SET UP TABLE*/

	tempvar gro gco
	sort `1'
	by `1': gen int `gro' = 1 if _n==1
	replace `gro' = sum(`gro')
	
	sort `2'
	by `2': gen int `gco' = 1 if _n==1
	replace `gco' = sum(`gco')
	sum `gro',mean
	local r=_result(6)
        gen int i= `gro'
        gen int j=`gco'
        gen cv=`scnt'
	sort i j
	keep i j cv
	gen int loc=_n+(`r'-1)*(j-i)	
	gen int ncv=cv[loc]
	keep i j cv ncv
	/* END SET UP TABLE */

/* ROUTINE FOR MARGINAL HOMOGENEITY*/
	sort i
	by i: gen mr=sum(cv)
	by i: replace mr=mr[_N]
	sort j
	by j: gen mc=sum(cv)
	by j: replace mc=mc[_N]
	gen diag=cv if i==j
	gen mmr=mr-diag
	gen mmc=mc-diag
        gen  nd=mc-mr
	sort i j
	tempname d
        mkmat nd if i==j,mat(`d')
	if "`mh'"=="mh" {
		gen double   m=((mr-mc)^2)/(mr+mc)  if i==j
		gen double mm=((mmr-mmc)^2)/(mmr+mmc)  if i==j
		sum m,mean
	        local k=_result(1)	
		local m=_result(18)
		local  df2=`k'-1
		gen tdf=1 if i==j
		replace tdf=. if mmr==0 & mmc==0
		sum tdf,mean
	        local df3=_result(1)-1	
		sum mm,mean
		local mm=_result(18)
		local p2=chiprob(`df2',`m')
		local p3=chiprob(`df3',(`k'-1)*`mm'/`k')
	}
/* ROUTINE FOR STUART-MAXWELL MARGINAL HOMOGENEITY*/
	tempname V Vi U  X
	gen vii=mmr+mmc
        replace vii=-1*(cv+ncv) if i~=j
       	matrix `V'=J(`r',`r',0)
	sort i j
        local i 1
	local ob 1	
	while `i'<=`r' {
		local j 1
		while `j'<=`r' {
			mat `V'[`i',`j']= vii[`ob']
			local ob=`ob'+1
			local j=`j'+1
		}
	   local i=`i'+1
	}
        mat `Vi'=syminv(`V')
        mat `U'=`d''*`Vi'
        mat `X'=`U'*`d'
        local  bmd=`X'[1,1]
	local df1=`r'-1
	local p4=chiprob(`df1',`bmd')
/* ROUTINE FOR SYMMETRY TEST */
	if "`contrib'"=="contrib" {
		noi di
		noi di in green "                  Contribution" 
		noi di in green "                   to Symmetry" 
		noi di in green "   Cells           Chi-Square" 

		noi di in green "______________   ______________"
	}
		gen double sym=((cv-ncv)^2)/(-1*vii) if i<j  
		replace sym=0 if sym==. & i<j         
		sort i j
		if  "`contrib'"=="contrib" {
	 	   local i  1
		   local ob 1
		   while `ob'<=_N {
		       if sym[`ob']~=. {
			 noi di  " n" i[`ob'] "_" j[`ob'] " & n" /*
			*/  j[`ob'] "_" i[`ob'] "       " %9.4f sym[`ob']
		       }	
			local ob=`ob'+1
		    }
		}
	gen d=0 if i<j
	replace d=1 if cv==0 & ncv==0 & d==0
	replace nd=sum(d)
	sum sym,mean
	local x2=_result(18)
	local df=(`r'*(`r'-1)/2)-nd[_N]
	local p=chiprob(`df',`x2')
/* END SYMMETRY TEST */
	sum cv,mean 
	local totpair=_result(18) 

/* EXACT TEST LOGARITHM nxn tables */
	gen pval=.
	if "`exact'"=="exact" {
		keep if i<j
		keep i j  cv ncv  
		rename cv   v1
		rename ncv  v2
		order i j v1 v2
		sort i j
		gen den= v1+v2
		tempname obsval
		gen double  oval=comb(den,v1)*(0.5)^den   /* OBSERVED TABLE'S */
		gen double obval=oval                 /* p-VALUE          */
		replace    obval=oval*obval[_n-1] if _n>1
		scalar  `obsval'=obval[_N]
		if `obsval'==. {gen pval=.}
		if `obsval'~=. {
		gen nv1=den
		gen nv2=0
		gen u=den/2 
		replace u=(den-1)/2 if mod(den,2)~=0
		gen negu=-1*u
		sort negu
		local i 1
		while `i'<=_N {
			local den`i'=den[`i']
			local u`i'=u[`i']  /* upper bound for each variable */
			local i=`i'+1
		}
		local r=_N        /* variables go from 1 to r=# of collumns */
		drop _all         /* First Observation */
		set obs 1         /* set to zero vector */
		local i 1
		while `i'<=`r'{
			gen v`i'=0
			local i=`i'+1
		}
		expand `u1'+1                                                              
		replace v1=_n-1                                                               
		local i 2
		local myval "v1"
		gen double  nnp=1
		while  `i'<=`r' {
			expand `u`i''+1
			local myval "`myval' v`i'"
			parse "`myval'", parse(" ")
			sort `myval'
			by `myval': replace v`i'=_n-1
			
			replace     nnp=1
			local j 1
			while `j'<=`r' {
				replace nnp=nnp*comb(`den`j'',v`j')* /*
					*/ (0.5)^`den`j''
				local j=`j'+1
			}
			drop  if nnp>`obsval'
			 
			local i=`i'+1
		}
                local i 1
                gen double np=1
                gen eq=0
                while `i'<=`r' {
                        replace np=np*comb(`den`i'',v`i')*(0.5)^`den`i''
                        replace eq=eq+1 if `den`i''-v`i'==v`i'
                        local i=`i'+1
                }
                keep  if np<=`obsval'
                replace np=np*2^(`r'-eq)
                sort np
                egen double pval=sum(np)
           }
	} /*end of exact for nxn */	

	noi di
	noi di in green /*
	*/ "                            Chi-Squared    df      Prob>chi2" 
	noi di in gr _dup(26) "-" "+" _dup(33) "-"
	noi di in gr "Symmetry                  | " in ye %9.4f `x2' /*
		*/ _col(44)  `df'  _col(54) %5.4f `p' 
	noi di in gr "Marginal homogeneity (MH) | " /*
                */ in ye %9.4f `bmd' /*
                */ _col(44)  `df1' _col(54) %5.4f `p4'

	if "`mh'"=="mh" {
		noi di in gr "MH (Bickenboller)         | " in ye %9.4f `m'  /*
			*/ _col(44)  `df2' _col(54) %5.4f `p2' 
		noi di in gr "MH (no diagonals)         | " /*
			*/ in ye %9.4f (`k'-1)*`mm'/`k' /*
			*/ _col(44)  `df3' _col(54) %5.4f `p3' 
	}
	noi di in gr _dup(26) "-" "+" _dup(33) "-"

	if "`exact'"=="exact" {
		noi di in gr "Symmetry (exact significance probability) " /*
			*/ in ye _col(54) %5.4f  pval
		if pval==. {
       	 	     noi di in gr  "(Too many observations for exact test," /*
			*/ " asymptotic result should hold)"
        	}

	}

	if "`mh'"=="" {
  		local m=.
  		local df2=.
  		local p2=.
  		local mm=.
  		local k=.
  		local df3=.
  		local p3=.
     	}
  
	global S_1=`totpair'
	global S_2= `x2'
	global S_3= `df'
	global S_4= `p'
	global S_5= `bmd'
	global S_6= `df1'
	global S_7= `p4'
	global S_8= `m'
	global S_9= `df2'
	global S_10= `p2'
	global S_11= (`k'-1)*`mm'/`k'
	global S_12= `df3'
	global S_13= `p3'
	global S_14=pval
	}
end

program define Mcross
        version 3.1
        if "`1'" != "using" {
		noi di in red "using required"
                exit 198
        }
        mac shift
        local nob = _N
        local using "`*'"

        tempfile cross2
        tempvar order midx
        preserve
        quietly use "`using'", clear
        quietly {
                gen long `order'=_n
                expand `nob', clear
                sort `order'
                by `order': gen long `midx' = _n
                sort `midx' `order'
                drop `order'
                save "`cross2'", replace
                restore, preserve
                gen long `midx' = _n
                sort `midx'
                merge `midx' using "`cross2'"
                drop `midx' _merge
                restore, not
        }
end

exit