Событие щелчка мышью не работает из-за диапазона значений в одной полосе гистограммы - PullRequest
Новая
       28

Событие щелчка мышью не работает из-за диапазона значений в одной полосе гистограммы

0 голосов
/ 31 января 2019

У меня есть датафрейм ниже: 

col1<-sample(500, size = 500, replace = TRUE)
col2<-sample(500, size = 500, replace = TRUE)
d<-data.frame(col1,col2)

И я создаю гистограмму этого фрейма данных, у которого активировано событие click.Когда пользователь щелкает по строке, строки данных, имеющие относительное значение, отображаются в виде данных.Проблема в том, что приложение отлично работает с несколькими значениями.Если, например, у моего dataframe было 5 строк вместо 500 с: 

col1<-sample(5, size = 5, replace = TRUE)
col2<-sample(5, size = 5, replace = TRUE)
d<-data.frame(col1,col2)

Но при большем количестве значений приложение не работает, так как график дает диапазон значений в каждой отдельной строке вместо уникального значения. 

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

ui <- fluidPage(
  mainPanel(
    plotlyOutput("heat")
  ),
  DT::dataTableOutput('tbl4')
)

server <- function(input, output, session) {
  output$heat <- renderPlotly({
        render_value(d) # You need function otherwise data.frame NN is not visible
    p <- plot_ly(x = d$col2, type = "histogram",source="subset") # set source so
    # that you can get values from source using click_event

  })

  render_value=function(NN){
    output$tbl4 <- renderDataTable({
      s <- event_data("plotly_click",source = "subset")
      print(s)
      return(DT::datatable(d[d$col2==s$y,]))           
    })  
  }           
}

shinyApp(ui, server)

1 Ответ

0 голосов
/ 31 января 2019

Вы можете попробовать это (добавлен код, чтобы захватить счет).Вам нужно построить гистограмму счета, и тогда вы сможете получить свои исходные данные на основе события клика.

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

ui <- fluidPage(
  mainPanel(
    plotlyOutput("heat")
  ),
  DT::dataTableOutput('tbl4')
)

server <- function(input, output, session) {
  output$heat <- renderPlotly({
    col1<-sample(500, size = 500, replace = TRUE)
    col2<-sample(500, size = 500, replace = TRUE)
    d<-data.frame(col1,col2)
    d=d %>%
      group_by(col2) %>%
      mutate(count = n()) # You can programatically add count for each row
    render_value(d) # You need function otherwise data.frame NN is not visible
    p <- plot_ly(x = d$count, type = "histogram",source="subset") 
    # You should histogram of count
    # set source so that you can get values from source using click_event       
  })

  render_value=function(d){
    output$tbl4 <- renderDataTable({
      s <- event_data("plotly_click",source = "subset")
      print(s)
      return(DT::datatable(d[d$count==s$x,]))           
    })  
  }           
}

shinyApp(ui, server)

Скриншот с рабочего прототипа: enter image description here

...