是否可以从闪亮的应用程序创建用户定义的报告?

时间:2016-12-27 19:09:40

标签: r shiny shinydashboard

下面的闪亮应用程序已从画廊中删除。它允许用户选择变量,构建线性回归和下载报告。

如果我事先不知道有多少用户想要构建的图表和模型并包含在报告中,该怎么办?是否可以使用动态添加的图创建报告?

Server.R

function(input, output) {

    regFormula <- reactive({
        as.formula(paste('mpg ~', input$x))
    })

    output$regPlot <- renderPlot({
        par(mar = c(4, 4, .1, .1))
        plot(regFormula(), data = mtcars, pch = 19)
    })

    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)

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

}

ui.R

fluidPage(
    title = 'Download a PDF report',
    sidebarLayout(
        sidebarPanel(
            helpText(),
            selectInput('x', 'Build a regression model of mpg against:',
                        choices = names(mtcars)[-1]),
            radioButtons('format', 'Document format', c('PDF', 'HTML', 'Word'),
                         inline = TRUE),
            downloadButton('downloadReport')
        ),
        mainPanel(
            plotOutput('regPlot')
        )
    )
)

report.Rmd

Here is my regression model:

```{r model, collapse=TRUE}
options(digits = 4)
fit <- lm(regFormula(), data = mtcars)
b   <- coef(fit)
summary(fit)
```

The fitting result is $mpg = `r b[1]` + `r b[2]``r input$x`$.
Below is a scatter plot with the regression line.

```{r plot, fig.height=5}
par(mar = c(4, 4, 1, 1))
plot(regFormula(), data = mtcars, pch = 19, col = 'gray')
abline(fit, col = 'red', lwd = 2)
```

1 个答案:

答案 0 :(得分:2)

好吧,看起来我找到了答案。问题出在本地/全局变量中。我不得不将列表初始化放在服务器功能之外。此外,我不得不使用<<-而不是<-来为情节分配新元素,而不是每次都创建新的情节。

非常感谢Peter Ellis的支持!

所以,解决方法是(我稍微改变了初始代码以专注于重要部分):

<强> server.R

library(ggplot2); library(shiny); library(grid); library(gridExtra)


plist <- list() # IMPORTANT - outside server function

shinyServer(function(input, output) {

    output$regPlot <- renderPlot({
        p <- do.call("grid.arrange", c(plotList(),
                                       ncol=floor(sqrt(length(plotList())+1)),
                                       top = "test"))
    })



    plotList <- eventReactive(input$plt2rprt, {
        p <- ggplot(data = mtcars, aes_string(x = input$x, y = "mpg")) +
            geom_point()
 #       isolate(
        plist[[length(plist)+1]] <<- p #IMPORTATNT <<- instead of <-
 #       )
        return(plist)
    })


    output$lengthOfList <- renderText({length(plotList())})
    output$lll <- renderText({length(plist)})

    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')

            owd <- setwd(tempdir())
            on.exit(setwd(owd))
            file.copy(src, 'report.Rmd', overwrite = TRUE)

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

}) #ShinyServer

<强> ui.R

fluidPage(
    title = 'Download a PDF report',
    sidebarLayout(
        sidebarPanel(
            helpText(),
            selectInput('x', 'Build a regression model of mpg against:',
                        choices = names(mtcars)[-1]),
            actionButton("plt2rprt", label = "Include into report"),
            hr(),
            radioButtons('format', 'Document format', c('PDF', 'HTML', 'Word'),
                         inline = TRUE),
            downloadButton('downloadReport')
        ),
        mainPanel(
            plotOutput('regPlot'),
            #verbatimTextOutput("count"),
            hr(),
            textOutput("lengthOfList"),
            textOutput("lll"),
            helpText("test-test-test")
        )
    )
)

<强> report.Rmd

Length of list of plots `r length(plotList())`

```{r plot, fig.height=5}
do.call("grid.arrange", c(plotList(),
                          ncol=floor(sqrt(length(plotList())+1)),
                          top = "test"))
```