Search code examples
rshinydocxofficerwordr

Print a Shiny reactive value on WordR


I am looking for some help please to print a reactive value in a Shiny session into a docx with WordR. A very stripped down version of my app is presented below.

The code for the docx template is `r reactive({declared_user()})` (which is bookended with MS Word’s formatting symbols). I don’t know how to show the format symbols or provide the docx template here on SO but that’s the only applicable code.

I have tried numerous ways of wrapping the declared_user() in a reactive context in both the r file and docx but still can’t seem to see either value/user in ‘slt_input’ printing out in rprt_out.docx.

All that prints out is… function () { .dependents$register() if (.invalidated || .running) { ..stacktraceoff..(self$.updateValue()) } if (.error) { stop(.value) } if (.visible) .value else invisible(.value) }

library(shiny)
library(WordR)
library(officer)
library(dplyr)

ui <- fluidPage(
  selectInput('slt_input', 'name', choices = c("god", 'devil')),
  actionButton("btn_inline", 'inline')
)

server <- function(input, output, session) {
  
  declared_user <- reactive({
    input$slt_input
  })

  observeEvent(input$btn_inline,{
    renderInlineCode("rprt_tmplt.docx", "rprt_out.docx")
  })
}

shinyApp(ui, server)

Solution

  • Here is a solution. I think 2 things complicated the issue:

    • renderInlineCode extracts the R code from the .docx template and uses eval to evaluate the code. Somehow, it couldn't use the correct environment for the evaluation. Therefore I slightly changed the code so that you can pass the environment as an argument to the function.
    • it still doesn't work to evaluate shiny code. Therefore, I generated a normal variable out of the reactive directly before the docx rendering and use this in the template
    library(shiny)
    library(WordR)
    library(officer)
    library(dplyr)
    
    renderInlineCode_2 <- function (docxIn, docxOut, eval_envir = parent.frame(), debug = F) 
    {
      if (debug) {
        browser()
      }
      doc <- officer::read_docx(docxIn)
      smm <- officer::docx_summary(doc)
      styles <- officer::styles_info(doc)
      regx <- "^[ ]*`r[ ](.*)`$"
      smm$expr <- ifelse(grepl(regx, smm$text), sub(regx, "\\1", 
                                                    smm$text), NA)
      smm$values <- sapply(smm$expr, FUN = function(x) {
        eval(parse(text = x), envir = eval_envir)
      })
      smm <- smm[!is.na(smm$expr), , drop = F]
      i <- 3
      for (i in seq_len(nrow(smm))) {
        stylei <- switch(ifelse(is.na(smm$style_name[i]), "a", 
                                "b"), a = NULL, b = styles$style_name[styles$style_id == 
                                                                        paste0(styles$style_id[styles$style_name == smm$style_name[i] & 
                                                                                                 styles$style_type == "paragraph"], "Char")])
        doc <- officer::cursor_reach(doc, keyword = paste0("\\Q", 
                                                           smm$text[i], "\\E")) %>% officer::body_remove() %>% 
          officer::cursor_backward() %>% officer::slip_in_text(smm$values[i], 
                                                               pos = "after", style = stylei)
      }
      print(doc, target = docxOut)
      return(docxOut)
    }
    
    ui <- fluidPage(
      selectInput('slt_input', 'name', choices = c("god", 'devil')),
      actionButton("btn_inline", 'inline')
    )
    
    server <- function(input, output, session) {
      
      declared_user <- reactive({
        input$slt_input
      })
      
      observeEvent(input$btn_inline,{
        eval_user <- declared_user()
        renderInlineCode_2("rprt_tmplt.docx", "rprt_out.docx")
      })
    }
    
    shinyApp(ui, server)
    

    In the template, use:

    `r eval_user`
    

    Edit

    When thinking a bit more about it, I think in the original renderInlineCode function the parent.frame() of eval is renderInlineCode. Obviously, there the required objects are not included but in its parent.frame(). So you have to relay on R's scoping which doesn't work correctly here with shiny. I'm happy to get some more thorough explanations.