无法在R Shiny应用中渲染R Markdown

时间:2018-09-28 19:24:03

标签: r shiny r-markdown

我正在尝试生成一个报告,我想在该报告中通过Shiny应用程序跨多个选项卡输出表格和图表。下面是我的闪亮应用和降价代码。当我尝试下载报告时,我没有得到图,而只有R代码。如何在可下载的报告中呈现输出。

app.R

library(shiny)
library(shinyWidgets)
library(shinydashboard)
library(DT)
library(plotly)
library(rmarkdown)


sidebar <- dashboardSidebar(
  sidebarMenu(id = "tab",
              menuItem("1", tabName = "1"),
              menuItem("2", tabName = "2"),
              downloadButton("report", "Generate report")

  )
)
body <-   ## Body content
  dashboardBody(box(
    tabItems(
      tabItem(tabName = "1",
              fluidRow(DT::dataTableOutput("atc_topline"))

      ),
      tabItem(tabName = "2",
              fluidRow(  plotlyOutput("stack"))
      )
    )
  ))

ui <-   dashboardPage(dashboardHeader(title = "Scorecard"),
                      sidebar,
                      body)

# Define the server code
server <- function(input, output,session) {
  delta_plot <- data.frame(structure(list(Month = structure(c(17257, 17287, 17318, 17348,
 17379, 17410, 17440, 17471, 17501, 17532), class = "Date"),  Interacting = c(11.326863, 11.21184,
  11.004666, 11.045412, 11.413678, 11.487366, 11.069, 11.177319,12.214473, 11.965812), Switcher = c(1.065518, 1.2053, 1.078746,
                                      0.792034, 0.945035, 1.086651, 1.334486, 0.919187, 0.683544, 0.875269
  )), row.names = c(NA, -10L), class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
 vars = "Month", drop = TRUE, indices = list( 0L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L), group_sizes = c(1L,
                  1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), biggest_group_size = 1L, labels = structure(list(
                   Month = structure(c(17257, 17287, 17318, 17348, 17379, 17410,
                   17440, 17471, 17501, 17532), class = "Date")), row.names = c(NA,  -10L),
                  class = "data.frame", vars = "Month", drop = TRUE), na.action = structure(c(`11` = 11L), class = "omit")))

  output$stack <- renderPlotly({
    p <- plot_ly()

    ToAdd <- setdiff(colnames(delta_plot),"Month")

    for(i in ToAdd[2:3]){
      p <- p %>% add_trace(x = delta_plot$Month, y = delta_plot[[i]], name = i,
                           type = 'scatter',
                           mode = 'lines') %>% layout(yaxis = list( side = "right"))
    }
p
  })

  output$atc_topline <- renderDataTable({
    delta_plot

  })

  output$report <- downloadHandler(
    # For PDF output, change this to "report.pdf"
    filename = "report.html",
    content = function(file) {

      tempReport <- file.path(tempdir(), "report.Rmd")
      file.copy("report.Rmd", tempReport, overwrite = TRUE)
      params <- list(n = delta_plot)


      rmarkdown::render(tempReport, output_file = file,
                        params = params,
                        envir = new.env(parent = globalenv())
      )
    }
  )
}

shinyApp(ui = ui, server = server)

report.Rmd

---
title: "Dynamic report"
output: html_document
params:
  n: NA
---

```{r}
library(plotly)
renderPlotly({
      p <- plot_ly()

    ToAdd <- setdiff(colnames(params$n),"Month")

    for(i in ToAdd[2:3]){
      p <- p %>% add_trace(x = params$n$Month, y = params$n[[i]], name = i,
                           type = 'scatter',
                           mode = 'lines') %>% layout(yaxis = list( side = "right"))
    }
p
  })
```

1 个答案:

答案 0 :(得分:3)

有了下面的降价文档,我得到了R代码和绘图。 我刚刚删除了renderPlotly({ })title之前的空格,这引起了Yaml问题,如here所述:

  

警告:yaml :: yaml.load中的错误:解析器错误:未找到预期的结果    在第2行的第1列

---
title: "Dynamic report"
output: html_document
params:
  n: NA
---

```{r}
library(plotly)

p <- plot_ly()

ToAdd <- setdiff(colnames(params$n),"Month")

for(i in ToAdd[2:3]){
  p <- p %>% add_trace(x = params$n$Month, y = params$n[[i]], name = i,
                       type = 'scatter',
                       mode = 'lines') %>% layout(yaxis = list( side = "right"))
}
p

```

enter image description here