Dynamiczne wybieranie wielu kart w błyszczącej aplikacji

Question

Mam duży zestaw danych z wieloma wymiarami. Tworzę eksplorator danych, który moim zdaniem będzie bardziej przyjazny dla użytkownika, jeśli dane można wybierać na wielu kartach, a nie na naprawdę długim pasku bocznym. Grałem wokół tej koncepcji z minimalnym przykładem roboczym (poniżej), ale nie mogę przejść do zakładki wydruku, gdy kliknę przycisk Widok działki. Reaktywność zadziała, gdy tylko kliknę kartę fabuły, ale nie zareaguje, gdy zaktualizuję niektóre selekcje (takie jak liczba klastrów).

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:

Udało nam się w pełni wdrożyć „Widok danych” i „powrót do wyboru” przycisków przy użyciu roztworu @jdharrison w pierwszych dwóch kartach http://www.wittgensteincentre.org/dataexplorer

Answer 1

myślę, że właśnie trzeba uprościć ostateczną logikę JavaScript. Są odniesienia do elementu z id = summary których nie masz itd myślę chcesz to mieć twoje przyciski kliknij na odpowiednie linki zakładka:

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

wprowadzenie go wszystkie razem:

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