*! version 1.0.0 22sep1997
program define symmetry
	version 5.0
	local varlist "req ex min(2) max(2)"
	local if "optional" 
	local options "NOTable CONtrib EXact"
	parse "`*'"

	qui {

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

	/* ROUTINE FOR DISPLAYING CROSS TABULATION" */

	tempvar touse
	mark `touse' `if' `in'
	markout `touse' `varlist', strok

	preserve
	stack `1' `touse' `2' `touse', into(`2' `touse') clear
	keep `2' `touse'
	sort `2'
	qui by `2': keep if `touse'
	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'
	tempvar cnt
	gen byte `cnt'=1
	sort `1' `2'
	merge `1' `2' using "`tt'"
	drop _merge
	keep if `touse'
	sort `1' `2'
	replace `cnt'=0 if `cnt'==.
	if "`notable'"~="notable" {
		noi table `1' `2',c(sum `cnt') row col center f(%5.0f)
	}

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

	/*END OF CROSS TABULATION ROUTINE*/ 

	/* SET UP TABLE*/

	tempvar gro gco
	egen int `gro'=group(`1')
	egen int `gco'=group(`2')
	sum `gro',d
	local r=_result(6)
	sum `gco',d
	local c=_result(6)

	local i=1
	while `i'<=`r' {
		local j=1
		while `j'<=`r' {
			gen n`i'_`j'=0
			replace n`i'_`j'=`scnt' if `gro'==`i' & `gco'==`j'
			local j=`j'+1
		}
		local i=`i'+1
	}
	collapse (sum) n1_1-n`r'_`r'
/* END SET UP TABLE */


/* ROUTINE FOR MARGINAL HOMOGENEITY*/

	local i=1
	while `i'<=`r' {
		local j=1
		gen r`i'=0
		while `j'<=`r' {
			replace r`i'=r`i'+n`i'_`j'
			local j=`j'+1
		}
		local i=`i'+1
	}
	local i=1
	while `i'<=`r' {
		local j=1
		gen c`i'=0
		while `j'<=`r' {
			replace c`i'=c`i'+n`j'_`i'
			local j=`j'+1
		}
		local i=`i'+1
	}

	local i=1
	local d2=0
	while `i'<=`r' {
		gen m`i'  =0
		replace m`i'=((r`i'-c`i')^2)/(r`i'+c`i') 
		replace m`i'=0 if m`i'==.
		if r`i'==0 & c`i'==0 {local d2=`d2'+1}
		local i=`i'+1
	}
/* ROUTINE FOR MARGINAL HOMOGENEITY*/

	local i=1
	while `i'<=`r' {
		local j=1
		gen mr`i'=0
		while `j'<=`r' {
			replace mr`i'=mr`i'+n`i'_`j' if `i'~=`j'
			local j=`j'+1
		}
		local i=`i'+1
	}
	local i=1
	while `i'<=`r' {
		local j=1
		gen mc`i'=0
		while `j'<=`r' {
			replace mc`i'=mc`i'+n`j'_`i' if `i'~=`j'
			local j=`j'+1
		}
		local i=`i'+1
	}

	local i=1
	local md2=0
	while `i'<=`r' {
		gen mm`i'  =0
		replace mm`i'=((mr`i'-mc`i')^2)/(mr`i'+mc`i') 
		replace mm`i'=0 if mm`i'==.
		if mr`i'==0 & mc`i'==0 {local md2=`md2'+1}
		local i=`i'+1
	}


/* 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 "______________   ______________"
	}
	local i=1
	while `i'<=`r' {
		local j=1
		while `j'<=`r' {
			gen x`i'_`j'=0
			replace x`i'_`j'=((n`i'_`j'-n`j'_`i')^2)/ /*
				*/ (n`i'_`j'+n`j'_`i') if `i'<`j'
			replace x`i'_`j'=0 if x`i'_`j'==.
			if `i'<`j' &  "`contrib'"=="contrib" {
				noi di  "n`i'_`j'" " & " /*
					*/ "n`j'_`i'" "      " %9.4f x`i'_`j'
			} 
			local j=`j'+1
		}
		local i=`i'+1
	}

/* END SYMMETRY TEST */
	local totpair=0
	local i=1
	while `i'<=`r' {
		local j=1
		while `j'<=`r' {
			local totpair=`totpair'+n`i'_`j'
			local j=`j'+1
		}
		local i=`i'+1
	}
/*df CALCULATION */
	local i=1
	local d=0
	while `i'<=`r' {
		local j=1
		while `j'<=`r' {
			if n`i'_`j'==0 & n`j'_`i'==0 & `i'<`j' { 	
				local d=`d'+1 
			}
			local j=`j'+1
		}
		local i=`i'+1
	}

	local i=1
	local x2=0
	while `i'<=`r' {
		local j=1
		while `j'<=`r' {
			local x2=`x2'+x`i'_`j'
			local j=`j'+1
		}
		local i=`i'+1
	}

	local i=1
	local m=0
	while `i'<=`r' {
		local m=`m'+m`i'
		local i=`i'+1
	}
	local i=1
	local mm=0
	while `i'<=`r' {
		local mm=`mm'+mm`i'
		local i=`i'+1
	}

	local df=(`r'*(`r'-1)/2)-`d'
	local df2=(`r'-1)-`d2'
	local k=`r'-`md2'
	local df3=`k'-1

	local p=chiprob(`df',`x2')
	local p2=chiprob(`df2',`m')
	local p3=chiprob(`df3',(`k'-1)*`mm'/`k')
	gen pval=.

	if "`exact'"=="exact" {
/* EXACT TEST LOGARITHM nxn tables */
		keep n1_1-n`r'_`r'
		xpose,clear v
		rename _varname  cell
		gen c1=real(substr(cell,2,index(cell,"_")-2))
		gen c2=real(substr(cell,index(cell,"_")+1,.))
		drop if c1==c2
		tempfile one
		save `one'
		keep if c1>c2
		tempfile two
		sort c1  c2
		save `two'
		use `one',clear
		keep if c2>c1
		rename c2 c3
		rename c1 c2
		rename c3 c1
		rename v1 v2
		sort c1 c2
		merge c1 c2 using `two'
		assert _merge==3
		drop c1 c2 _merge
		order cell v1 v2
		gen den= v1+v2
		gen N=den

		gen double  oval=comb(N,v1)*(0.5)^N   /* OBSERVED TABLE'S */
		gen double obval=oval                 /* p-VALUE          */
		replace    obval=oval*obval[_n-1] if _n>1
		local      obsval=obval[_N]
		gen  den_n=den
		gen nv1=N
		gen nv2=0
		gen u=N/2 if mod(N,2)==0
		replace u=(N-1)/2 if mod(N,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 */
		clear             /* 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
		}
		sum v1-v`r'
		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 `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
	}

	zap_s
	global S_1=`totpair'
	global S_2= `x2'
	global S_3= `df'
	global S_4= `p'
	global S_5= `m'
	global S_6= `df2'
	global S_7= `p2'
	global S_8= (`k'-1)*`mm'/`k'
	global S_9= `df3'
	global S_10= `p3'
	global S_11=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