Сохранять метки строк/столбцов из таблицы() с использованием kable и knitr

Функция table в базе R добавляет хорошие метки столбцов/столбцов, но когда я использую knitr::kable, они исчезают. Любой простой способ сохранить их, помимо добавления их на стороне html/markdown?

Воспроизводимый пример:

library(knitr)

# reproducibility
set.seed(123) 

# here a df
some_data <-
  data.frame(a=sample(c('up','down'), 10, replace=T),
             b=sample(c('big','small'), 10, replace=T))

# using table() you get nice labels ('a' and 'b', in this case)
table(some_data)

enter image description here

# that goes away with kable, in either markdown or html format (I care about html)
kable(table(some_data))
kable(table(some_data), format='html')

enter image description here

Ответ 1

@Yihui должен получить кредит на это. Прямо из пакета printr:

# BEGINNING of Rmd file:

```{r echo=FALSE}
# devtools::install_github("yihui/printr")
require(printr)

# reproducibility
set.seed(123) 

# here a df
some_data <-
  data.frame(a=sample(c('up','down'), 10, replace=T),
             b=sample(c('big','small'), 10, replace=T))

table(some_data)
```

# End of Rmd file

Результаты в:

|a/b  | big| small|
|:----|---:|-----:|
|down |   5|     1|
|up   |   0|     4|

Ответ 2

Неплохо, что кто-то еще отправил щедрость на мой старый вопрос. В любом случае, если это полезно, моим решением была функция генератора hbml homebrew

table_label <- function(tbl) {

  # table dimensions
  rows <- dim(tbl)[1]
  cols <- dim(tbl)[2]

  # get started
  html_out <- '<table>\n'

  # first row: label only
  blank_cell <- '<td>&nbsp;</td>'
  html_out <- 
    paste0(html_out,
           '\t<tr>',
           blank_cell, 
           '<td>', names(dimnames(tbl))[2], '</td>', # column label
           rep(blank_cell, cols-2),
           '</tr>\n')

  # second row:
  html_out <- 
    paste0(html_out,
           '\t<tr>',
           # label...
           '<td>', names(dimnames(tbl))[1], '</td>',
           # ...and headers
           paste0('<td>', dimnames(tbl)[[2]], '</td>', collapse=''),
           '</tr>\n')

  # subsequent rows
  for (i in 1:rows) {
    html_out <- 
      paste0(html_out,
             '\t<tr>',
             # header... 
             '<td>', dimnames(tbl)[[1]][i], '</td>',                        
             # ...and values
             paste0('<td>', tbl[i,], '</td>', collapse=''),
             '</tr>\n')
  }

  # last row
  html_out <- paste0(html_out, '</table>')
  return(html_out)
}

Теперь этот файл уценки:

Produce table
```{r}
set.seed(123) 

some_data <-
  data.frame(a=sample(c('up','down'), 10, replace=T),
             b=sample(c('big','small', 'medium'), 10, replace=T))

tbl <- table(some_data)
```

Now display
```{r, results='asis'}
cat(table_label(tbl))
```

Производит результаты, которые я хотел:

enter image description here

Сгенерированный html также читаем:

<table>
    <tr><td>&nbsp;</td><td>b</td><td>&nbsp;</td></tr>
    <tr><td>a</td><td>big</td><td>medium</td><td>small</td></tr>
    <tr><td>down</td><td>4</td><td>0</td><td>2</td></tr>
    <tr><td>up</td><td>0</td><td>4</td><td>0</td></tr>
</table>

Ответ 3

Не оптимальное решение (поскольку уценка Pandoc не поддерживает col/rowspans), но попробуйте pander, который предназначен с легкостью преобразовывать объекты R в уценку (и набор опций):

> library(pander)
> pander(ftable(some_data))

------ --- ----- -------
       "b" "big" "small"

 "a"                    

"down"       5      1   

 "up"        0      4   
------ --- ----- -------

> pander(ftable(some_data), style = 'rmarkdown')

|        |     |       |         |
|:------:|:---:|:-----:|:-------:|
|        | "b" | "big" | "small" |
|  "a"   |     |       |         |
| "down" |     |   5   |    1    |
|  "up"  |     |   0   |    4    |

Ответ 4

Хотя немного взломанный, объединяя пакет tables и xtable, вы можете получить html таблицы непредвиденных обстоятельств с именами строк/столбцов. Это работает для вас?

require(xtable)
require(tables)

some_data <-
  data.frame(a=sample(c('up','down'), 10, replace=T),
             b=sample(c('big','small'), 10, replace=T))

tab <- as.matrix(tabular(Factor(a)~Factor(b), data=some_data))

print(xtable(data.frame(tab)), type="html", include.rownames=F, include.colnames=F)