Экспорт текстов и данных из блестящего в 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"
))

Я попробовал метод, описанный здесь. Я вставил код из ссылки напрямую, но, похоже, ничего не получается со следующей ошибкой:

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
    }

На стороне пользовательского интерфейса:

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

Это ortho_text, который я хотел бы отобразить (или нет, в зависимости от ввода) в формате PDF.

Дальнейшее редактирование: это то, что я пробовал

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 shiny shinyapps

Larry Li 17.11.2019 источник

comment

Вы создали файл report.Rmd для использования в RMarkdown, который включает макет того, что вы хотите в отчете? Если нет, вы получите эту ошибку. Это пример отчета, использованный в примере Shiny, на который вы ссылались: github.com/rstudio/shiny-examples/blob/master/016-knitr-pdf/ Если вам нужна дополнительная помощь, дайте мне знать. - Ben 17.11.2019

Ответы (1)

arrow_upward
2
arrow_downward

Похоже, у вас нет файла report.Rmd, уже созданного в R Markdown (или он не может найти файл).

Ниже приведен код, который должен генерировать отчет. В первой части обновлен ui и server код. Вы можете добавить format, чтобы разрешить различные форматы файлов, если это необходимо, и кнопку загрузки. Вы хотите, чтобы ваша фильтрация выполнялась в блоке reactive.

Вторая часть представляет собой пример файла report.Rmd, в котором будет показана таблица данных с использованием xtable. Вы можете дополнительно изменить свой отчет, чтобы включить любую информацию, которую вы хотите, и другую стандартную информацию.

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 для удаления дополнительных комментариев, добавляемых при создании таблицы. Кроме того, для этого примера с 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()
      ))

Затем укажите их как встроенный код r в вашем report.Rmd:

---
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())
```

Ben 17.11.2019

comment

Это замечательно и такая простая ошибка! Я все еще очень новичок в этом, поэтому спасибо за вашу помощь. Для моего собственного образования, как filter в блоке reactive имеет значение? - Larry Li; 17.11.2019

comment

Блок reactive будет обновляться всякий раз, когда изменяется блок input. Мне нравится, когда мои фильтры данных находятся в одном месте — и output$table, и report.Rmd могут ссылаться и получать одинаковые результаты (без повторения кода). В качестве альтернативы вы можете передать данные в виде параметров в файл .Rmd, но тогда вы будете повторять свои фильтры в отчете. - Ben; 17.11.2019

comment

Извините, еще один вопрос, как мне включить вывод текста output$px_name и output$dob в файл Rmd? - Larry Li; 17.11.2019

comment

Их можно было передать как параметры. Я отредактирую ответ через мгновение, чтобы продемонстрировать... см. отредактированный ответ выше. - Ben; 18.11.2019

comment

Спасибо, я многому учусь. Учитывая, что я никогда не занимался программированием примерно 6 месяцев назад, вы понятия не имеете, что значит для меня ваша помощь. - Larry Li; 18.11.2019

comment

Рад, что смог помочь. Отличный прогресс за 6 месяцев! Пожалуйста, дайте мне знать, если возникнут другие вопросы. Удачи! - Ben; 18.11.2019

comment

Другой связанный с этим вопрос: что я могу сделать, если текст, который я хочу экспортировать в pdf, является объектом output? - Larry Li; 19.11.2019

comment

Можете ли вы описать немного больше о том, что вам нужно? Что это за объект (таблица, график, текст или что-то еще)? Это что-то отличное от того, что было в вашем примере? - Ben; 19.11.2019

comment

У меня есть observeEvent на стороне server, которая в зависимости от ввода даст output$ortho_text <- renderText("some text") или output$ortho_text <- NULL, сторона ui будет renderText("ortho_text"). Это ortho_text, который я хочу отобразить в pdf. - Larry Li; 20.11.2019

comment

@LarryLi - есть несколько способов сделать это, в зависимости от ряда факторов. Возможно, для простоты создайте еще один блок reactive специально для ortho_text (например, my_ortho_text). В этом блоке есть оператор if для input$ortho == "yes", который вернет либо строку текста (да), либо что-то еще. Затем ваш output$ortho_text просто вызовет этот блок (my_ortho_text()). В вашем .Rmd вызовите тот же блок. Если вы это сделаете, вам не понадобится отдельный файл observeEvent. Однако вам понадобится аналогичный оператор if в my_ortho_table. - Ben; 20.11.2019

comment

не могли бы вы просмотреть добавление? Я попробовал то, что вы предложили, но, похоже, столкнулся с новой ошибкой. Я ценю вашу помощь, дайте мне знать, если вам надоело, и я задам новый вопрос на форуме! - Larry Li; 20.11.2019

comment

Вы не хотите иметь output в блоке reactive. Это должно быть похоже на ваш my_ortho_table, который только что вернул кадр данных, но вместо этого вы хотите, чтобы он возвращал строку. Тогда ваш output$ortho_text вызовет блок (например, my_ortho_text()). - Ben; 20.11.2019

comment

Таким образом, my_ortho_text <- reactive({}) будет содержать код для проверки вашего input$ortho и возврата либо некоторой строки, либо NULL (как вам угодно). Ваш output$ortho_text не нуждается ни в каком операторе if — он должен быть простым, просто вызвать my_ortho_text(). Мы могли бы начать чат для дальнейшего обсуждения, или вы можете опубликовать новый вопрос. Извините, если я сделал более запутанным. Опять же, есть несколько способов сделать это, но я подумал, что это может быть самым простым и более совместимым с тем, что у вас есть до сих пор. - Ben; 20.11.2019

comment

Чтобы уточнить, для вашего вывода вам нужно: output$ortho_text <- renderText({my_ortho_text()}) - я думаю, вы забыли renderText? - Ben; 20.11.2019

comment

Я попробую это, будет ли тогда Rmd просто my_ortho_text() в фрагменте кода или как мне отобразить текст? - Larry Li; 20.11.2019

comment

Давайте продолжим обсуждение в чате. - Larry Li; 20.11.2019

comment

буду доступен через 20 минут - Ben; 20.11.2019

Экспорт текстов и данных из блестящего в pdf

Ответы (1)

Вопросы по теме