分析結果のレポートを欲しい人が欲しい人なりにいじって取得できる、Shiny+Rmarkdownの組み合わせが個人的にかなり有用であると考えているのですが（スケールする話はちょっと忘れよう。。。）いかんせん、長いレポートや複雑なレポートを作成する場合に「いつおわるんだ！」となるため、進捗状況を表示するProgress Barを表示する方法について調べたため、記事にしてみました。

尚、このSOのQ&Aがネタ元です。

> packageVersion("shiny")
[1] ‘1.3.2’
> packageVersion("rmarkdown")
[1] ‘1.14’

準備

とりあえず、app.rはUIをアクションボタン一つの単純なもので、クリックしたら、test.Rmdの処理を始めて終わればダウンロードするという形でやってみます。

app.r

library(shiny)

ui <- fluidPage(
    downloadButton("startProcess","長い処理の開始")
)

server <- function(input, output) {
    
    output$startProcess <- downloadHandler(
        filename = "tempfile,pptx",
        content = function(file){
            rmarkdown::render(input = "test.Rmd",output_file = file)
        }
    )

}

shinyApp(ui = ui, server = server)

test.Rmdの内容はこんな感じ。(半角スペース4つでいれるコードチャンクにシンタックスハイライトする方法がわからないorz）

---
title: "test"
author: "ironwest"
date: "2019/10/4"
output: powerpoint_presentation
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
```

```{r, results='asis'}
for(i in 1:26){
  cat("-------\n\n")
  cat(LETTERS[i])
  cat("\n\n")
}
```

もちろん、クリックしても何も起きません。
パワポファイルは無事に出力されました。

`withProgress`をつけてやってみる

app.r

library(shiny)

ui <- fluidPage(
  downloadButton("startProcess","長い処理の開始")
)

server <- function(input, output) {
  
  output$startProcess <- downloadHandler(
    filename = "tempfile.pptx",
    content = function(file){
      withProgress(expr = {
        rmarkdown::render(input = "test.Rmd", 
                          output_file = file)
      }, message = "頑張って処理中！")
    }
  )
  
}


shinyApp(ui = ui, server = server)

こちら、withProgressがしっかりと効かせてレンダリングできていますが、
ただ、レンダリングの途中経過と関係なく、ずっと10%くらいで表記がとまって、表記が終わった瞬間100%に吹っ飛ぶというところが問題で、「処理が終わるまでの時間の目安」になりえません。今回のように数秒で終わる処理ならそれでも良いですが、分単位でかかるようなレポートを出力するUIとしてノンプログラマ向けのアプリを作る場合は不適です。

そこで、Rendetingの途中経過を表示してみましょう。

Rmarkdown側からShinyのProgress Barに影響を与える

app.R

library(shiny)
library(rmarkdown)

ui <- fluidPage(
    downloadButton("startProcess","長い処理の開始")
)

server <- function(input, output, session) {

    output$startProcess <- downloadHandler(
        filename = "tempfile.pptx",
        content = function(file) {
            withProgress(message = "rendering",{
                rmarkdown::render(
                    input = "test.Rmd",
                    output_file = file,
                    params = list(rendered_from_shiny = TRUE), 
                    envir  = new.env(parent = globalenv()))
            })
        }
    )
}

shinyApp(ui = ui, server = server)

ひとつ前との違いは、paramsに、rendered_from_shinyというロジカルな値を与えているところのみです。この、rendered_from_shinyがTRUEの時だけ、次のtest.Rmdファイルの中のsetProgressが効くようにすれば、Shinyから呼び出さないときでもエラーが出ずにKnitできるように、Rmdファイルがなります。（Shinyからしか呼び出さない場合は、そもそもいらないです）

それで、test.Rmdファイルは、

---
title: "test"
author: "ironwest"
date: "2019/10/4"
output: powerpoint_presentation
params:
  rendered_from_shiny: FALSE
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
```

```{r, results='asis'}
for(i in 1:26){
  if(params$rendered_from_shiny){
    Sys.sleep(0.3)
    shiny::setProgress(value = i/26, message = str_c(LETTERS[i],"を処理中!") )
  }
  cat("-------\n\n")
  cat(LETTERS[i])
  cat("\n\n")
}
```

（一瞬過ぎて本当に動いているかわからなかったので、Sys.sleepを入れています。）

こんな感じでできあがり！

まとめ

本当はPromiseとかのAsync的なことを一緒にしないと、多数を相手にするShinyアプリとしては、この方法だめそうですが、とりあえず分析結果を限られたノンプログラマ―の方たちと共有してディスカッションするには使えそうな気がしています。