我有一个包含多个维度的大型数据集。我正在创建一个数据浏览器，我相信如果可以通过多个选项卡而不是从非常长的侧边栏选择数据，它将更加用户友好。我一直在用一个最小的工作示例(如下)来研究这个概念，但是当我单击“查看绘图”按钮时，我无法切换到“绘图”选项卡。一旦我单击“绘图”选项卡， react 性就会起作用，但当我更新某些选择(例如簇数)时它不会 react 。

library(shiny)

runApp(list(
  ui = shinyUI(fluidPage(
    headerPanel('Iris k-means clustering'),
    mainPanel(
      tabsetPanel(
        type = "tabs", 
        tabPanel(title = "Select X", 
                 selectInput('xcol', 'X Variable', names(iris)),
                 HTML("<div id='linkToY'><FORM><INPUT Type='BUTTON' VALUE='Next'></FORM></div>") ),
        tabPanel(title = "Select Y", 
                 selectInput('ycol', 'Y Variable', names(iris), selected=names(iris)[[2]]),
                 HTML("<div id='linkToClusters'><FORM><INPUT Type='BUTTON' VALUE='Next'></FORM></div>") ),
        tabPanel("Select Clusters", numericInput('clusters', 'Cluster count', 3, min = 1, max = 9),
                 HTML("<div id='linkToPlot'><FORM><INPUT Type='BUTTON' VALUE='View Plot'></FORM></div>"),
                 HTML("<div id='linkToData'><FORM><INPUT Type='BUTTON' VALUE='View Data'></FORM></div>") ),
        tabPanel(title = "Plot", plotOutput('plot1')),
        tabPanel(title = "Data", 
                 dataTableOutput(outputId="table"),
                 HTML("<script>$('#linkToY').click(function() {
                       tabs = $('.tabbable .nav.nav-tabs li')
                       tabs.each(function() {
                       $(this).removeClass('active')
                       })
                       $(tabs[1]).addClass('active')
                       tabsContents = $('.tabbable .tab-content .tab-pane')
                       tabsContents.each(function() {
                       $(this).removeClass('active')
                       })
                       $(tabsContents[1]).addClass('active')
                       $('#summary').trigger('change').trigger('shown');
                       })</script>"),
                 HTML("<script>$('#linkToClusters').click(function() {
                       tabs = $('.tabbable .nav.nav-tabs li')
                       tabs.each(function() {
                       $(this).removeClass('active')
                       })
                       $(tabs[2]).addClass('active')
                       tabsContents = $('.tabbable .tab-content .tab-pane')
                       tabsContents.each(function() {
                       $(this).removeClass('active')
                       })
                       $(tabsContents[2]).addClass('active')
                       $('#summary').trigger('change').trigger('shown');
                       })</script>"),
                 HTML("<script>$('#linkToPlot').click(function() {
                       tabs = $('.tabbable .nav.nav-tabs li')
                       tabs.each(function() {
                       $(this).removeClass('active')
                       })
                       $(tabs[3]).addClass('active')
                       tabsContents = $('.tabbable .tab-content .tab-pane')
                       tabsContents.each(function() {
                       $(this).removeClass('active')
                       })
                       $(tabsContents[3]).addClass('active')
                       $('#summary').trigger('change').trigger('shown');
                       })</script>"),
                 HTML("<script>$('#linkToData').click(function() {
                       tabs = $('.tabbable .nav.nav-tabs li')
                       tabs.each(function() {
                       $(this).removeClass('active')
                       })
                       $(tabs[4]).addClass('active')
                       tabsContents = $('.tabbable .tab-content .tab-pane')
                       tabsContents.each(function() {
                       $(this).removeClass('active')
                       })
                       $(tabsContents[4]).addClass('active')
                       $('#summary').trigger('change').trigger('shown');
                       })</script>")
        )
      )
     )
   )),
  server = function(input, output) {
   selectedData <- reactive({
     iris[, c(input$xcol, input$ycol)]
   })
   clusters <- reactive({
     kmeans(selectedData(), input$clusters)
   })
   output$plot1 <- renderPlot({
     plot(selectedData(),
          col = clusters()$cluster,
          pch = 20, cex = 3)
     points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
   })
   output$table <- renderDataTable({
     selectedData()
   })
 }
))

