用R markdown 生成交互式深度分析报告

Jean

R markdown的交互式动态报告由Shiny支持，在Rstudio中通过菜单File->New File->R Markdown->Shiny即可创建，与其它R markdown文档的区别是它提供了反应式输入输出组件，根据输入实时更新文档中相应的输出。先看一个简单的例子。
1、内嵌反应式组件的Shiny文档
---
title: "Shiny Doc 测试"
output: html_document
runtime: shiny
---

## R markdown Shiny文档测试
### 运行一些R代码
```{r}
date<-Sys.Date()
```
日期，inline形式的代码只显示结果，不会显示代码：`r date`

### 定义反应式输入，相当于ui.R
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
```{r}
numeric("rows", "头部显示行数", 5)
```

### 定义反应式输出，相当于server.R
```{r}
rows<-reactive({input$rows})
renderTable({ head(cars, rows())})
```

### 在后面可以继续引用反应式输入，包括反应式变量，render()输出等反应式组件。
行数：`r renderText({rows()})`。

### 定义另一个反应式输入
```{r}
slider("tail","尾部显示行数：", min = 2, max = 6, value = 4)
```

### 在后面引用反应式输出
```{r}
renderTable({tail(cars, input$tail)})
```

在头部的YAML定义中，通过runtime: shiny来定义它是个Shiny文档，它的输出只能是html_document,在线交互式，不能是pdf_document等其它格式。
然后在文档中直接嵌入Shiny反应式组件。与Shiny App的显著区别是, ui与server函数中的反应式组件，以及普通R代码可以按书写文档的需要自由的交织在一起，Shiny Server上部署运行时会自动分开抽取出来。
渲染效果如下图，改变行数输入值，输出就会相应调整。

这时Rstudio文档编辑工具栏上的运行按钮会自动由Knit变为Run Document，Rstuido识别它是个Shiny文档。它适用于从头开始创建报告。

2、内嵌独立Shiny App的文档
有3种嵌入的方式，虽然与Shiny文档的其它部分显示在同一个网页中，但它们操作不了嵌入Shiny APP内部的数据，没有这样的API。
1） shinyApp()函数嵌入，嵌入在文档中定义的Shiny APP。
---
title: "Shiny Doc"
output: html_document
runtime: shiny
---

```{r, echo=FALSE}
shinyApp(

ui = fluidPage(
select("region", "Region:",
choices = colnames(WorldPhones)),
plotOutput("phonePlot", height=270)
),

server = function(input, output) {
output$phonePlot <- renderPlot({
barplot(WorldPhones[,input$region]*1000,
ylab = "Number of Telephones", xlab = "Year")
})
},

options = list(height = 345)
)
```

2） shinyAppDir()嵌入，嵌入部署运行在其它目录的Shiny APP。

---

title: "Shiny Doc"
output: html_document
runtime: shiny
---
```{r, echo=FALSE}
# 如果有global.R，要在嵌入之前手工调用，它不会自动执行。
# https://github.com/rstudio/rmarkdown/issues/211
# source("../kmeansExample/global.R")
shinyAppDir(
"../kmeansExample",
options = list(
width = "100%"
)
)
```

这两种方式嵌入独立的Shiny App，都不支持global.R全局设置脚本，需要在文档中嵌入Shiny App之前自己手工调用执行。上面的Rmd执行效果如下：

3） knitr::include_app()嵌入，网页IFRAME嵌入。
---
title: "墨尔本房价分析报告"
author: "Jean"
date: "`r Sys.Date()`"
output: html_document
runtime: shiny
---

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

## 运行一些R代码，以便在报告里引用它们的结果。

显示当前的工作目录，显示代码及其执行结果是为了说明这是一个R markdown报告。

```{r somecode, echo=TRUE}
getwd()
```

## 嵌入完整Shiny App

通过在R Markdown 报告中使用 `shinyAppDir` 函数嵌入其它目录下运行的完整Shiny App，本例嵌入了Shiny App “墨尔本房价回归分析”，它调用底层的Python脚本在预处理数据的基础上完成各个回归模型的计算(当时是用Python研究的GBDT回归模型，当然也可以完全用R来完成)，Shiny App主要是管理各个回归模型数据的交互式可视化展示：

```{r shinyapp, =FALSE, echo=TRUE, out.width="100%"}
# R markdown嵌入Shiny App时，目前不支持加载global.R, 具体见下面的issue
# https://github.com/rstudio/rmarkdown/issues/211
# 对于使用global.R的Shiny App，要自己手动加载global.R
# 不过在Rstudio开发环境中虽然测试通过了，但在Shiny Server部署运行时有问题。
# global.R应该是正常加载了，但UI中不能显示所有render()函数渲染的组件，目前还没有找到原因。
source("../melbourne/global.R")
shinyAppDir(
"../melbourne",
options = list(
width = "100%", height=1000
))
#
# 这一行输出正常，证明在Shiny Server中手动加载global.R执行正常。
# perf
```

