Rmarkdown html: встроенный реактивный блестящий контент в пользовательской таблице с нумерацией заголовков - PullRequest
Новая
       18

Rmarkdown html: встроенный реактивный блестящий контент в пользовательской таблице с нумерацией заголовков

0 голосов
/ 23 июня 2019

У меня есть огромное количество регрессионных оценок, которые я хочу отображать в таблицах с пользовательским форматированием (существующие пакеты, такие как stargazer, не дают достаточно компактных результатов).Я хочу, чтобы читатель мог выбирать параметры для оценок, которые он хочет отображать с помощью виджетов shiny.Для большинства контента это легко, но, кажется, довольно сложно, когда контент должен быть встроен в теги html.Я попытался

  1. сделать всю таблицу внутри вызова HTML() внутри реактивной функции, а затем вызвать renderUI() для этой функции
  2. , включая реактивное содержимое внутри тегов html

Мне удалось заставить таблицу работать с первым методом, за исключением того, что метка заголовка и нумерация не сработали.Я попытался передать метку (#tab:TableLabel1) на knitr::knit2html(), но это дало тот же результат.Я также попытался заменить теги html их эквивалентами shiny, что ничего не изменило и сделало код длиннее, потому что мне приходилось вручную указывать каждый td вместо использования paste() с вектором.Я включил рабочий пример ниже (он использует dplyr). 

---
output: bookdown::html_document2
runtime: shiny
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library(dplyr)
library(shiny)
```

<style>
  th + th {padding-left: 20px;}
  td + td {padding-left: 20px;}
  th + td {padding-left: 20px;}
</style>


```{r data}
dt = as_tibble(expand.grid(Sample=1:3, DepVar=1:3)) %>%
     mutate(Coef = round(rnorm(length(Sample)),2),
            SE = round(runif(length(Sample)),2))
```

```{r SampleChoice}
selectInput("Sample", label = "Choose a sample to view", choices=list(1,2,3), selected=1)
```

This table is great, but I cannot get the caption label to work properly:
```{r printtable}
PrintTable = eventReactive(input$Sample, {
  HTML(
    '<table>',
    '<caption>(#tab:TableLabel1) the first table</caption>',
    '<tr><th>Row group heading</th></tr>',
    '<tr><th>Variable</th>',
    paste0('<td>', dt$Coef[dt$Sample == as.numeric(input$Sample)],'</td>', collapse=""),
    '</tr>',
    '<tr><th></th>',
    paste0('<td>(', dt$SE[dt$Sample == as.numeric(input$Sample)],')</td>', collapse=""),
    '</tr>',
    '</table>'
  )
})
renderUI(print_table())
```

<br>
Moving everything except the reactive content outside of the HTML() call 
makes the caption work properly but causes all the reactive content 
to show up outside the table:

```{r PrintSE}
print_Coef = eventReactive(input$Sample, {
  HTML(paste0('<td>(', dt$Coef[dt$Sample == as.numeric(input$Sample)],')</td>', collapse=""))
})
print_SE = eventReactive(input$Sample, {
  HTML(paste0('<td>(', dt$SE[dt$Sample == as.numeric(input$Sample)],')</td>', collapse=""))
})
```

<table>
<caption>(#tab:TableLabel2) the second table</caption>
<tr><th>Row group heading</th></tr>
<tr><th>Variable</th>`r renderUI(print_Coef())`</tr>
<tr><th></th>`r renderUI(print_SE())`</tr>
</table>
...