Selezione dinamica su più schede in un'app lucida

Question

Ho un grande set di dati con più dimensioni. Sto creando un data explorer in cui credo che sarà più facile da usare se i dati possono essere selezionati su più schede, piuttosto che da una barra laterale molto lunga. Ho giocato a questo concetto con un esempio di lavoro minimo (sotto), ma non sono in grado di passare alla scheda Plot quando clicco sul pulsante Visualizza grafico. La reattività funzionerà quando avrò fatto clic sulla scheda Plot, ma non reagisce quando aggiorno alcune selezioni (come il numero di cluster).

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:

Gestito ad attuare pienamente un "Visualizza dati" e "Back to Selection" pulsanti che utilizzano la soluzione di @jdharrison nelle prime due schede di http://www.wittgensteincentre.org/dataexplorer

Answer 1

io ti penso solo necessità di semplificare la tua logica JavaScript finale. Ci sono riferimenti a un elemento con id = summary che non avete ecc Penso che tutto quello che volete è di avere i pulsanti cliccare sui relativi link scheda:

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

Mettere tutto insieme:

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