Удаление полной ширины таблицы kableExtra с помощью всплывающего окна - PullRequest
0 голосов
/ 01 мая 2020

Продолжая ответ на предыдущий вопрос SO здесь , результирующая таблица занимает всю ширину slidy_presentation, несмотря на используемую команду kable_styling(full_width=F). Поскольку я все еще плохо знаком с пакетом kableExtra и RMarkdown в целом, я чувствую, что это может быть связано с длинной сноской внизу таблицы.

В результате я пытаясь использовать функцию HTML «popover», как предложено в виньетке R Awesome Table в HTML. В частности, я пытаюсь создать поле «Примечание» в последней строке столбца x из следующего файла .RMD.

Файл RMD:

---
title: "Untitled"  
output: slidy_presentation  
---

```{r}
library(kableExtra)
library(dplyr)
```

Include the HTML script from vignette here.

```{r echo=FALSE}
prob.success <- sample( seq(.5,.99,.01), size=1 )
conf.alpha <- sample( seq(.5,.99,.01), size=1 )

tab1 <- data.frame( x=0:5, f=round(dbinom(0:5,5,prob.success),3) ) %>%
  mutate( pe=x/5, lcl=qbeta(1-conf.alpha,x+0.5,5-0:5+0.5) ) %>%
  mutate( lcl=pmin(pe,lcl) ) %>%
  mutate( delta=pe-lcl ) %>%
  mutate( f_delta=f*delta )

exp.expr <- "$\\sum_x f(x)*\\left ( pe(x) - lcl(x) \\right )$"
exp.delta <- format( round(sum( tab1$f_delta ),4), nsmall=4 )

tab2 <- tab1 %>%
  mutate( x=as.character(x), f=format(round(f,4),nsmall=4) ) %>%
  mutate( pe=format(round(pe,4),nsmall=4) ) %>%
  mutate( lcl=format(round(lcl,4),nsmall=4) ) %>%
  mutate( delta=format(round(delta,4),nsmall=3) ) %>%
  mutate( f_delta=format(round(f_delta,4),nsmall=4) ) %>%
rbind( ., data.frame(x="", f="", pe="Exp", lcl="Diff", delta="=", f_delta=exp.expr) ) %>%
  rbind( ., data.frame(x="",f="",pe="",lcl="",delta="=",f_delta=exp.delta) )

tab.cols <- c( "x", "f(x)", "pe(x)", "lcl(x)", "pe(x)-lcl(x)",
            "$f(x)\\times\\left(pe(x)-lcl(x)\\right)$" )

kable( tab2, format="html", escape=FALSE, align="c", col.names=tab.cols ) %>%
  kable_styling( "striped", full_width = F, position="center" ) %>%
  footnote( general="Given x successes out of n trials, the holistic Jeffreys $100*(1-\\alpha)\\%$ Lower *Credible* Limit is the value $p$ such that $\\int_0^p \\frac{t^{x+0.5-1}(1-t)^{n-x+0.5-1}}{B(x+0.5,n-x+0.5)} dt = \\alpha$ where B(a,b) is the Beta function given by $\\int_0^1 t^{(x-1)}(1-t)^{(y-1)} dt$.",
       general_title="Note:", footnote_as_chunk=TRUE, escape=FALSE )

Моя попытка до сих пор

С единственным изменением вышеупомянутого блока R с переменной tab2, вот что я попробовал.

tab2 <- tab1 %>%
  mutate( x=as.character(x), f=format(round(f,4),nsmall=4) ) %>%
  mutate( pe=format(round(pe,4),nsmall=4) ) %>%
  mutate( lcl=format(round(lcl,4),nsmall=4) ) %>%
  mutate( delta=format(round(delta,4),nsmall=3) ) %>%
  mutate( f_delta=format(round(f_delta,4),nsmall=4) ) %>%
  rbind( ., data.frame(x="", f="", pe="Exp", lcl="Diff", delta="=", f_delta=exp.expr) ) %>%
  # Change is only with the last line
  rbind( ., data.frame(x=cell_spec("Note",popover=spec_popover(content="Test",title=NULL,position="bottom")),
                       f="",pe="",lcl="",delta="=",f_delta=exp.delta) )

и функция всплывающего окна не работает.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...