Getting all possible combinations for 2x2 tables with fixed margins and totals

[Andrzej]

Hi,
I would like to obtain all possible combinations for 2x2 table with fixed values of the marginal totals as well as on the overall total.
Something like here:

Fisher's exact test meaning of "greater" and "less"

Specifically this part:

and here for Fisher exact test (fisher.test):

How those tables could be created in R ?

thank you.

[kjhealy]

There is surely a more elegant way to do this, but a brute-force approach would be to generate all possible 2x2 tables with the given row and column marginals and then filter the ones that satisfy the joint marginal conditions.

library(tidyverse)

## Constraints
r1_marg <- 20
r2_marg <- 20
c1_marg <- 29
c2_marg <- 11

## Range of values
r1c1 <- c(0:max(c(r1_marg, c1_marg)))
r1c2 <- c(0:max(c(r1_marg, c2_marg)))
r2c1 <- c(0:max(c(c1_marg, r2_marg)))
r2c2 <- c(0:max(c(c2_marg, r2_marg)))

## This is super-inefficient and I am
## sure there is a clever way to do 
## this directly.
marg_combos <- expand_grid(r1c1, r1c2, 
                      r2c1, r2c2) %>%
  filter(r1c1 + r1c2 == r1_marg & 
         r2c1 + r2c2 == r2_marg &
         r1c1 + r2c1 == c1_marg &
         r1c2 + r2c2 == c2_marg) %>% 
  tibble::rowid_to_column(var = "tab_id") %>% 
  pivot_longer(r1c1:r2c2, names_to = "pos") %>%
  group_by(tab_id) %>% 
  summarize(mat = list(matrix(value, 
                      nrow = 2, ncol = 2, byrow = TRUE))) %>% 
  group_by(tab_id) %>% 
  mutate(fisher = map(mat, fisher.test)) # probably want to read the fisher docs

marg_combos
#> # A tibble: 12 x 3
#> # Groups:   tab_id [12]
#>    tab_id mat               fisher 
#>     <int> <list>            <list> 
#>  1      1 <int[,2] [2 × 2]> <htest>
#>  2      2 <int[,2] [2 × 2]> <htest>
#>  3      3 <int[,2] [2 × 2]> <htest>
#>  4      4 <int[,2] [2 × 2]> <htest>
#>  5      5 <int[,2] [2 × 2]> <htest>
#>  6      6 <int[,2] [2 × 2]> <htest>
#>  7      7 <int[,2] [2 × 2]> <htest>
#>  8      8 <int[,2] [2 × 2]> <htest>
#>  9      9 <int[,2] [2 × 2]> <htest>
#> 10     10 <int[,2] [2 × 2]> <htest>
#> 11     11 <int[,2] [2 × 2]> <htest>
#> 12     12 <int[,2] [2 × 2]> <htest>

## E.g.

marg_combos$mat[[1]]
#>      [,1] [,2]
#> [1,]    9   11
#> [2,]   20    0

marg_combos$fisher[[1]]
#> 
#>  Fisher's Exact Test for Count Data
#> 
#> data:  .x[[i]]
#> p-value = 0.0001453
#> alternative hypothesis: true odds ratio is not equal to 1
#> 95 percent confidence interval:
#>  0.0000000 0.2397675
#> sample estimates:
#> odds ratio 
#>          0

marg_combos$mat[[7]]
#>      [,1] [,2]
#> [1,]   15    5
#> [2,]   14    6

[Andrzej]

Thank you very much indeed Sir, for taking your time to solve this.
I would like to kindly ask you if is it a way to select all generated tables that are connected with p-values (from fisher exact test) that are lower than alpha = 0.05 ? As it states here: The Fisher-exact P value corresponds to the proportion of values of the test statistic that are as extreme (i.e., as unusual) or more extreme than the observed value of that test statistic ( https://www.pnas.org/content/117/32/19151). So basically I would like to select 2x2 tables like those ones marked with red to see what could be regarded as or more extreme than 18,11,2,9 table ( the observed data).
,

kind regards,
Andrzej

[Andrzej]

I am a bit struggle with extracting p.values from this nested list, I tried:

marg_combos[[3]][[1]][[1]]

which extracts a single p.value, and then I would like to extract all p-values and bind it to tab_id variable.
Any ideas will be greatly appreciated.

[Andrzej]

I tried stubbornly:

marg_combos_2 <- sapply(marg_combos[[3]],"[[", 'p.value') %>% as.data.frame()

sapply(marg_combos[[3]],"[[", 'p.value', drop=FALSE)

marg_combos_3 <- cbind(marg_combos, marg_combos_2)

colnames(marg_combos_3$.) <- "P_values_extracted"

names(marg_combos_3)

colnames(marg_combos_3)[which(names(marg_combos_3) == ".")] <- "P_values_extracted"

marg_combos_4 <-  marg_combos_3 %>% select(1,2,4)

marg_combos_4 %>% 
  rowwise() %>% 
  mutate_if(is.list, ~paste(unlist(.), collapse = '|')) %>% 
  write.csv('marg_combos_4_final.csv', row.names = FALSE)

Key to the solutions was this:

marg_combos[[3]],"[[", 'p.value'

I have done it by many trial and error attempts.

And then in Excel straightaway:

Maybe someone could propose a simpler solution or with purrr more efficient one ?
I was stuck a bit when it came to get to a deeper elements of nested list.

[nirgrahamuk]

marg_combos$pval <- purrr::map_dbl(marg_combos$fisher, 
                                   ~ .$`p.value`)
marg_combos$flatmat <- map_chr(marg_combos$mat,~paste0(.x,collapse="|"))
select(ungroup(marg_combos),
       tab_id,flatmat,pval)

# A tibble: 12 x 3
   tab_id flatmat        pval
    <int> <chr>         <dbl>
 1      1 9|20|11|0  0.000145
 2      2 10|19|10|1 0.00334 
 3      3 11|18|9|2  0.0310  
 4      4 12|17|8|3  0.155   
 5      5 13|16|7|4  0.480   
 6      6 14|15|6|5  1       
 7      7 15|14|5|6  1       
 8      8 16|13|4|7  0.480   
 9      9 17|12|3|8  0.155   
10     10 18|11|2|9  0.0310  
11     11 19|10|1|10 0.00334 
12     12 20|9|0|11  0.000145