如何在 Shiny 的应用程序中调用应用程序

Question

我有一个 Shiny 应用程序目录，如下所示：

-- ShinyApps
     |
     |_ base_app
     |_ my_sub_app

在base_app 我有以下代码：

# app.R

#-----------
# Server Section
#-----------
server <- function(input, output) { }

#-----------
# UI section
#-----------

ui <- fixedPage(

  h1("My head"),
  br(),

  br(),

  fluidRow(

      column(6,
             wellPanel(
               h3("AMAZON"),
               hr(),
               a("Go", class = "btn btn-primary btn-md", 
                 href = "http://www.amazon.com")
             )),

      column(6,
             wellPanel(
               h3("My Sub App"),
               hr(),
               a("Go", class = "btn btn-primary btn-md")
               # What should I do here to include My_SUB_APP
             ))


    )




)


shinyApp(ui = ui, server = server)

看起来像这样：

我想要做的是，当点击My SubApp面板下的Go按钮时，它 将启动sub_app()我该怎么做？

我不想传递 URL（例如通过 href）

Answer 1

好的，经过进一步分析，这在技术上是可行的。

（但是带有 href 的链接解决方案几乎肯定会更好，问题是 Shiny Server 或 RStudio Connect 或您用于托管应用程序的任何产品都需要已经加载应用程序才能访问它，所以为什么不直接链接到它的托管位置？）

此解决方案没有明显的“加载此目录”工作流程，而是专门加载 server.R 和 ui.R 文件

为了覆盖当前的 UI 和服务器，您需要从字面上覆盖 ui 和服务器。

覆盖 ui 很容易，您只需从头开始在服务器端渲染整个内容，然后在他们决定按下按钮时交换 ui。

覆盖服务器是评估子APP的服务器功能的问题，（这可能绝对有命名空间冲突，但对于一个简单的应用程序来说可能是可能的）

这是一个例子。

app.R 文件：

#-----------
# UI section
#-----------

ui1 <- fixedPage(

  h1("My head"),
  br(),

  br(),

  fluidRow(

    column(6,
           wellPanel(
             h3("AMAZON"),
             hr(),
             a("Go", class = "btn btn-primary btn-md", 
               href = "http://www.amazon.com")
           )),

    column(6,
           wellPanel(
             h3("My Sub App"),
             hr(),
             a("Go", 

               # Link button to input$SubApp1
               id = 'SubApp1', 
               class = "btn btn-primary btn-md action-button")

           ))


  )
)

appUI <- parse(file = 'subdir/ui.R')
appServer <- eval(parse(file = 'subdir/server.R'))

#-----------
# Server Section
#-----------
server <- function(input, output, session) { 
  output[['fullPage']] <- renderUI({

    if(!is.null(input$SubApp1) && input$SubApp1 > 0) {
      # If they pressed the button once,
      # run the appServer function and evaluate the parsed appUI code
      appServer(input, output, session)
      eval(appUI)
    } else {
      # 
      ui1
    }
  })
}

ui <- uiOutput('fullPage')

shinyApp(ui = ui, server = server)

subdir/ui.R（示例）：

page <- 
  navbarPage("X-men",id = "navibar",
             tabPanel("placeholder"),
             tabPanel("Plot",value = "plot"),
             selected = "plot"
  )
page[[3]][[1]]$children[[1]]$children[[2]]$children[[1]] <- 
  tags$li(tags$a(
    href = 'http://google.com', 
    icon("home", lib = "glyphicon") 
  )
  )
page

subdir/server.R（示例）：

function(input, output, session) {

}