Dynamically selecting over multiple tabs in a shiny app

Question

I have a large data set with multiple dimensions. I am creating a data explorer where I believe it will be more user friendly if data can be selected over multiple tabs, rather than from a really long sidebar. I have been playing around this concept with a minimal working example (below), but I am unable to switch to the Plot tab when I click on the View Plot button. The reactivity will work once I have I clicked on the Plot tab, but it does not react when I update some of the selections (such as number of clusters).

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()
   })
 }
))

UPDATE:

Managed to fully implement a "View Data" and "Back to Selection" buttons using the solution of @jdharrison in the first two tabs of http://www.wittgensteincentre.org/dataexplorer

Answer 1

I think you just need to simplify your final JavaScript logic. There are references to an element with id = summary which you dont have etc. I think all you want is to have your buttons click on the relevant tab links:

        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();
                     })")

Putting it all together:

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()
   })
 }
))