```
library(magrittr)
The result appears somewhat counter intuitive.
x3 <- matrix(c(3,14,0,5), ncol = 2, byrow = TRUE)
addmargins(x3)
## [,1] [,2] [,3]
## [1,] 3 14 17
## [2,] 0 5 5
## [3,] 3 19 22
fisher.test(x3)
##
## Fisher's Exact Test for Count Data
##
## data: x3
## p-value = 1
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
## 0.112454 Inf
## sample estimates:
## odds ratio
## Inf
There are only four possible tables with the same margins.
x2 <- matrix(c(2,15,1,4), ncol = 2, byrow = TRUE)
x1 <- matrix(c(1,16,2,3), ncol = 2, byrow = TRUE)
x0 <- matrix(c(0,17,3,2), ncol = 2, byrow = TRUE)
lstTabs <- list(x3 = x3, x2 = x2, x1 = x1, x0 = x0)
## Check the margins
lapply(lstTabs, addmargins)
## $x3
## [,1] [,2] [,3]
## [1,] 3 14 17
## [2,] 0 5 5
## [3,] 3 19 22
##
## $x2
## [,1] [,2] [,3]
## [1,] 2 15 17
## [2,] 1 4 5
## [3,] 3 19 22
##
## $x1
## [,1] [,2] [,3]
## [1,] 1 16 17
## [2,] 2 3 5
## [3,] 3 19 22
##
## $x0
## [,1] [,2] [,3]
## [1,] 0 17 17
## [2,] 3 2 5
## [3,] 3 19 22
All tables have probabilities equal to or lower than the probability of table x3, thus, its p-value is 1.00.
## Define a function to obtain a 2x2 table probability using hypergeometric distribution
GetTableProb <- function(mat) {
## x: the number of white balls drawn without replacement
## from an urn which contains both black and white balls. =>[1,1] cell
## m: the number of white balls in the urn. => 1st row sum
## n: the number of black balls in the urn. => 2nd row sum
## k: the number of balls drawn from the urn. => 1st column sum
dhyper(x = mat[1,1], m = sum(mat[1,]), n = sum(mat[2,]), k = sum(mat[,1]))
}
## Check probability of each table
probTab <- data.frame(prob = sapply(lstTabs, GetTableProb))
probTab
## prob
## x3 0.441558442
## x2 0.441558442
## x1 0.110389610
## x0 0.006493506