How to change headers of rows and columns ?

[Andrzej]

Hi,

I need to change the headers of rows and columns:

M <- as.table(rbind(c(762, 327, 468), c(484, 239, 477)))

dimnames(M) <- list(
  gender = c("F", "M"),
  party = c("Democrat", "Independent", "Republican")
)

M

f <- ftable(M,
            row.vars = "gender",
            col.vars = c("party"))

My desire output:

The code I have tried so far:

vars <- attributes(f)

fmat <- as.data.frame.matrix(f)


fmat <- cbind(gender = vars$row.vars, fmat)    

header_cols <- t(expand.grid(vars$col.vars) %>% arrange(party))

for(hindex in seq(from=nrow(header_cols), to = 1)) {
  header_items <- c(rownames(header_cols)[hindex],  header_cols[hindex,])
  fmat <- rbind(header_items, fmat)  
}

library(flextable)

ft <- flextable(fmat)

Which gives me this:

And my second question is, how to obtain just dataframe looking identical aand "as is" the ftable, meaning this:

[technocrat]

M <- as.table(rbind(c(762, 327, 468), c(484, 239, 477)))

dimnames(M) <- list(
  gender = c("F", "M"),
  party = c("Democrat", "Independent", "Republican")
)

M |> 
  as.data.frame.matrix() |>
  tibble::rownames_to_column(var = "gender") |>
  gt::gt(caption = "Party")

The screenshot is necessary because the return is HTML and won't display properly

^{Created on 2023-04-29 with reprex v2.0.2}

[Andrzej]

Thank you, this is close enough, I am still trying to do it with flextable package.

[technocrat]

@Andrzej

And my second question is, how to obtain just dataframe looking identical aand "as is" the ftable

Both questions are easier by recalling the difference between a data frame and a presentation table. In the first case, a data frame can't have two headers unless it is tolerable to have the "real" header as a row, and that will mean converting the numbers to character representation, which is seldom desired.

In this case, the "party" column would have to be entered as "", creating "invisible" data and the rownames wouild have to be converted to a column and it's heading would also have to be entered as "", also not ideal.

[Andrzej]

@technocrat

In this case, the "party" column would have to be entered as "", creating "invisible" data and the rownames wouild have to be converted to a column and it's heading would also have to be entered as "", also not ideal.

Good idea, can you please show me how to do it ?

[technocrat]

You'll regret using this

M <- as.table(rbind(c(762, 327, 468), c(484, 239, 477)))

dimnames(M) <- list(
  gender = c("F", "M"),
  party = c("Democrat", "Independent", "Republican")
)

d <- as.data.frame.matrix(ftable(M))

d
#>    V1  V2  V3
#> 1 762 327 468
#> 2 484 239 477


d <- ftable(M) |> 
  as.data.frame.matrix() |>
  tibble::rownames_to_column(var = "foo")

d$gender <- attributes(ftable(M))$row.vars$gender
d <- d[c(5,1:4)]
d[2] <- ""
colnames(d) <- c("gender",".",attributes(ftable(M))$col.vars$party)
 
d
#>   gender . Democrat Independent Republican
#> 1      F        762         327        468
#> 2      M        484         239        477

^{Created on 2023-04-29 with reprex v2.0.2}

[Andrzej]

@technocrat

You'll regret using this

Not necesserily, I have learnt something from it. Anyway I have tried and achieved this:

library(flextable)
library(tidyverse)
library(officer)
library(magrittr)


M <- as.table(rbind(c(762, 327, 468), c(484, 239, 477)))

dimnames(M) <- list(
  gender = c("F", "M"),
  party = c("Democrat", "Independent", "Republican"))

M
#>       party
#> gender Democrat Independent Republican
#>      F      762         327        468
#>      M      484         239        477

f <- ftable(M,
            row.vars = "gender",
            col.vars = c("party"))


ftable_to_flextable <- function( x ){

  row.vars = attr( x, "row.vars" )
  col.vars = attr( x, "col.vars" )
  rows <- rev( expand.grid( rev(row.vars), stringsAsFactors = FALSE ) )
  cols <- rev(expand.grid( rev(col.vars), stringsAsFactors = FALSE ))

  xmat <- as.matrix(x)
  cols$col_keys = dimnames(xmat)[[2]]
  xdata <- cbind(
    data.frame(rows, stringsAsFactors = FALSE),
    data.frame(xmat, stringsAsFactors = FALSE)
  )
  names(xdata) <- c(names(row.vars), cols$col_keys)

  ft <- regulartable(xdata)
  ft <- set_header_df(ft, cols)
  ft <- theme_booktabs(ft)
  ft <- merge_v(ft, j = names(row.vars))
  ft
}



final <- ftable(M) %>% ftable_to_flextable()

ft_2 <- add_header_row(final, values = c("Party"), colwidths = c(4), top = TRUE)

ft_2 <- add_header_row(final, values = c("Gender", "Party"), colwidths = c(1, 3), top = TRUE)

ft_2 <- width(ft_2, j=1, 3/2.54)

ft_2 <- align(ft_2, align = "center", part = "header")

ft_2 <- border_outer(ft_2, fp_border(color="black", width=1.5))

ft_2 <- border_inner(ft_2, fp_border(color="gray"))

ft_2 <- fix_border_issues(ft_2)

ft_2 %<>% bold(part = "header")

ft_2 %<>% bold (i = c(1,2),
               j = 1, bold = TRUE)

#ft_2

^{Created on 2023-04-30 with reprex v2.0.2}

I do not know why I had to comment last line (#ft_2), because reprex crashed otherwise. This is why I included the output from clipboard, but still curious why it happened. I do not know why reprex can't include final resulting flextable in it ?

Now I try to place vertical bold line between first and second column, any suggestions would be greatly appreciated.