Question

我有一个包含多个维度的大型数据集。我正在创建一个数据资源管理器，我相信如果可以通过多个选项卡选择数据，而不是从非常长的侧边栏中选择数据，那么它将更加用户友好。我用最小的工作示例（下面）一直在玩这个概念，但是当我点击View Plot按钮时我无法切换到Plot选项卡。单击“绘图”选项卡后，反应性将起作用，但是当我更新某些选择（例如群集数量）时，它不会做出反应。

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解决方案管理完全实现“查看数据”和“返回选择”按钮

Answer 1

我认为您只需要简化最终的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()
   })
 }
))

动态选择闪亮应用中的多个标签

1 个答案: