将文本和数据表从 shiny 导出为 pdf

Exporting texts and datatable from shiny to pdf

我正在尝试编写一个工作应用程序,以允许以数据表格式为患者提供一些关于某些药物的简单建议,并可以选择添加一些额外的文本。我环顾四周,看看是否有某种方法可以将文本和数据表导出为 pdf,以便我们可以将其打印出来,但到目前为止还没有成功。这是应用程序的代码:

library(tidyverse)
library(shiny)
library(shinythemes)
library(xtable)


insulin <- readRDS("insulin.rda")

# User Interface

ui <- fluidPage(

  titlePanel("Pre-operative Advice on Insulin - For Patients with Diabetes Undergoing Elective Surgery v0.1"),

  p("Please refer to Guideline on Shared Drive or Intranet for full guidance"),

  sidebarLayout(
    sidebarPanel(
      p("Patient Name and Date of Birth (Optional)"),

      textInput("px_name", label = "Patient Name", placeholder = "Patient Name"),
      textInput("dob", label = "Date of Birth or CHI", placeholder = "Date of Birth or CHI"),

      selectInput("DM", "What type of diabetes does patient have?",
                  c("Type One" = "Type 1",
                    "Type Two on Insulin" = "Type 2"),
                  selected = "Type One"),

      selectInput("time", "Is patient on morning or afternoon list?",
                  c("Morning List" = "AM",
                    "Afternoon List" = "PM"),
                  selected = "Morning"),

      checkboxGroupInput("class", "Which type(s) of insulin is patient on?",
                         c("Long and Intermediate acting",
                           "Pre-Mixed",
                           "Rapid or Short acting"))

      ),

    mainPanel(
      uiOutput("insulin_sel"),

      h3(textOutput(outputId = "px_name")),

      br(),

      h4(textOutput(outputId = "dob")),

      br(),

      tableOutput("table"),




    )
  )
)

server <- function(input, output){
  output$px_name <- renderText({input$px_name})

  output$dob <- renderText({input$dob})


  output$insulin_sel <- renderUI({

    insulin_subset <- insulin %>% filter(DM == input$DM, 
                                         Time == input$time, 
                                         Class %in% input$class)

    selectizeInput("name", "Type in name of insulin",
                   choices = list("Type in insulin name" = "", 
                                  "Names" = insulin_subset$Name), 
                                  selected = NULL, 
                                  multiple = TRUE,
                                  options = NULL)
  })

  output$table <- renderTable({

    insulin_subset <- insulin %>% filter(DM == input$DM, 
                                         Time == input$time, 
                                         Class %in% input$class)

    tab <- insulin_subset %>% filter(Name %in% input$name)

    xtable(tab)

  })



}

shinyApp(ui = ui, server = server)

这是说明的一部分:

