从一个DataTable到另一个闪亮的超链接

Question

我有一个闪亮的应用程序，由两页组成：

• 第1页显示带有摘要信息的DataTable (ensembles)。
• 第2页显示了详细的价格信息(items)的一个特定的集合，这是可选择的。

当用户单击第1页上的一行时，我希望他们被带到第2页，并选择相应的集合。

​

​

下面的代码创建了闪亮的应用程序和两个页面，但需要用户切换页面并手动输入集合编号。

app.R

library(shiny)

## Create item pricing data
set.seed(1234)
init_items = function() {
  item.id=1:1000
  ensemble.id=rep(1:100,each=10)
  cost=round(runif(1000,10,100), 2)
  profit=round(cost*runif(1000,0.01,0.15), 2)
  price=cost+profit

  data.frame(item.id, ensemble.id, cost, price, profit)
}
items = init_items()

## Create ensemble pricing data
init_ensembles = function(items) {
  items %>% group_by(ensemble.id) %>% summarize_each(funs(sum), cost, price, profit)
}
ensembles = init_ensembles(items)

## Attach dependencies
## https://github.com/timelyportfolio/functionplotR/issues/1#issuecomment-224369431
getdeps <- function() {
  htmltools::attachDependencies(
    htmltools::tagList(),
    c(
      htmlwidgets:::getDependency("datatables","DT")
    )
  )
}

# Define UI for application
ui <- shinyUI(
  navbarPage("Linked Table Test",
             tabPanel("Page 1", uiOutput("page1")),
             tabPanel("Page 2", uiOutput("page2"), getdeps())
  )
)

# Define server logic
server <- shinyServer(function(input, output, session) {
  output$page1 <- renderUI({
    inclRmd("./page1.Rmd")
  })

  output$page2 <- renderUI({
    inclRmd("./page2.Rmd")
  })
})


# Run the application
shinyApp(ui = ui, server = server)

页面1.

# Ensembles

Click on an ensemble to display detailed pricing information.
```{r}

标签$div(

DT：：renderDataTable(集成，行名= FALSE)

)

页面2.

# Items

```{r}

inputPanel(

numericInput("ensemble.id"，标签=“集成ID:"，0，min(ensembles$ensemble.id)，max(ensembles$ensemble.id))

)

标签$div(

renderText(paste0(“集合的详细定价信息”，input$ensemble.id，":"))

)

标签$div(

DT：：renderDataTable(条目%>% filter(ensemble.id==input$ensemble.id) %>% select(-ensemble.id)，行名= FALSE)

)

Answer 1

这应该给你提供工具来做你想做的事：

library(shiny)
library(DT)
ui <- fluidPage(
  tabsetPanel(
    tabPanel("One",
             DT::dataTableOutput("test1")
    ),
    tabPanel("two",
             numericInput("length","Length",0,0,10)
    )))
server <- function(input, output, session) {
  df <- reactive({
    cbind(seq_len(nrow(mtcars)),mtcars)
  })
  output$test1 <- DT::renderDataTable({
    df()
  },rownames=FALSE,options=list(dom="t"),
  callback=JS(
    'table.on("click.dt", "tr", function() {

    tabs = $(".tabbable .nav.nav-tabs li a");
    var data=table.row(this).data();

    document.getElementById("length").value=data[0];
    Shiny.onInputChange("length",data[0]);
    $(tabs[1]).click();
    table.row(this).deselect();})'
  ))

}
shinyApp(ui = ui, server = server)

单击datatable中的一行时，它将切换选项卡，并将数字输入的值更改为所选行中第一列的值。

编辑:您可能必须显式地将您的数据存储在闪亮的应用程序中，而不是从r标记脚本中包含它们，因为我不认为readable中的闪亮对象具有可靠可读的html Ids。

编辑:我拿走了你的代码，并让它开始工作：

library(shiny)
library(dplyr)
## Create item pricing data
set.seed(1234)
init_items = function() {
  item.id=1:1000
  ensemble.id=rep(1:100,each=10)
  cost=round(runif(1000,10,100), 2)
  profit=round(cost*runif(1000,0.01,0.15), 2)
  price=cost+profit

  data.frame(item.id, ensemble.id, cost, price, profit)
}
items = init_items()

## Create ensemble pricing data
init_ensembles = function(items) {
  items %>% group_by(ensemble.id) %>% summarize_each(funs(sum), cost, price, profit)
}
ensembles = init_ensembles(items)

## Attach dependencies
## https://github.com/timelyportfolio/functionplotR/issues/1#issuecomment-224369431
getdeps <- function() {
  htmltools::attachDependencies(
    htmltools::tagList(),
    c(
      htmlwidgets:::getDependency("datatables","DT")
    )
  )
}

# Define UI for application
ui <- shinyUI(fluidPage(
  tabsetPanel(#id="Linked Table Test",
    tabPanel("Page 1", DT::dataTableOutput("page1")),
    tabPanel("Page 2", inputPanel(
      numericInput("ensemble.id", label = "Ensemble ID:", 0, min(ensembles$ensemble.id), max(ensembles$ensemble.id))
    ),
    textOutput("page2"), DT::dataTableOutput("table2"),getdeps())
  )
))

# Define server logic
server <- shinyServer(function(input, output, session) {
  output$page1 <- DT::renderDataTable(ensembles, rownames = FALSE,
                                      callback=JS(
                                        'table.on("click.dt", "tr", function() {

    tabs = $(".tabbable .nav.nav-tabs li a");
    var data=table.row(this).data();
    document.getElementById("ensemble.id").value=data[0];
    Shiny.onInputChange("ensemble.id",data[0]);
    $(tabs[1]).click();
    table.row(this).deselect();
    })'                     
                                      ))


  output$table2 <- DT::renderDataTable(items %>% filter(ensemble.id==input$ensemble.id) %>% select(-ensemble.id), rownames = FALSE)

  output$page2 <- renderText({
    print(input$ensemble.id)
    paste0("Detailed pricing information for ensemble #",input$ensemble.id,":")
  })
})


# Run the application
shinyApp(ui = ui, server = server)