Как я могу получить строку данных из ggplotly в блестящем

Код ниже.

Я пытаюсь использовать событие plotly_click, чтобы выяснить, какие данные выбираются. Однако я не могу понять, как это сделать. Данные, предоставляемые plotly_click, очень минимальны и вообще не включают группировку или группы. У меня нет опыта работы с JS, но я знаю, что должен быть способ! Моя цель - иметь возможность выбрать точку данных и получить строку, которой она соответствует, в data.frame d1

d1=structure(list(Topic = c("compensation", "manager", "benefits",
                         "family", "communication", "worklifebalance", "perks", "compensation",
                         "benefits", "manager", "communication", "worklifebalance", "family",
                         "perks", "benefits", "compensation", "manager", "communication",
                         "family", "worklifebalance", "perks"),
                  variable = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L),
                                       .Label = c("Prct", "Count"), class = "factor"),
                  value = c(2.23121245555964, 0.723305136692411, 0.576192227534633,
                         0.202280250091946, 0.190020840995464, 0.153242613706019,
                         0.0122594090964816, 0.913705583756345, 0.609137055837563,
                         0.50761421319797, 0.50761421319797, 0.304568527918782, 0.203045685279188,
                         0, 1.49977276170277, 1.21193758521436, 0.893803969095592,
                         0.439327374640206, 0.348432055749129, 0.242387517042872,
                         0.0757460990758976),
                  group = c("APAC", "APAC", "APAC", "APAC",  "APAC", "APAC", "APAC",
                            "EMEA", "EMEA", "EMEA", "EMEA", "EMEA", "EMEA", "EMEA",
                            "AMERICAS", "AMERICAS", "AMERICAS", "AMERICAS", "AMERICAS",
                            "AMERICAS", "AMERICAS")),
             .Names = c("Topic", "variable", "value", "group"), class = c("data.table", "data.frame"),
             row.names = c(NA, -21L))


library(needs)
needs(
  stringr,
  data.table,
  tm,
  ggplot2,
  wordcloud,
  readxl,
  dplyr,
  quanteda,
  topicmodels,
  reshape,
  plotly,
  shiny,
  rCharts,
  ggthemes,
  shinyjs,
  shinyWidgets,DT,shinythemes,
  ggrepel,tidyverse,treemapify
)
options(stringsAsFactors = F)

library(shiny)
ui <- fluidPage(
  fluidRow(plotlyOutput('keywords')),
  fluidRow(  verbatimTextOutput("selection")) )



server = function(input,output){
  output$keywords = renderPlotly({


    d0 = d1
    p = ggplot(d0, aes(reorder(Topic,-value), value)) +
      geom_point(aes(colour = value),
        shape = 16,
        size = 3,
        show.legend = F) +
      facet_wrap(~ group)+
      theme_minimal()
    ggplotly(p)


  })
  output$selection <- renderPrint({
    s <- event_data("plotly_click")
      cat("You selected: \n\n")
      as.list(s)

  })
}


shinyApp(ui, server)

r ggplot2 plotly r-plotly shiny
person Ted Mosby    schedule 23.02.2018    source источник

Ответы (2)


arrow_upward
2
arrow_downward

Я не уверен, что это то, что вы хотите, но вы можете попробовать:

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

ui <- fluidPage(
   fluidRow(plotlyOutput('keywords')),
   fluidRow(verbatimTextOutput("selection")),
   fluidRow(DT::dataTableOutput("table1"))
)   

server = function(input,output){
output$keywords = renderPlotly({

d0 = d1
key <- row.names(d0)
d0 <- data.frame(d3, key)  

p = ggplot(d0, aes(reorder(Topic,-value), value, key = key)) +
        geom_point(aes(colour = value),
                   shape = 16,
                   size = 3,
                   show.legend = F) +
        facet_wrap(~ group)+
        theme_minimal()
      ggplotly(p)


    })
    output$selection <- renderPrint({
      s <- event_data("plotly_click")
      cat("You selected: \n\n")
      data.frame(s)
    })

    selection2 <- reactive({
      s <- event_data("plotly_click")
      cat("You selected: \n\n")
      df <- data.frame(s)
    })

    output$table1 = renderDT({
      d2 <- d1 %>% filter(key == selection2()$key)
      d2 
  }) 
  }

shinyApp(ui, server)
person MLavoie    schedule 23.02.2018
comment
@ТедМосби. Если вы определите key вне функции server, она будет работать. Это имеет смысл. Нажмите на одну точку, и появится таблица. Я внес изменения в свой пост выше. - person MLavoie; 26.02.2018
comment
Почти работает. Если вы посмотрите на группы, они отключены. Если я нажму на точку в АМЕРИКАХ, появится группа Азиатско-Тихоокеанского региона. - person Ted Mosby; 26.02.2018
comment
@TedMosby, добавив это: d0 <- cbind(d0, key) поверх кода, кажется, решает проблему. - person MLavoie; 26.02.2018
comment
УДИВИТЕЛЬНО! Благодарю вас! - person Ted Mosby; 26.02.2018
comment
Из любопытства, почему это должно быть вне функции сервера? Данные являются реактивными, поэтому вынесение их за рамки всего не работает. - person Ted Mosby; 26.02.2018
comment
Я не могу проверить код сейчас, но теперь он должен работать внутри - person MLavoie; 26.02.2018

arrow_upward
1
arrow_downward

Я использовал только plotly_selected, но полагаю, что plotly_clicked должно быть похоже. plotly_selected будет срабатывать, когда вы проведете кистью по графику.

Вот пример:

# 'data' is the data frame you used to draw the plot
brushed_data <- reactive({
  d <- event_data("plotly_selected")

  data_key <- d$key

  if (!is.null(data_key) && length(data_key) > 0) {
   # if it's not the row names, can be any column 'data[data$key %in% data_key,]
   data[rownames(data) %in% data_key,]
  } else {
    data.frame()
  }
})

Ключ указывается, когда вы рисуете свой сюжет, в моем случае я передаю key = rownames(data) в add_markers

EDIT Пример веб-сайта Plotly адаптирован с использованием ggplot2 и plotly_click.

library(plotly)
library(shiny)

ui <- fluidPage(
  plotlyOutput("plot"),
  verbatimTextOutput("click"),
  verbatimTextOutput("brush")
)

server <- function(input, output, session) {

  output$plot <- renderPlotly({
    # use the key aesthetic/argument to help uniquely identify selected observations
    key <- row.names(mtcars)
    p <- ggplot(mtcars, aes(x = mpg, y = wt, colour = factor(vs), key = key)) + 
      geom_point() + facet_wrap(~ cyl)
    ggplotly(p) %>% layout(dragmode = "select")
  })

  output$click <- renderPrint({
    d <- event_data("plotly_click")
    req(d)
    print(mtcars[d$key, ])
  })

  output$brush <- renderPrint({
    d <- event_data("plotly_selected")
    req(d)
    print(mtcars[d$key, ])
  })

}

shinyApp(ui, server)
person lkq    schedule 23.02.2018
comment
Что, если я захочу гранить, скажем, cyl в ваших данных? Это больше не работает - person Ted Mosby; 26.02.2018
comment
@TedMosby добавление + facet_wrap(~ cyl) после geom_point() все еще работает - person lkq; 26.02.2018