How do I combine tables to make a shareable figure that keeps header info?

[rvaducks]

I want to combine a series of tables while keeping relevant info related to the columns used for the figure. This isn't going in a paper but being shared with collaborators with limited knowledge of R so it doesn't need to be pretty but it needs to be clear. I have used cbind but that combines the columns but with no info of which columns belong to which data. My data looks like the below:

Tone <- c("no", "yes", "no", "yes")
One <- c( "correct", "correct", "correct", "incorrect")
Two <- c("correct", "incorrect", "correct", "incorrect")
Three <- c("incorrect", "incorrect", "correct", "correct")

df <- data.frame(Tone, One, Two, Three)

table1 <- table(df$Tone, df$One)
table2 <- table(df$Tone, df$Two)
table3 <- table(df$Tone, df$Three)

Ideally I would have a heading that spanned "correct incorrect" and said "One" and then "Two" and then "Three". I'm open to other ideas for presenting this data though.

[FactOREO]

I hope I understood it in the correct way, but does this look somewhat like you imagined it?
Otherwise you might be better of to some sort of manual table which explains what you try to achieve:

Tone <- c("no", "yes", "no", "yes")
One <- c( "correct", "correct", "correct", "incorrect")
Two <- c("correct", "incorrect", "correct", "incorrect")
Three <- c("incorrect", "incorrect", "correct", "correct")

df <- data.frame(Tone, One, Two, Three)

library('gt')
gt(data = df[,c(2:4)]) |>
  tab_header(
    title = 'Correct / Incorrect'
  )

Correct / Incorrect
One	Two	Three
correct	correct	incorrect
correct	incorrect	incorrect
correct	correct	correct
incorrect	incorrect	correct

^{Created on 2022-09-25 with reprex v2.0.2}

In my R session the header is centered over the column names One/Two/Three, this is some sort of weird stuff in reprex.

Kind regards

[rvaducks]

Thanks but this isn't it exactly. The table function returns a 2 x 2 table that sums the number of instances for each case (e.g., number of yes/incorrect, number of no/incorrect...). This is the info I am trying to pull out. The goal is a table where someone can quickly glance and understand when the criteria was three, there were X false positives and x flase negatives, and when the criteria was two..., etc.

[FactOREO]

Maybe ftable() is feasible for your needs? The problem you have with the original wish is, that something like "shared cells" does hardly exist in R. With ftable() it looks like this:

Tone <- c("no", "yes", "no", "yes")
One <- c( "correct", "correct", "correct", "incorrect")
Two <- c("correct", "incorrect", "correct", "incorrect")
Three <- c("incorrect", "incorrect", "correct", "correct")

Data <- data.frame(
  Tone = rep(Tone, 3),
  Number = factor(rep(c('One','Two','Three'), each = 4),
                  levels = c('One','Two','Three')),
  Result = c(One,Two,Three)
)

ftable(Data$Result, Data$Tone, Data$Number)
#>                One Two Three
#>                             
#> correct   no     2   2     1
#>           yes    1   0     1
#> incorrect no     0   0     1
#>           yes    1   2     1

^{Created on 2022-09-25 with reprex v2.0.2}

Along the columns you have the usual contingency table for each number.

Another approach would be somewhat hacky (and tedious):

# hacky
hacky <- data.frame(
  One = vector(length = 3L),
  `One ` = vector(length = 3L),
  Two = vector(length = 3L),
  `Two ` = vector(length = 3L),
  Three = vector(length = 3L),
  `Three ` = vector(length = 3L)
)
hacky[1,] <- rep(c('correct','incorrect'),3)
hacky[c(2,3),c(1,2)] <- table(Tone,One)
hacky[c(2,3),c(3,4)] <- table(Tone,Two)
hacky[c(2,3),c(5,6)] <- table(Tone,Three)
hacky
#>       One      One.     Two      Two.   Three    Three.
#> 1 correct incorrect correct incorrect correct incorrect
#> 2       2         0       2         0       1         1
#> 3       1         1       0         2       1         1

^{Created on 2022-09-25 with reprex v2.0.2}

Maybe there is also a way inside gt to do this, but I am not to familiar with this package (unfortunately).

Kind regards

[nirgrahamuk]

Tone <- c("no", "yes", "no", "yes")
One <- c( "correct", "correct", "correct", "incorrect")
Two <- c("correct", "incorrect", "correct", "incorrect")
Three <- c("incorrect", "incorrect", "correct", "correct")

df <- data.frame(Tone, One, Two, Three)
nms <-  c("One", "Two", "Three")

library(tidyverse)

(data_list <- map(
 nms,
  ~ select(df, Tone, .x) |>
    group_by_at(c("Tone", .x)) |>
    summarise(n = n()) |>
    pivot_wider(
      names_from = .x,
      values_from = "n",
      values_fill = 0L
    )
) |> set_names(nms))

#for printing i.e. as html
library(flextable)
library(htmltools)
imap(data_list,
    ~tagList(flextable(.x) |> 
               add_header_row(values = .y,colwidths = 3) |> 
               htmltools_value(),br()))|> htmltools::html_print()