在 Shiny App 中与 plotly 或 googlevis 图表交互地设置数据

Question

R 古格斯，

有没有办法通过点击闪亮应用程序中的交互式绘图或 googlevis 图表来对 data.table 中的数据进行子集和查看？

例如，当我点击以下代码生成的 plotly 图表上的相关部分时，我希望看到图中突出显示的行：

  library(shiny)
  library(plotly)
  library(DT)
  library(dplyr)

  shinyApp(
    ui = shinyUI(fluidPage(
      titlePanel("Movie Ratings!"),

      mainPanel(
        plotlyOutput("chart", width = "100%"),
        dataTableOutput("DToutput")
      )
    )),

    server = function(input, output, session) {

      df <- structure(c(106487,495681,1597442,2452577,2065141,2271925,4735484,3555352,8056040,4321887,
                        2463194,347566,621147,1325727,1123492,800368,761550,1359737,1073726,36,53,141,
                        41538,64759,124160,69942,74862,323543,247236,112059,16595,37028,153249,427642,
                        1588178,2738157,2795672,2265696,11951,33424,62469,74720,166607,404044,426967,
                        38972,361888,1143671,1516716,160037,354804,996944,1716374,1982735,3615225,
                        4486806,3037122,17,54,55,210,312,358,857,350,7368,8443,6286,1750,7367,14092,
                        28954,80779,176893,354939,446792,33333,69911,53144,29169,18005,11704,13363,
                        18028,46547,14574,8954,2483,14693,25467,25215,41254,46237,98263,185986),
                      .Dim=c(19,5),.Dimnames=list(c("1820-30","1831-40","1841-50","1851-60","1861-70",
                                                    "1871-80","1881-90","1891-00","1901-10","1911-20",
                                                    "1921-30","1931-40","1941-50","1951-60","1961-70",
                                                    "1971-80","1981-90","1991-00","2001-06"),
                                                  c("Europe","Asia","Americas","Africa","Oceania")))
      df.m <- melt(df)
      df.m <- rename(df.m, c(Var1 = "Period", Var2 = "Region"))


      output$chart <- renderPlotly({

        a <- ggplot(df.m, aes(x = Period, y = value/1e+06,fill = Region)) + 
          ggtitle("Migration to the United States by Source Region (1820-2006), In Millions")
        b <- a + geom_bar(stat = "identity", position = "stack")

        p <- ggplotly(b)
        p
    })

      output$DToutput <- renderDataTable({df.m})
})

最终目标是开发一个应用程序，用户可以在应用程序的任何位置轻松地在数据和图表之间导航。我有一个类似的应用程序，但用不同的代码编写：http://mqasim.me/sw1000/

Answer 1

Plotly 中的当前点击事件返回跟踪中的所有数据，因此很难隔离堆栈中的元素。此外，还需要使用plot_ly() 构建情节。处理所选表行位于不同页面的一种方法是消除分页的需要。

curveNumber：对于多条轨迹，信息将以堆叠的方式返回

有关耦合事件，请参阅this Plotly tutorial，有关选择行，请参阅 DT 闪亮页面的 section 2.3。

library(shiny)
library(plotly)
library(DT)
library(dplyr)
library(reshape2)

shinyApp(
  ui = shinyUI(fluidPage(
    titlePanel("Movie Ratings!"),

    mainPanel(
      plotlyOutput("chart", width = "100%"),
      DT::dataTableOutput("DToutput")
    )
  )),

  server = function(input, output, session) {

    df <- structure(c(106487,495681,1597442,2452577,2065141,2271925,4735484,3555352,8056040,4321887,
                      2463194,347566,621147,1325727,1123492,800368,761550,1359737,1073726,36,53,141,
                      41538,64759,124160,69942,74862,323543,247236,112059,16595,37028,153249,427642,
                      1588178,2738157,2795672,2265696,11951,33424,62469,74720,166607,404044,426967,
                      38972,361888,1143671,1516716,160037,354804,996944,1716374,1982735,3615225,
                      4486806,3037122,17,54,55,210,312,358,857,350,7368,8443,6286,1750,7367,14092,
                      28954,80779,176893,354939,446792,33333,69911,53144,29169,18005,11704,13363,
                      18028,46547,14574,8954,2483,14693,25467,25215,41254,46237,98263,185986),
                    .Dim=c(19,5),.Dimnames=list(c("1820-30","1831-40","1841-50","1851-60","1861-70",
                                                  "1871-80","1881-90","1891-00","1901-10","1911-20",
                                                  "1921-30","1931-40","1941-50","1951-60","1961-70",
                                                  "1971-80","1981-90","1991-00","2001-06"),
                                                c("Europe","Asia","Americas","Africa","Oceania")))
    df.m <- melt(df)
    df.m <- rename(df.m, Period = Var1, Region = Var2)

    output$chart <- renderPlotly({

      plot_ly(data = df.m, x = Period, y = value/1e+06, color = Region, type = "bar", source = "select") %>%
        layout(title = "Migration to the United States by Source Region (1820-2006), In Millions",
               xaxis = list(type = "category"),
               barmode = "stack")
    })

    output$DToutput <- DT::renderDataTable({

      datatable(df.m, selection = list(target = "row+column"), 
                options = list(pageLength = nrow(df.m), dom = "ft"))
    })

    proxy = dataTableProxy('DToutput')

    # highlight rows that are selected on plotly output
    observe({

      event.data = plotly::event_data("plotly_click", source = "select")

      if(is.null(event.data)) {
        rowNums <- NULL
      } else {
        rowNums <- row.names(df.m[df.m$Period %in% event.data$x,])
      }

      proxy %>% selectRows(as.numeric(rowNums))
    })    
  })