How to change headers of rows and columns ?

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:

obraz

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:

obraz

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

obraz

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

1 Like

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

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.

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

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

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 ?

obraz

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

obraz

This topic was automatically closed 42 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.