> dput(insulin)
structure(list(DM = c("Type 2", "Type 2", "Type 2", "Type 2", 
"Type 2", "Type 2", "Type 2", "Type 2", "Type 2", "Type 2", "Type 2", 
"Type 2", "Type 2", "Type 2", "Type 1", "Type 1", "Type 1", "Type 1", 
"Type 1", "Type 1", "Type 1", "Type 1", "Type 1", "Type 1", "Type 1", 
"Type 1", "Type 1", "Type 1", "Type 2", "Type 2", "Type 2", "Type 2", 
"Type 2", "Type 2", "Type 2", "Type 2", "Type 1", "Type 1", "Type 1", 
"Type 1", "Type 1", "Type 1", "Type 1", "Type 1", "Type 2", "Type 2", 
"Type 2", "Type 2", "Type 2", "Type 2", "Type 2", "Type 2", "Type 2", 
"Type 2", "Type 1", "Type 1", "Type 1", "Type 1", "Type 1", "Type 1", 
"Type 1", "Type 1", "Type 1", "Type 1"), Time = c("AM", "AM", 
"AM", "AM", "AM", "AM", "AM", "PM", "PM", "PM", "PM", "PM", "PM", 
"PM", "AM", "AM", "AM", "AM", "AM", "AM", "AM", "PM", "PM", "PM", 
"PM", "PM", "PM", "PM", "AM", "AM", "AM", "AM", "PM", "PM", "PM", 
"PM", "AM", "AM", "AM", "AM", "PM", "PM", "PM", "PM", "AM", "AM", 
"AM", "AM", "AM", "PM", "PM", "PM", "PM", "PM", "AM", "AM", "AM", 
"AM", "AM", "PM", "PM", "PM", "PM", "PM"), Class = c("Long and Intermediate acting", 
"Long and Intermediate acting", "Long and Intermediate acting", 
"Long and Intermediate acting", "Long and Intermediate acting", 
"Long and Intermediate acting", "Long and Intermediate acting", 
"Long and Intermediate acting", "Long and Intermediate acting", 
"Long and Intermediate acting", "Long and Intermediate acting", 
"Long and Intermediate acting", "Long and Intermediate acting", 
"Long and Intermediate acting", "Long and Intermediate acting", 
"Long and Intermediate acting", "Long and Intermediate acting", 
"Long and Intermediate acting", "Long and Intermediate acting", 
"Long and Intermediate acting", "Long and Intermediate acting", 
"Long and Intermediate acting", "Long and Intermediate acting", 
"Long and Intermediate acting", "Long and Intermediate acting", 
"Long and Intermediate acting", "Long and Intermediate acting", 
"Long and Intermediate acting", "Pre-Mixed", "Pre-Mixed", "Pre-Mixed", 
"Pre-Mixed", "Pre-Mixed", "Pre-Mixed", "Pre-Mixed", "Pre-Mixed", 
"Pre-Mixed", "Pre-Mixed", "Pre-Mixed", "Pre-Mixed", "Pre-Mixed", 
"Pre-Mixed", "Pre-Mixed", "Pre-Mixed", "Rapid or Short acting", 
"Rapid or Short acting", "Rapid or Short acting", "Rapid or Short acting", 
"Rapid or Short acting", "Rapid or Short acting", "Rapid or Short acting", 
"Rapid or Short acting", "Rapid or Short acting", "Rapid or Short acting", 
"Rapid or Short acting", "Rapid or Short acting", "Rapid or Short acting", 
"Rapid or Short acting", "Rapid or Short acting", "Rapid or Short acting", 
"Rapid or Short acting", "Rapid or Short acting", "Rapid or Short acting", 
"Rapid or Short acting"), Name = c("Abasaglar", "Lantus", "Levemir", 
"Toujeo", "Tresiba", "Insulatard", "Humulin I", "Abasaglar", 
"Lantus", "Levemir", "Toujeo", "Tresiba", "Insulatard", "Humulin I", 
"Abasaglar", "Lantus", "Levemir", "Toujeo", "Tresiba", "Insulatard", 
"Humulin I", "Abasaglar", "Lantus", "Levemir", "Toujeo", "Tresiba", 
"Insulatard", "Humulin I", "Humulin M3", "Novomix 30", "Insuman Comb 15/25/50", 
"Humalog Mix 25/50", "Humulin M3", "Novomix 30", "Insuman Comb 15/25/50", 
"Humalog Mix 25/50", "Humulin M3", "Novomix 30", "Insuman Comb 15/25/50", 
"Humalog Mix 25/50", "Humulin M3", "Novomix 30", "Insuman Comb 15/25/50", 
"Humalog Mix 25/50", "Novorapid/Fiasp", "Humalog", "Apidra", 
"Humulin S", "Actrapid", "Novorapid/Fiasp", "Humalog", "Apidra", 
"Humulin S", "Actrapid", "Novorapid/Fiasp", "Humalog", "Apidra", 
"Humulin S", "Actrapid", "Novorapid/Fiasp", "Humalog", "Apidra", 
"Humulin S", "Actrapid"), Plan = c("Usual dose at usual time", 
"Usual dose at usual time", "Usual dose at usual time", "Usual dose at usual time", 
"Usual dose at usual time", "Usual dose at usual time", "Usual dose at usual time", 
"Usual dose at usual time", "Usual dose at usual time", "Usual dose at usual time", 
"Usual dose at usual time", "Usual dose at usual time", "Usual dose at usual time", 
"Usual dose at usual time", "Usual dose at usual time", "Usual dose at usual time", 
"Usual dose at usual time", "Usual dose at usual time", "Usual dose at usual time", 
"Usual dose at usual time", "Usual dose at usual time", "Usual dose at usual time", 
"Usual dose at usual time", "Usual dose at usual time", "Usual dose at usual time", 
"Usual dose at usual time", "Usual dose at usual time", "Usual dose at usual time", 
"Half usual morning dose taken with a sugary drink at 7am", "Half usual morning dose taken with a sugary drink at 7am", 
"Half usual morning dose taken with a sugary drink at 7am", "Half usual morning dose taken with a sugary drink at 7am", 
"Half usual morning dose taken with a light breakfast at 7am", 
"Half usual morning dose taken with a light breakfast at 7am", 
"Half usual morning dose taken with a light breakfast at 7am", 
"Half usual morning dose taken with a light breakfast at 7am", 
"Half usual morning dose taken with a sugary drink at 7am", "Half usual morning dose taken with a sugary drink at 7am", 
"Half usual morning dose taken with a sugary drink at 7am", "Half usual morning dose taken with a sugary drink at 7am", 
"Half usual morning dose taken with a light breakfast at 7am", 
"Half usual morning dose taken with a light breakfast at 7am", 
"Half usual morning dose taken with a light breakfast at 7am", 
"Half usual morning dose taken with a light breakfast at 7am", 
"Omit breakfast dose", "Omit breakfast dose", "Omit breakfast dose", 
"Omit breakfast dose", "Omit breakfast dose", "Half usual morning dose taken with a light breakfast at 7am", 
"Half usual morning dose taken with a light breakfast at 7am", 
"Half usual morning dose taken with a light breakfast at 7am", 
"Half usual morning dose taken with a light breakfast at 7am", 
"Half usual morning dose taken with a light breakfast at 7am", 
"Omit breakfast dose", "Omit breakfast dose", "Omit breakfast dose", 
"Omit breakfast dose", "Omit breakfast dose", "Usual morning dose taken with a light breakfast at 7am, oral fluids until 11am, omit lunchtime dose", 
"Usual morning dose taken with a light breakfast at 7am, oral fluids until 11am, omit lunchtime dose", 
"Usual morning dose taken with a light breakfast at 7am, oral fluids until 11am, omit lunchtime dose", 
"Usual morning dose taken with a light breakfast at 7am, oral fluids until 11am, omit lunchtime dose", 
"Usual morning dose taken with a light breakfast at 7am, oral fluids until 11am, omit lunchtime dose"
)), row.names = c(NA, -64L), class = c("tbl_df", "tbl", "data.frame"
))

