r - Shiny :runExample 给出错误(不能从 `runApp()` 内调用 `runApp()` )

Question

我在 Rstudio 中使用 rmarkdown (1.4)/knitr (1.15.1) 创建一个 R markdown HTML 页面。我正在将 Shiny 合并到文件中以制作交互式文档(通过 runtime: shiny )。

当我尝试从 Shiny 运行示例时，出现错误:

```{r, eval=TRUE,chunk_title='Shiny_Example'}
runExample("01_hello")
```

Error: can't call runApp() from within runApp(). If your application code contains runApp(), please remove it.

如果我在 R markdown 代码块之外运行代码，我可以让应用程序正常加载(即使在 Rstudio 的同一 session 中)。

我确实注意到 runExample代码使用 runApp而不是 shinyapp .

这是我问题的根源吗？还是我可能做错了什么？

我的代码:

---
title: "Shiny Not Working"
output: html_document
runtime: shiny
---

```{r, eval=TRUE,chunk_title='Shiny_Example'}
library(shiny)
runExample("01_hello")
```

带有堆栈跟踪的完整错误:

Warning: Error in runApp: Can't call `runApp()` from within `runApp()`. 
If your application code contains `runApp()`, please remove it.

Stack trace (innermost first):
117: runApp
116: runExample
115: eval
114: eval
113: withVisible
112: withCallingHandlers
111: handle
110: timing_fn
109: evaluate_call
108: evaluate::evaluate
107: evaluate
106: in_dir
105: block_exec
104: call_block
103: process_group.block
102: process_group
101: withCallingHandlers
100: process_file
 99: knitr::knit
 98: <Anonymous>
 97: do.call
 96: contextFunc
 95: .getReactiveEnvironment()$runWith
 94: shiny::maskReactiveContext
 93: <reactive>
 82: doc
 81: shiny::renderUI
 80: func
 79: origRenderFunc
 78: output$__reactivedoc__
  3: <Anonymous>
  2: do.call
  1: rmarkdown::run

另请注意:

使用此设置运行其他 Shiny 的代码可以正常工作:

---
title: "Shiny Not Working"
output: html_document
runtime: shiny
---

```{r, eval=TRUE,chunk_title='Simple_Shiny'}
library(shiny)
ui <- fluidPage()
server <- function(input, output){}
shinyApp(ui = ui, server = server)
```

sessionInfo注意事项:

R version 3.3.2 (2016-10-31)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1

shiny_1.0.1  rmarkdown_1.4  knitr_1.15.1

Answer 1

所以我找到了一个解决方案(我将在下面详细说明)。

但是，我仍然想知道为什么 runExample代码不起作用(即，这是一个错误吗？？)以及是否有更官方/正确的方法可以让它工作。

我的解决方案:

更改runExample中的功能来自 runApp()至shinyAppDir() .

原创 runExample代码:

function (example = NA, port = NULL, launch.browser = getOption("shiny.launch.browser", 
    interactive()), host = getOption("shiny.host", "127.0.0.1"), 
    display.mode = c("auto", "normal", "showcase")) 
{
    examplesDir <- system.file("examples", package = "shiny")
    dir <- resolve(examplesDir, example)
    if (is.null(dir)) {
        if (is.na(example)) {
            errFun <- message
            errMsg <- ""
        }
        else {
            errFun <- stop
            errMsg <- paste("Example", example, "does not exist. ")
        }
        errFun(errMsg, "Valid examples are \"", paste(list.files(examplesDir), 
            collapse = "\", \""), "\"")
    }
    else {
        runApp(dir, port = port, host = host, launch.browser = launch.browser, 
            display.mode = display.mode)
    }
}

我编辑的代码:

(注意:最终内部函数更改为 shinyAppDir )

runExample2 <- function (example = NA, port = NULL, launch.browser = getOption("shiny.launch.browser", 
    interactive()), host = getOption("shiny.host", "127.0.0.1"), 
    display.mode = c("auto", "normal", "showcase")) 
{
    examplesDir <- system.file("examples", package = "shiny")
    dir <- resolve(examplesDir, example)
    if (is.null(dir)) {
        if (is.na(example)) {
            errFun <- message
            errMsg <- ""
        }
        else {
            errFun <- stop
            errMsg <- paste("Example", example, "does not exist. ")
        }
        errFun(errMsg, "Valid examples are \"", paste(list.files(examplesDir), 
            collapse = "\", \""), "\"")
    }
    else {
        shinyAppDir(appDir = dir)
    }
}

我意识到我失去了申请 port 的能力, host , launch.browser , 和 display.mode我修改后的函数的参数(尽管我为了比较而留下了该代码)，但我已经将它换成了一个可行的解决方案。

注意:由于某种原因， resolve()也不解析的内部函数 isWindows()被我的机器识别(即，我得到了错误 Error: could not find function "resolve" )，所以我使用了 getAnywhere()找到代码，然后在创建 runExample2 之前手动分配这些功能.

我的完整 WORKING r Markdown 代码:

---
title: "Shiny Not working"
date: "Today"
output: html_document
runtime: shiny
--- 


```{r, eval=TRUE,chunk_title='Shiny_Example'}
library(shiny)

isWindows <- function () 
.Platform$OS.type == "windows"

resolve <- function (dir, relpath) 
{
    abs.path <- file.path(dir, relpath)
    if (!file.exists(abs.path)) 
        return(NULL)
    abs.path <- normalizePath(abs.path, winslash = "/", mustWork = TRUE)
    dir <- normalizePath(dir, winslash = "/", mustWork = TRUE)
    if (isWindows()) 
        dir <- sub("/$", "", dir)
    if (nchar(abs.path) <= nchar(dir) + 1) 
        return(NULL)
    if (substr(abs.path, 1, nchar(dir)) != dir || substr(abs.path, 
        nchar(dir) + 1, nchar(dir) + 1) != "/") {
        return(NULL)
    }
    return(abs.path)
}


runExample2 <- function (example = NA, port = NULL, launch.browser = getOption("shiny.launch.browser", 
    interactive()), host = getOption("shiny.host", "127.0.0.1"), 
    display.mode = c("auto", "normal", "showcase")) 
{
    examplesDir <- system.file("examples", package = "shiny")
    dir <- resolve(examplesDir, example)
    if (is.null(dir)) {
        if (is.na(example)) {
            errFun <- message
            errMsg <- ""
        }
        else {
            errFun <- stop
            errMsg <- paste("Example", example, "does not exist. ")
        }
        errFun(errMsg, "Valid examples are \"", paste(list.files(examplesDir), 
            collapse = "\", \""), "\"")
    }
    else {
        shinyAppDir(appDir = dir
)
    }
}


runExample2("01_hello")
```