R闪亮的应用程序之间的构建链接

Question

我有两个闪亮的应用程序，我想将一个链接到另一个。一个有一个数据表，其中包含一些我想链接到另一个应用程序的值，我可以从selectInput 选项中选择这个值。

总结一下，我有一个看起来像这样的应用程序（取自here）：

library(shiny)
library(DT)

server <- function(input, output) {
  output$iris_type <- DT::renderDataTable({
    datatable(data.frame(Species=paste0("<a href='#filtered_data'>", unique(iris$Species), "</a>")),
              escape = FALSE,
              callback = JS(
                'table.on("click.dt", "tr", function() {
                tabs = $(".tabbable .nav.nav-tabs li a");
                $(tabs[1]).click();})'))
  })

  output$filtered_data <- DT::renderDataTable({
    selected <- input$iris_type_rows_selected
    if(is.null(selected)){
      datatable(iris)
    } else {
      datatable(iris[iris$Species %in% unique(iris$Species)[selected], ])
    }
  })
}

ui <- shinyUI(fluidPage(
  mainPanel(
    tabsetPanel(
      tabPanel("Iris Type", DT::dataTableOutput("iris_type")),
      tabPanel("Filtered Data", DT::dataTableOutput("filtered_data"))
    )
  )
))

shinyApp(ui = ui, server = server)

还有一个：

library(shiny)
library(dplyr)
library(tidyr)

data(iris)  

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

  iris1 <- reactive({
    iris %>% 
      filter(Species %in% input$select)
  })

  output$filtered_data <- DT::renderDataTable({
    datatable(iris1())
  })
})

ui <- shinyUI(fluidPage(
  mainPanel(
    selectInput("select", label=h3("Iris Type"), choices=list('setosa', 'versicolor', 'virginica'),
                selected='setosa', multiple=FALSE),
    DT::dataTableOutput("filtered_data")

  )
))

shinyApp(ui = ui, server = server)

（我知道这是一个愚蠢的例子，但它显示了我想要的）

当我点击第一个应用程序中的一个物种时，我希望它将我链接到第二个应用程序而不是另一个选项卡，然后从第一个应用程序中选择点击的物种（见下图）。

我想我必须将链接从 "<a href='#filtered_data'>", unique(iris$Species), "</a>" 更改为我的另一个应用程序的链接，但我不知道如何在第二个应用程序中更改我的 selectInput 选项的值。请帮忙。

Answer 1

修改我之前的回复，（因为同意，应该有一个更简单的解决方案）

相反，这是一个基于挖掘会话对象的解决方案：

如果你通过

打开第二个闪亮的应用程序

<a href="http://server.com/app2?Species=setosa">

（将 server.com/app2 更改为您的实际链接） 然后在第二个应用程序中，将其包含在选择对象中：

编辑：请注意，由于这依赖于会话对象，因此您的服务器功能将从 function(input,output) 更改为 function(input,output,session)

ui.R:

htmlOutput('selectSpecies')

服务器.R：

output$selectSpecies <- renderUI({
    URLvars <- session$clientData$url_search
    # NOTE: the following regex is not one-size-fits-all
    # if you use multiple inputs, you'll probably need to adjust it
    # also remove special characters, because I want to sanitize our inputs

    Species <- gsub('[[:punct:]]','',URLvars)
    Species <- sub('^.*Species(.*$)','\\1',URLvars)

    selectInput("select", label=h3("Iris Type"), choices=list('setosa',    'versicolor', 'virginica'),
            selected=ifelse(Species=="",'setosa',Species), multiple=FALSE)
})

所以会话对象确实包含它打开时使用的 url 部分，所以只需将该信息转换为我们可以使用的变量即可。