我已经尝试过 here 中描述的方法。我直接从 link 粘贴了代码,但似乎无处可去,出现以下错误:

Warning in normalizePath(path.expand(path), winslash, mustWork) :
  path[1]="report.Rmd": The system cannot find the file specified
Warning in normalizePath(path.expand(path), winslash, mustWork) :
  path[1]="report.Rmd": The system cannot find the file specified
Warning: Error in abs_path: The file 'report.Rmd' does not exist.
  [No stack trace available]

在这一点上,即使我可以将 DT 导出为 pdf 也很有用。

编辑:关于显示输出对象的查询。 服务器端代码:

my_ortho_table <- reactive({
    ortho_table <- drugsUI %>%
      filter(Ortho == "yes") %>%
      select(Name, Recommendations)
    return(ortho_table)
  })  

  observeEvent(input$ortho, {
    if(input$ortho == "yes"){
      output$ortho_tab <- renderTable({
        xtable(my_ortho_table())})
      output$ortho_text <- renderText("Additional information for patients undergoing hip and knee replacement or revision,
                                      if taking the following medications")
    }else{
      output$ortho_tab <- NULL
      output$ortho_text <- NULL
    }

ui 一方:

textOutput("ortho_text"),
tableOutput("ortho_tab"),

这是我想在pdf中显示(或不显示,取决于输入)的ortho_text

进一步编辑: 这是我试过的

my_ortho_table <- reactive({
    ortho_table <- drugsUI %>%
      filter(Ortho == "yes") %>%
      select(Name, Recommendations)


    if(input$ortho == "yes"){
      output$ortho_tab <- renderTable({
        xtable(ortho_table)})

    }else{
      output$ortho_tab <- NULL
      }
  })  

  my_ortho_text <- reactive({
    if(input$ortho == "yes"){

      output$ortho_text <- renderText("Additional information for patients undergoing hip and knee replacement or revision,
                                      if taking the following medications")
    }else{

      output$ortho_text <- NULL
    }

  })

对应输出:

output$ortho_table <- my_ortho_table()


output$ortho_text <- my_ortho_text()

但出现以下错误:

Error in .getReactiveEnvironment()$currentContext() : 
  Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

听起来您还没有在 R Markdown 中创建 report.Rmd 文件(或者找不到该文件)。

下面是应该生成报告的代码。第一部分更新了 uiserver 代码。如果需要,您可以添加 format 以允许不同的文件格式,以及一个下载按钮。您将希望在 reactive 块中完成过滤。

第二部分是一个示例 report.Rmd 文件,它将使用 xtable 显示数据 table。您可以进一步修改您的报告以包括您想要的任何信息和其他样板信息。

library(tidyverse)
library(shiny)
library(shinythemes)
library(xtable)
library(rmarkdown)

insulin <- readRDS("insulin.rda")

# User Interface

ui <- fluidPage(
  titlePanel("Pre-operative Advice on Insulin - For Patients with Diabetes Undergoing Elective Surgery v0.1"),
  sidebarLayout(
    sidebarPanel(
      p("Patient Name and Date of Birth (Optional)"),
      textInput("px_name", label = "Patient Name", placeholder = "Patient Name"),
      textInput("dob", label = "Date of Birth or CHI", placeholder = "Date of Birth or CHI"),
      selectInput("DM", "What type of diabetes does patient have?",
                  c("Type One" = "Type 1",
                    "Type Two on Insulin" = "Type 2"),
                  selected = "Type One"),
      selectInput("time", "Is patient on morning or afternoon list?",
                  c("Morning List" = "AM",
                    "Afternoon List" = "PM"),
                  selected = "Morning"),
      checkboxGroupInput("class", "Which type(s) of insulin is patient on?",
                         c("Long and Intermediate acting",
                           "Pre-Mixed",
                           "Rapid or Short acting")),
      radioButtons('format', 'Document format', c('PDF', 'HTML', 'Word'), inline = TRUE),
      downloadButton('downloadReport')
    ),
    mainPanel(
      uiOutput("insulin_sel"),
      h3(textOutput(outputId = "px_name")),
      br(),
      h4(textOutput(outputId = "dob")),
      br(),
      tableOutput("table")
    )
  )
)

server <- function(input, output){

  my_insulin_table <- reactive({
    insulin_subset <- insulin %>% filter(DM == input$DM, 
                                         Time == input$time, 
                                         Class %in% input$class)
    tab <- insulin_subset %>% filter(Name %in% input$name)
  })

  output$px_name <- renderText({input$px_name})
  output$dob <- renderText({input$dob})
  output$insulin_sel <- renderUI({
    insulin_subset <- insulin %>% filter(DM == input$DM, 
                                         Time == input$time, 
                                         Class %in% input$class)
    selectizeInput("name", "Type in name of insulin",
                   choices = list("Type in insulin name" = "", 
                                  "Names" = insulin_subset$Name), 
                   selected = NULL, 
                   multiple = TRUE,
                   options = NULL)
  })

  output$table <- renderTable({
    xtable(my_insulin_table())
  })

  output$downloadReport <- downloadHandler(
    filename = function() {
      paste('my-report', sep = '.', switch(
        input$format, PDF = 'pdf', HTML = 'html', Word = 'docx'
      ))
    },
    content = function(file) {
      src <- normalizePath('report.Rmd')

      # temporarily switch to the temp dir, in case you do not have write
      # permission to the current working directory
      owd <- setwd(tempdir())
      on.exit(setwd(owd))
      file.copy(src, 'report.Rmd', overwrite = TRUE)

      out <- render('report.Rmd', switch(
        input$format,
        PDF = pdf_document(), HTML = html_document(), Word = word_document()
      ))
      file.rename(out, file)
    }
  )
}

shinyApp(ui = ui, server = server)

report.Rmd 文件可以包含以下内容作为示例:

# Pre-operative Advice on Insulin

```{r echo = FALSE, results = 'asis'}
options(xtable.comment = FALSE)
xtable(my_insulin_table())
```

请注意 asis 用于 xtable 以删除创建 table 时添加的附加注释。此外,对于这个 xtable 的示例,它仅针对 pdf 格式。

编辑: 要将姓名和出生日期传递到您的报告中,您还可以使用参数。

首先,在 render 语句的列表中添加参数:

out <- render('report.Rmd', 
        params = list(name = input$px_name, dob = input$dob),
        switch(input$format,
          PDF = pdf_document(), 
          HTML = html_document(), 
          Word = word_document()
      ))

然后在您的 report.Rmd:

中将它们作为内联 r 代码引用
---
title: "Pre-operative Advice on Insulin"
output: pdf_document
params:
  name: 'NULL'
  dob: 'NULL'
---

# Demographics

Name: `r params[["name"]]`

Date of Birth: `r params[["dob"]]`

# Insulin Schedule

```{r echo = FALSE, results = 'asis'}
options(xtable.comment = FALSE)
xtable(my_insulin_table())
```