Parlak uygulamada birden fazla sekmeyi dinamik olarak seçme

Question

Birden çok boyuta sahip büyük bir veri kümem var. Veriler çok uzun sekmelerden ziyade birden çok sekme üzerinden seçilebilirse daha kullanıcı dostu olacağına inandığım bir veri gezgini oluşturuyorum. Bu konsept etrafında en az bir çalışma örneği (altta) ile oynuyordum, ancak View Plot düğmesini tıkladığımda Plot sekmesine geçemiyorum. Plot sekmesine tıkladığımda reaktivite çalışacaktır, ancak bazı seçimleri (kümelerin sayısı gibi) güncellediğimde tepki vermiyor.

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

GÜNCELLEME: Tamamen "Geri Seçimi" http://www.wittgensteincentre.org/dataexplorer

Answer 1

ilk iki sekmelerde @jdharrison çözümünü kullanarak düğmeleri bir "Görünüm Verileri" ve uygulamak için Yönetilen

sadece seni düşünüyorum Son JavaScript mantığınızı basitleştirmeniz gerekir. Hepsini bir araya getirirsek

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