Until recently I was using an older version of flextable (0.2.0) to generate a report from a shiny app that included a table of outputs.
To accommodate a change I needed to make I had to upgrade to 0.4.2. Now the report no longer works.
The app throws this error:
**## Error in knit_print.flextable(x, ...): `render_flextable` needs to be used as a renderer for a knitr/rmarkdown R code chunk**
results of sessionInfo():
> sessionInfo()
R version 3.3.2 (2016-10-31)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows >= 8 x64 (build 9200)
locale:
[1] LC_COLLATE=English_United States.1252 LC_CTYPE=English_United States.1252
[3] LC_MONETARY=English_United States.1252 LC_NUMERIC=C
[5] LC_TIME=English_United States.1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] dplyr_0.5.0 purrr_0.2.2 readr_1.0.0 tidyr_0.6.0
[5] tibble_1.2 ggplot2_2.2.0 tidyverse_1.0.0 shinycssloaders_0.2.0
[9] officer_0.2.1 flextable_0.4.2 lattice_0.20-34 knitr_1.15.1
[13] shinythemes_1.1.1 magrittr_1.5 DT_0.2 shinyjs_0.8
[17] shiny_1.0.5
loaded via a namespace (and not attached):
[1] zip_1.0.0 Rcpp_0.12.15 highr_0.6 plyr_1.8.4
[5] R.methodsS3_1.7.1 R.utils_2.5.0 base64enc_0.1-3 tools_3.3.2
[9] digest_0.6.10 packrat_0.4.8-1 uuid_0.1-2 jsonlite_1.1
[13] evaluate_0.10 gtable_0.2.0 DBI_0.5-1 yaml_2.1.14
[17] stringr_1.1.0 xml2_1.1.1 sourcetools_0.1.5 gdtools_0.1.6
[21] htmlwidgets_0.8 rprojroot_1.1 grid_3.3.2 glue_1.2.0
[25] R6_2.2.0 rmarkdown_1.8 scales_0.4.1 backports_1.0.4
[29] htmltools_0.3.5 assertthat_0.1 colorspace_1.3-1 mime_0.5
[33] xtable_1.8-2 httpuv_1.3.5 stringi_1.1.2 miniUI_0.1.1
[37] lazyeval_0.2.0 munsell_0.4.3 markdown_0.7.7 R.oo_1.21.0
Working example that displays the error:
ui.R:
library(shiny)
shinyUI(
fluidPage(
sidebarPanel(
actionButton("submit", "Submit")
),
mainPanel(
fluidRow(
QA_HTMLInput("QA_HTML1")
)
)
)
)
server.R:
library(shiny)
library(flextable)
shinyServer(function(input, output, session) {
#browser()
rprtVec <- reactive({
if(input$submit > 0) {
x <- list(a=1,
b=1,
c=1,
d=1,
e=1,
f=1,
g=1,
h=1,
i=1,
j=1,
k=1,
l=1,
m=1,
gg=1,
hh=1,
jj=1,
mm=1,
nn=1
)
x
}
})
###
HTMLRep1 <- observe({
if(input$submit > 0) {
callModule(QA_HTMLOption,"QA_HTML1",rprtVec(),"summaryQA.Rmd")
}
})
})
global.R:
QA_HTMLInput <- function(id) {
ns <- NS(id)
# tagList(
# tags$hr(style="border-color: darkblue;"),
uiOutput(ns("report"))
# )
}
# module server for Q HTML Report
QA_HTMLOption <- function(input, output, session, myvec, reportName) {
output$report <- renderUI({
ns <- session$ns
# temporarily switch to the temp dir, in case you do not have write
# permission to the current working directory
lbl <- substr(reportName,7,8)
tempReport <- file.path(tempdir(),reportName)
try(file.copy(reportName,tempReport,overwrite = TRUE))
# Set up parameters to pass to Rmd document
if(lbl == "QA"){
params <- list(Title = myvec$a,
Author = myvec$b,
Date = myvec$c,
AR = myvec$d,
P10 = myvec$e,
OID = myvec$f,
OIO = myvec$g,
DID = myvec$h,
DIO = myvec$i,
IID = myvec$j,
IIO = myvec$k,
lkMtrx = myvec$l,
rskMtrx = myvec$m,
OCC = myvec$gg,
DET = myvec$hh,
LCS = myvec$jj,
MTX = myvec$mm,
RM1 = myvec$nn
)
}
tagList(
HTML(knitr::knit2html(text = readLines(tempReport), fragment.only = TRUE))
)
})
return(list(
# Charact = reactive({input$charact})
))
}
Now the document to be knitted - summaryQA.Rmd:
---
---
<h2> 2. Summary: </h2>
For the <b> Quick Assessment </b>, the questions, with selected answers and associated scores are shown here. These form the basis for the analysis.
```{r, results='asis', echo=FALSE}
library(officer)
library(flextable)
library(magrittr)
ID <- c("C01"," "," ","C02"," "," ","C03"," "," ")
Data <- c("Problem 1","Answer 1","Note 1","Problem 2","Answer 2","Note 2","Problem 3","Answer 3","Note 3")
Rank <- c("L"," "," ","L"," "," ","L"," "," ")
finalResults <- data.frame(ID,Data,Rank)
results_table1 <- flextable(finalResults) %>%
theme_box() %>%
### Column Headers
# format column headers for table
bold(part = "header") %>%
fontsize(part = "header",size = 18) %>%
align(part="header",align="center") %>%
### Body
# set column widths
width(j = ~ID, width = 1) %>%
width(j = ~Data, width = 8) %>%
width(j = ~Rank, width = 1) %>%
# format general body of table
fontsize(part = "body",size = 18) %>%
align(j = ~ID, align = "center", part = "body") %>%
align(j = ~Data, align = "left", part = "body") %>%
align(j = ~Rank, align = "center", part = "body") %>%
padding( padding = 5, part = "all" ) %>%
style(pr_c = fp_cell(border = fp_border(color="black", width = 2)),part = "all") #%>%
# format cell merging
for(mm in seq(from=1,to=(nrow(finalResults)-2),by=3)) {
results_table1 <- merge_at(results_table1,i=mm:(mm+2), j = ~ID, part = "body")
results_table1 <- merge_at(results_table1,i=mm:(mm+2), j = ~Rank, part = "body")
}
results_table1
```
To correct this I have tried to use htmltools_value(), but it makes no difference.
In QA_HTMLOption, replace
tagList(
HTML(knitr::knit2html(text = readLines(tempReport), fragment.only = TRUE))
)
by
temp_html <- tempfile(fileext = ".html")
rmarkdown::render(input = tempReport, output_file = temp_html)
tagList(
includeHTML(temp_html)
)