多个Web应用程序R闪亮

Question

假设我有 2 个操作按钮作为起始页面“客户”和“员工”，如下所示，并且对于每个选项，都有一个不同的 Web 应用程序。

当用户单击“客户端”按钮时，我需要运行以下代码：

library(shiny)

ui <- 
navbarPage(
"The Client Web",
tabPanel("Section1 "),
tabPanel(" Section1 2")
)

server <- function(input, output,session){

}

shinyApp(ui = ui, server = server)

当用户单击“员工”按钮时，我需要运行以下代码：

 library(shiny)

 ui <- 
 navbarPage(
 "The Employee Web",
 tabPanel("Component 1"),
 tabPanel("Component 2"),
  tabPanel("Component 3")
  )

  server <- function(input, output,session){

  }

 shinyApp(ui = ui, server = server)

我需要在一个应用程序中使用这两个 Web 应用程序，具体取决于用户的类型“客户”或“员工”。预先感谢您！

Answer 1

使用JavaScript

我会使用 Javascript 代码来隐藏/显示任一页面。

您必须使用按钮和两个导航栏页面创建应用程序。

library(shiny)

ui <- fluidPage(
  # Buttons
  actionButton('clientsBtn', 'Clients'),
  actionButton('employeeBtn', 'Employee'),
  
  # Employee pag
  div(
    class = 'employees-page',
    navbarPage(
      "The Employee Web",
      tabPanel("Component 1"),
      tabPanel("Component 2"),
      tabPanel("Component 3")
    )
  ),
  
  # Clients page
  div(
    class = 'clients-page',
    navbarPage(
      "The Client Web",
      tabPanel("Section1 "),
      tabPanel(" Section1 2")
    )
  ),

  # Javascript to control de page logic
includeScript('script.js')
)

server <- function(input, output,session){
  
  
}

shinyApp(ui = ui, server = server)

script.js 文件只是一个具有该扩展名的文本文件。

// hide by default the clients page
$('.clients-page').hide(); 

$('#clientsBtn').on('click', () => { 
  $('.employees-page').hide(); 
  $('.clients-page').show();
})

$('#employeeBtn').on('click', ()=>{ 
  $('.employees-page').show(); 
  $('.clients-page').hide(); 
})

使用shiny.router的单独页面

正如我所承诺的，这是使用

{shiny.router}

来完成你想要的事情的方法。

library(shiny)
library(shiny.router)

# The root page is separated from clients and employee pages
# and contains two buttons/links that takes you the destination
# you wish

root_page <- tagList(
  tags$a(
  div(class='btn btn-default', id='clientsBtn', 'Clients'),
  href=route_link('clients')
  ),
  
  tags$a(
    div(class='btn btn-default', id='employeeBtn', 'Employee'), 
    href=route_link('employees')
    )
)

# The employee and clients page should include a button/link
# to take you back to the root page. I place the button in the
# first tabpanel of each page, but for better ux is good idea
# if you place it in all of them. Consider change its style and
# position using css configuration.

employee_page <- tagList(
  navbarPage(
    "The Employee Web",
    tabPanel(
      "Component 1",
      tags$a(
        div(class='btn btn-default', id='home1', 'Home'), 
        href=route_link('/')
      )
      ),
    tabPanel("Component 2"),
    tabPanel("Component 3")
  )
)


clients_page <- tagList(
  navbarPage(
    "The Client Web",
    tabPanel(
      "Section1 ",
      tags$a(
        div(class='btn btn-default', id='home1', 'Home'), 
        href=route_link('/')
      )
      ),
    tabPanel(" Section1 2")
  )
)

router <- make_router(
  route("/", root_page),
  route("employees", employee_page),
  route("clients", clients_page)
)

ui <- fluidPage(
  router$ui
)

server <- function(input, output, session) {
  router$server(input, output, session)
}

shinyApp(ui, server)

Answer 2

我得到了这些结果：

当我尝试以下代码时：

library(shiny)
library(shiny.router)


Cleints_page <- div(
titlePanel("Cleints"),
p("This is the Cleints web app")
)

Employees_page <- div(
titlePanel("Employees"),
p("This is the Employees web app")
)

router <- make_router(
route("/", Cleints_page),
route("employees", Employees_page)
)


 ui <- fluidPage(
 tags$ul(
  tags$li(a(href = route_link("/"), "Cleints 
  Web")),
  tags$li(a(href = route_link("employees"), 
  "Employees Web"))
  
  ),
  router$ui
  )

  server <- function(input, output, session) {
  router$server(input, output, session)
  }

  shinyApp(ui, server)

但是，我仍然需要它们每个都是一个单独的页面。我怎样才能实现这一目标？

Answer 3

按照这个答案，您可以调整闪亮成为这样的多页面应用程序：

library(shiny)

start_web <- shiny::fillPage(
  a(
    href = "client",
    "Client",
    class = "btn btn-primary"
  ),
  a(
    href = "employer",
    "Employer",
    class = "btn btn-secondary"
  )
)

client_web <- navbarPage(
  title = div(
    "The Client Web",
    # poormans breadcrumbs
    a(href = "start", "Start"), ">", a(href = "client", "Client")
  ),

  tabPanel("Section1 1", "Client Stuff 1"),
  tabPanel("Section1 2", "Client Stuff 2")

)

employer_web <- navbarPage(
  title = div(
    "The Employers Web",
    # poormans breadcrumbs
    a(href = "start", "Start"), ">", a(href = "employer", "Employer")
  ),

  tabPanel("Section2 1", "Employer Stuff 1"),
  tabPanel("Section2 2", "Employer Stuff 2")
)

server <- function(input, output,session) {
  # use shiny module for employer/client UI + server
  # add all servers here
}

ui <- function(req) {
  if (req$PATH_INFO %in% c("/", "/start")) {
    start_web
  } else if (req$PATH_INFO == "/client") {
    client_web
  } else if (req$PATH_INFO == "/employer") {
    employer_web
  } else {
    "404 Not Found"
  }
}

shinyApp(ui = ui, server = server, uiPattern = "/|/api")

起始页：

示例页面：