R의 시각적 응답 사용 안 함 클릭 이벤트

Question

나는 plot_ly 분산 플롯을 사용하여 반짝이는 앱을 만들고 있습니다. 크로스 토크 패키지의 SharedData 객체를 사용하여 플롯과 datatable (DT의 정보)간에 정보를 공유합니다.

문제는 플롯에서 한 점을 클릭하면 다른 모든 점의 색이 희미 해지고 선택한 점에 대한 범례에 항목이 추가되고 문제가 발생하면 그 점이 보이지 않습니다 그것을 취소하십시오. 이 시각적 인 변경 사항을 비활성화하고 싶지만 여전히 플롯 클릭을 감지 할 수 있습니다.

난 그냥 plot_ly 전화의 데이터 매개 변수에 SharedData 객체 대신 반응성 data.frame를 사용하는 경우이 문제가 발생하지 않습니다,하지만 플롯에서 event_data은 datatable에서 행을 선택하기에 충분한 정보를 갖고 있지 않으며 . (. x 및 y 점 좌표가 예기치 않은 결과를 가질 수 있도록 데이터에 대한 좌표가 일치하는 점의 숫자를 부동) 여기

하는 데모가 mtcars을 사용하고 : 그런 일이 왜

library(shiny) 
library(DT) 
library(plotly) 
library(data.table) 
library(crosstalk) 

### UI function --------- 
ui <- fluidPage(
    fluidRow(
    plotlyOutput('my_graph', height = '400px') 
), 
    fluidRow(
    dataTableOutput('my_table') 
) 
) 

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

### SharedData object ---- 
    filtered_data <- reactive({ 
    data.table(mtcars, keep.rownames = TRUE) 
    }) 

    shared_data <- reactive({ 
    req(filtered_data()) 
    SharedData$new(filtered_data(), ~rn) 
    }) 

### my_graph ---- 
    output$my_graph <- renderPlotly({ 
    p <- plot_ly(shared_data(), 
       x = ~disp, 
       y = ~mpg, 
       color = ~factor(carb), 
       source = 'm') 
    p 
    }) 

### my_table --------- 
    output$my_table <- renderDataTable({ 
    datatable(shared_data()$data(), 
       selection = 'single') 
    }) 

    observe({ 
    click_detect = plotly::event_data('plotly_hover', source = 'm') 
    str(click_detect) 

    dataTableProxy('my_table') %>% 
     selectRows(match(click_detect$key, shared_data()$data()$rn)) 
    }) 
} 

shinyApp(ui, server) 

Answer 1

이 날 뛰고 있지만, 가능한 해결 방법은 두 가지입니다.

---

포스 Plotly 1.

if (click_detect$curveNumber != 0) { 
     output$my_graph <- renderPlotly({ 
      p <- plot_ly(shared_data(), 
         x = ~disp, 
         y = ~mpg, 
         color = ~factor(carb), 
         source = 'm', 
         marker = list(opacity = 1)) 
      p 
     })  
     } 

단점 모든 마커의 불투명도를 설정하려면 다음 그래프 점멸.

---

filterRows 문을 변경하십시오. 귀하의 데이터를 모르지만 mtcars에 대해 carb (curveNumber을 통해) 필터링 한 다음 pointNumber을 통해 필터링 할 수 있습니다.

dataTableProxy('my_table') %>% selectRows(
     which(mtcars$carb == sort(unique(mtcars$carb))[[click_detect$curveNumber + 1]])[[click_detect$pointNumber + 1]])