Значения brushedPoints неверны для данных ggplot при фасетировании с помощью collect () - PullRequest
0 голосов
/ 21 января 2019

Мне повезло в Shiny с гранеными данными. Я создаю графики и показываю выбранные (т.е. очищенные) данные в таблице под графиком.

Я недавно пытался выполнить эту же операцию с немного более сложными данными. Я хочу выбрать одно поле в данных, а затем сгенерировать графики всех данных по этому одному полю. Я узнал, как это сделать с помощью этого сообщения о переполнении стека .

Кажется, это работает, когда я помещаю его в свое приложение, за исключением того, что я заметил, что на определенных графиках, 1) когда я пытался выбрать ВСЕ точки, ни одна из них не отображалась (ниже), или

All points selected, but none shown in table

... 2) если я пытался выбрать пустое место, все данные были выбраны (ниже).

Empty space selected, but all data shown in table

Мне кажется, что координаты кисти не точно преобразуются в координаты данных. Например, вот некоторые данные из графика 'disp', который показан как ошибочный (упорядочен по значению - 71,1 - наименьшее значение):

mpg  var value
33.9 disp  71.1
30.4 disp  75.7
32.4 disp  78.7
27.3 disp  79.0
30.4 disp  95.1
22.8 disp 108.0

Когда я попытался выбрать все точки на графике дисплеев (то есть первое изображение), значения для кисти были ниже (xmin, xmax, ymin и ymax все, кажется, соответствуют моему выбору). Тем не менее, я не знаю, как координаты нарисованных блоков переводятся в выборку данных - я действительно выхожу из своей глубины:

> fancybrush
$`xmin`
[1] 51.18154
$xmax
[1] 482.1583
$ymin
[1] 9.225
$ymax
[1] 35.075
$panelvar1
[1] "disp"
$coords_css
$coords_css$`xmin`
[1] 721
$coords_css$xmax
[1] 898
$coords_css$ymin
[1] 24.24657
$coords_css$ymax
[1] 121.9497
$coords_img
$coords_img$`xmin`
[1] 721
$coords_img$xmax
[1] 898
$coords_img$ymin
[1] 24.24657
$coords_img$ymax
[1] 121.9497
img_css_ratio
$img_css_ratio$`x`
[1] 1
$img_css_ratio$y
[1] 1
$mapping
$mapping$`x`
[1] "value"
$mapping$y
[1] "mpg"
$mapping$panelvar1
[1] "var"
$domain
$domain$`left`
[1] -23.6
$domain$right
[1] 495.6
$domain$bottom
[1] 9.225
$domain$top
[1] 35.075
$range
$range$`left`
[1] 690.2876
$range$right
[1] 903.5204
$range$bottom
[1] 121.9497
$range$top
[1] 24.24657
$log
$log$`x`
NULL
$log$y
NULL
$direction
[1] "xy"
$brushId
[1] "fancybrush"
$outputId
[1] "fancyPlot"

Для меня это немного отстой, но я, кажется, достаточно близко, чтобы быть уверенным, что это возможно. Если кто-нибудь может подсказать, что мне нужно сделать, чтобы это исправить, я хотел бы услышать от вас.

Ниже приведен наименьший возможный воспроизводимый пример кода, который я могу сделать, который иллюстрирует «простую» огранку (которая работает) прямо над «причудливой» огранкой, которая терпит неудачу. Есть несколько мест, где я устанавливаю глобальные переменные, чтобы я мог видеть, какие значения были.

Извиняюсь за длинный пост - надеюсь, я был максимально ясен. Спасибо, что прочитали это далеко.

library(shiny)
ui <- fluidPage(
  div(h1("Simple Facet"),p("These plots facet mtcars by CYL", plotOutput("simpleFacetPlot",brush = "simplebrush"), dataTableOutput("simpleFacetTable"))),
  div(h1("Fancy Facet"),p("These plots plot all other columns against MPG", plotOutput("fancyPlot",brush = "fancybrush"), dataTableOutput("fancyTable")))
)
server <- function(input, output) {
  ##### functions to get the data
  getSimpleData <-function(){
    thisData = mtcars
    thisData<<-thisData
    return(thisData)
  } 
  getFancyData <-function(coreField = NULL){
    thisData = mtcars
    thisData = thisData[!is.na(thisData[coreField]),]
    thisDataRes = thisData %>% gather(-coreField , key = "var", value = "value")  
    thisDataRes<<-thisDataRes
    return(thisDataRes)
  }
  #####  blocks to watch for the selections
  simpleSelected <- reactive({
    input$simplebrush
    thisSimpleData = getSimpleData()
    simpleBrushed=brushedPoints(thisSimpleData,
                          input$simplebrush,
                          xvar = "wt",
                          yvar = "mpg")
    return(simpleBrushed)
  })
  fancySelected <- reactive({
    input$fancybrush
    fancybrush<<-input$fancybrush
    thisFancyData = getFancyData(coreField = 'mpg')
    fancyBrushed=brushedPoints(thisFancyData,
                          input$fancybrush,
                          xvar = "var",
                          yvar = "mpg")
    return(fancyBrushed)
  })

 ##### blocks to generate the plots
  output$simpleFacetPlot <- renderPlot({
    #just force faceting on cylinder for the simple plot
    simpleFacetPlot = ggplot(data = getSimpleData(), aes(x = wt, y = mpg)) + geom_point() + facet_wrap(~ cyl) 
    return(simpleFacetPlot)
  })
  output$fancyPlot <- renderPlot({
    fancyPlot <- ggplot(data = getFancyData(coreField = 'mpg'), aes(x = value, y = mpg)) + geom_point() + facet_wrap(~ var) 
    return(fancyPlot)
  })

  #####blocks to print the selection output
  output$fancyTable <- renderDataTable({
    return(fancySelected())
  })  
  output$simpleFacetTable <- renderDataTable({
    return(simpleSelected())
  })

}

shinyApp(ui = ui, server = server)
...