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

时间:2017-04-06 06:08:22

标签: r shiny

我有一个Shiny apps目录,如下所示:

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

看起来像这样:

enter image description here

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

我不想传递网址(例如通过href

1 个答案:

答案 0 :(得分:2)

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

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

此解决方案没有明显的“加载此目录”工作流程,并且涉及专门加载server.R和ui.R文件

为了覆盖当前的UI和服务器,您需要逐字覆盖ui和服务器。

覆盖ui很简单,你只需从头开始在服务器端渲染整个东西,然后在他们决定按下按钮时交换ui。

覆盖服务器是评估subAPP的服务器功能的问题(可能绝对存在命名空间冲突,但对于简单的应用程序可能是可能的)

以下是一种实现方法的示例。

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

}