更新:

在 http://www.wittgensteincentre.org/dataexplorer 的前两个选项卡中使用@jdharrison 的解决方案设法完全实现“查看数据”和“返回选择”按钮。

最佳答案

我认为您只需要简化最终的 JavaScript 逻辑。有对带有 id = summary 的元素的引用，而你没有等等。我想你想要的只是让你的按钮点击相关的标签链接:

        tabPanel(title = "Plot", plotOutput('plot1')),
        tabPanel(title = "Data", dataTableOutput(outputId="table")), 
        tags$script("$('#linkToY').click(function() {
                     tabs = $('.tabbable .nav.nav-tabs li a');
                     $(tabs[1]).click();
                     })"),
        tags$script("$('#linkToClusters').click(function() {
                     tabs = $('.tabbable .nav.nav-tabs li a');
                     $(tabs[2]).click();
                     })"),
        tags$script("$('#linkToPlot').click(function() {
                     tabs = $('.tabbable .nav.nav-tabs li a');
                     $(tabs[3]).click();
                     })"),
        tags$script("$('#linkToData').click(function() {
                     tabs = $('.tabbable .nav.nav-tabs li a');
                     $(tabs[4]).click();
                     })")

综合起来:

library(shiny)

runApp(list(
  ui = shinyUI(fluidPage(
    headerPanel('Iris k-means clustering'),
    mainPanel(
      tabsetPanel(
        type = "tabs", 
        tabPanel(title = "Select X", 
                 selectInput('xcol', 'X Variable', names(iris)),
                 HTML("<div id='linkToY'><FORM><INPUT Type='BUTTON' VALUE='Next'></FORM></div>") ),
        tabPanel(title = "Select Y", 
                 selectInput('ycol', 'Y Variable', names(iris), selected=names(iris)[[2]]),
                 HTML("<div id='linkToClusters'><FORM><INPUT Type='BUTTON' VALUE='Next'></FORM></div>") ),
        tabPanel("Select Clusters", numericInput('clusters', 'Cluster count', 3, min = 1, max = 9),
                 HTML("<div id='linkToPlot'><FORM><INPUT Type='BUTTON' VALUE='View Plot'></FORM></div>"),
                 HTML("<div id='linkToData'><FORM><INPUT Type='BUTTON' VALUE='View Data'></FORM></div>") ),
        tabPanel(title = "Plot", plotOutput('plot1')),
        tabPanel(title = "Data", dataTableOutput(outputId="table")), 
        tags$script("$('#linkToY').click(function() {
                     tabs = $('.tabbable .nav.nav-tabs li a');
                     $(tabs[1]).click();
                     })"),
        tags$script("$('#linkToClusters').click(function() {
                     tabs = $('.tabbable .nav.nav-tabs li a');
                     $(tabs[2]).click();
                     })"),
        tags$script("$('#linkToPlot').click(function() {
                     tabs = $('.tabbable .nav.nav-tabs li a');
                     $(tabs[3]).click();
                     })"),
        tags$script("$('#linkToData').click(function() {
                     tabs = $('.tabbable .nav.nav-tabs li a');
                     $(tabs[4]).click();
                     })")
      )
     )
   )),
  server = function(input, output) {
   selectedData <- reactive({
     iris[, c(input$xcol, input$ycol)]
   })
   clusters <- reactive({
     kmeans(selectedData(), input$clusters)
   })
   output$plot1 <- renderPlot({
     plot(selectedData(),
          col = clusters()$cluster,
          pch = 20, cex = 3)
     points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
   })
   output$table <- renderDataTable({
     selectedData()
   })
 }
))

关于javascript - 在 Shiny 的应用程序中动态选择多个选项卡，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/27145572/