改用include_app来嵌入App，因为它是通过IFRAME嵌入的，没有运行环境的影响。
```{r, =TRUE, echo=TRUE, out.width="100%"}
# knitr::include_app()在Rstudio开发环境与Shiny Server部署环境运行都正常。
knitr::include_app("https://jeanye.cn:4443/shiny/users/jean/melbourne/", height="1200px")

```

这是通过在当前的Shiny文档网页中插入一个IFRAME来嵌入，完全不受Shiny文档运行环境的影响。比如墨尔本房价分析App，如果用前一种方式嵌入，由于未知的原因，所有render()函数渲染输出的Widget都显示为空白，而用这种方式嵌入就可以正常显示。

3、通过shinytest包后台运行Shiny App嵌入
一般引用已经部署应用的Shiny App来撰写深度分析报告，往往需要比较不同输入参数下的分析结果，这就要求Shiny文档与引用的Shiny App之间有交互的能力，由Shiny文档中设定引用Shiny App的输入参数，引用它的输出结果，然后在文档中加以比较分析。幸运的是，可以通过shinytest包后台运行被引用的Shiny App来完成，虽然它没有可视的UI界面，但可以在Shiny文档中通过程序去模拟UI的操作，然后提取输出的结果展示或比较分析。下面以墨尔本房价回归分析APP为例具体看看。

---
title: "墨尔本房价分析报告"
author: "Jean"
date: "`r Sys.Date()`"
output: html_document
runtime: shiny
---

## 后台加载墨尔本房价回归分析Shiny APP
需要用shinytest包，以便设置反应式输入，以及截图和提取反应式输出。
```{r}
library(shiny)
library(shinytest)
# Set loadTimeout to a long time
# Can not use shinytest for larger application
# Error in sd_startShiny(self, private, path, seed) :
# Cannot find shiny port number. Error:
# https://community.rstudio.com/t/can-not-use-shinytest-for-larger-application/6514
app <- shinytest::ShinyDriver$new("../melbourne", loadTimeout=1000000)
# get background browser window size.
app$getWindowSize()
```

### 默认算法与异常值阀值：

算法：`r app$getValue("algo")` 异常值阀值：`r app$getValue("threshold")`% 屏幕截图。

```{r, out.width = "100%", fig.width=10, fig.height=10}
app$takeScreenshot()
```


### 设置新的算法与阀值参数

设置算法
```{r}
app$setInputs(algo="LigthGBM")
app$getValue("algo")
```

设置异常值阀值
```{r}
app$setInputs(threshold=35)
app$getValue("threshold")
```


算法：`r app$getValue("algo")` 异常值阀值：`r app$getValue("threshold")`% 屏幕截图。
```{r, out.width = "100%", fig.width=10, fig.height=10}
app$takeScreenshot()
```



## 直接显示其中一个Widget
### 提取Shiny APP中返回的数据
用shinytest包的findWidget()函数找到Widget，然后用Widget的getHtml()函数得到Widget的HTML源码（包括数据），
然后把HTML源码插入到当前页面中。因为shinytest后台运行的Shiny APP运行在另一个R进程中，Widget的源码和数据不在本进程中，所以要得到Widget的HTML源码，并插入到当前的页面。反应式输入的值可以通过getValue()函数直接得到，所以需要这样提取的一般是反应式输出的值，特别是render()函数渲染输出的HTML Widget。

参阅：

https://cran.r-project.org/web/packages/shinytest/shinytest.pdf

https://rstudio.github.io/shinytest/reference/Widget.html

显示所有Widget

```{r}
app$listWidgets()
```


### 性能数据
```{r}
perf<-app$findWidget("performance")
perfHtml<-perf$getHtml()
HTML(perfHtml)
```

### 训练集拟合效果
```{r}
trainPlot<-app$findWidget("trainPlot")
trainHtml<-trainPlot$getHtml()
HTML(trainHtml)
```

### 验证集拟合效果
```{r}
validPlot<-app$findWidget("validPlot")
validHtml<-validPlot$getHtml()
HTML(validHtml)
```

### 异常数据
DataTable Widget只返回第一页，因为getHtml()只返回了一页。
```{r}
outliers<-app$findWidget("outliers")
outliersHtml<-outliers$getHtml()
HTML(outliersHtml)

```

可以通过shinytest包的execute()函数执行JavaScript找到“下页”按钮，模拟点击翻页，用程序逐页把数据抓过来。
```{r}
app$execute("
var nextPage = document.getElementsByClassName('next');
if (nextPage !=null){nextPage[0].click();}"
)
```

```{r}
outliers<-app$findWidget("outliers")
outliersHtml<-outliers$getHtml()
HTML(outliersHtml)
```

执行结果如下，这样写深度分析报告就比较充分和自由了。