(* Token Swap Test for 2 X 2 Tables *) (* with Fisher-Irwin Exact Test *) tokenSwaps [testTable_?MatrixQ] := Module [ {colTotals = Plus @@ testTable, rowTotals = (Plus @@ #)& /@ testTable, grandTotal = (Plus @@ #)& //@ testTable, expectedTable, balancedTable, swapSteps, posSwap, negSwap, swaps, swapTree, numSwaps, denomSwaps, tokenSwapProb, fisher, fisherSteps, fisherSwap, fisherTables, fisherPValue}, (* Token swap test *) (* calculate a balanced table, and the number of misclassification steps to transform the balanced table to the test table *) expectedTable = Outer [Times, rowTotals, colTotals] / grandTotal //N; balancedTable = Round @ expectedTable; swapSteps = (testTable - balancedTable) [[1, 1]]; (* define positive swaps and negative swaps *) posSwap = {{a_, b_}, {c_, d_}} -> {{a+1, b-1}, {c-1, d+1}}; negSwap = {{a_, b_}, {c_, d_}} -> {{a-1, b+1}, {c+1, d-1}}; (* define a swaps function that recursively builds a tree of swapped tables, and create a swap tree for the test table *) swaps [r_] := swaps [r, 0]; swaps [r_, k_] := {r} /; k == Abs [swapSteps]; swaps [r_, k_] := Join [{r}, swaps [#, k+1]& /@ {r /. posSwap, r /. negSwap}]; swapTree = swaps [balancedTable]; (* define a numerator swaps function that counts the number of swaps between the balanced table and the test table, and a denominator swaps function that counts the number of all possible swaps *) numSwaps [{lab_}] := 1 /; lab == testTable; numSwaps [{lab_}] := 0; denomSwaps [{lab_}] := 1; (# [{lab_, lc_, rc_}] := {2 * lab [[1, 2]] * lab [[2, 1]] * # [lc], 2 * lab [[1, 1]] * lab [[2, 2]] * # [rc]})& /@ {numSwaps, denomSwaps}; (* calculate a token swap probability as the ratio of numerator swaps to denominator swaps in the swap tree for the test table *) tokenSwapProb = ( (Plus @@ #)& //@ numSwaps [swapTree] ) / ( (Plus @@ #)& //@ denomSwaps [swapTree] ) //N; (* Fisher exact test *) (* define a Fisher probability function, a series of tables, and calculate a one-tailed Fisher exact test p value *) fisher [{{a_, b_}, {c_, d_}}] := ( (a+c)! (b+d)! (a+b)! (c+d)! ) / ( a! b! c! d! (a+b+c+d)! ) //N; fisherSteps = (testTable - expectedTable) [[1, 1]]; fisherSwap = If [fisherSteps >= 0, posSwap, negSwap]; fisherTables = Drop [ FixedPointList [(# /. fisherSwap)&, testTable, SameTest -> (MemberQ [#2, -1, Infinity]&)], -1]; fisherPValue = Plus @@ (fisher /@ fisherTables); (* print results *) Print [""]; Print [StringForm ["Token Swap Test Probability = ``", tokenSwapProb]]; Print [" "]; Print [StringForm ["Fisher Exact Test P Value = ``", fisherPValue]]]