在两个闪亮的应用程序之间切换

所以我有两个独立的onefileshinyApps，带有 UI 和服务器，位于一个函数内。

现在我需要做的是在第一个应用程序中调用第二个应用程序。

这是一个简单的示例（功能被简化以显示我想要实现的功能）：

appOne <- function() {
  app <- list(ui = NULL, server = NULL)
  app$ui <- fluidPage(fluidRow(
    column(3),
    mainPanel(h2("Welcome to the load page"),actionButton("browse", strong("Browse Variants"), class = "btn-success")))
  )
  app$server <- function(input, output, session) {
    observeEvent(input$browse, {
      appTwo()
    })
  }
  runApp(app)
}

appTwo <- function() {
  app <- list(ui = NULL, server = NULL)
  app$ui <- fluidPage(fluidRow(
    column(3),
    mainPanel(h2("Welcome to appTwo"), plotOutput("plot")))
  )
  app$server <- function(input, output, session) {
    output$plot <- renderPlot({
      plot(cars)
    })
  }
  runApp(app)
}

所以我需要的是当用户单击第一个应用程序中的按钮时切换到第二个应用程序。有任何想法吗？

我面临着同样的问题。这是我的解决方案。它需要使用更大且独立的应用程序进行测试，但它听起来回答了您的问题。

我添加了一个选择器应用程序（名为appRoute，但实际上路由功能是通过无限循环来保证的）。每个应用程序都需要有一个退出按钮。应用程序通过返回/停止代码（闪亮的 stopApp 函数）进行通信。闪亮的打印功能正在调用闪亮的runApp功能。

通过将附加按钮链接到特定的 stopApp，应该可以在应用程序之间切换（无需返回选择器应用程序）。我不知道是否可以在应用程序之间传输信息（也许使用会话），但我将使用磁盘文件来实现这一点。

如果您找到更好的解决方案，请告诉我。

library(shiny)
library(shinyjs)

# The tab need to be closed programmatically; here is a quick solution
# https://github.com/daattali/advanced-shiny/blob/master/close-window/app.R
jscode <- "shinyjs.closeWindow = function() { window.close(); }"


# App One
appOne <- list(
  ui = fluidPage(
    useShinyjs(),
    extendShinyjs(text = jscode, functions = c("closeWindow")),
    fluidRow(
      column(3),
      mainPanel(h2("Welcome to the load page"),
                plotOutput("plot"),
                actionButton("quit", "QUIT", class = "btn-warning")))
  ),
  server = function(input, output, session) {
    output$plot <- renderPlot({
      with(cars, hist(dist, breaks = 10))
    })
    observeEvent(input$quit,  { js$closeWindow(); stopApp("appRoute") })
  }
)

# App TWO
appTwo <- list(
  ui = fluidPage(
    useShinyjs(),
    extendShinyjs(text = jscode, functions = c("closeWindow")),
    fluidRow(
      column(3),
      mainPanel(h2("Welcome to appTwo"),
                plotOutput("plot"),
                actionButton("quit", "QUIT", class = "btn-warning")))
  ),
  server = function(input, output, session) {
    output$plot <- renderPlot({
      plot(cars)
    })
    observeEvent(input$quit,  { js$closeWindow(); stopApp("appRoute") })
  }
)

# Router
appRoute <- list(
  ui = fluidPage(
    useShinyjs(),
    extendShinyjs(text = jscode, functions = c("closeWindow")),
    fluidRow(
      column(3),
      mainPanel(h2("Welcome to Selector"), 
                actionButton("appOne", "AppOne"), 
                actionButton("appTwo", "AppTwo"), 
                actionButton("appEnd", "END", class = "btn-danger")
      ))
  ),
  server = function(input, output, session) {
    observeEvent(input$appOne, { js$closeWindow(); stopApp("appOne") })
    observeEvent(input$appTwo, { js$closeWindow(); stopApp("appTwo") })
    observeEvent(input$appEnd, { js$closeWindow(); stopApp("appEnd") })
  }
)

# Main loop
route <- "appRoute"
while (TRUE) {
  app <- switch(
    route,
    appRoute = shinyApp(appRoute$ui, appRoute$server),
    appOne = shinyApp(appOne$ui, appOne$server),
    appTwo = shinyApp(appTwo$ui, appTwo$server),
    appEnd = "END"
  )
  if (is.null(app)) {  # not matched
    warning("Unknown route ", route)
    route <- "appRoute"
    next
  } else if (is.character(app)) {  # final end
    message("Ending")
    break
  }
  # Execute a new app and retrieve return code
  route <- print(app)
  message("New route ", route)
  # browser()
}