Поиск случайных x-значений, используемых geom_jitter

Я хочу иметь возможность выбирать наблюдения из квадратного графика с дрожащими точками сверху. I have been sometimely successful by having the point click find the category, look at the y-value and select the observation. Следующий код показывает мой прогресс до сих пор:

# ------------------------------Load Libraries---------------------------------

library(shiny)
library(ggplot2)
library(dplyr)

# -------------------------Print Boxplot to Screen-----------------------------

ui <- fluidPage(plotOutput('irisPlot', click = 'irisClick'))

server <- function(input, output){

# --------------------------Store Clicked Points-------------------------------  

  clicked <- reactiveValues(rows = rep(TRUE,nrow(iris)))

# ---------------------------Modify the Dataset--------------------------------  

  IRIS <- reactive({iris %>% mutate(index = clicked$rows)})

# ---------------------Select Points Through Plot Click------------------------  

  observeEvent(
    input$irisClick,{
      nS <- iris %>% mutate(selected = rep(FALSE,nrow(iris)))  
      lvls <- levels(iris$Species)
      plant <- lvls[round(input$irisClick$x)]
      pxl <- which(
        sqrt((iris$Sepal.Width-input$irisClick$y)^2) %in%
        min(sqrt((iris$Sepal.Width-input$irisClick$y)^2)) 
      )
      point <- iris[pxl,'Sepal.Width']
      nS[nS$Species == plant & nS$Sepal.Width %in% point,'selected'] <- TRUE
      clicked$rows <- xor(clicked$rows, nS$selected)
    })

# --------------------------Generate the Boxplot-------------------------------  

  output$irisPlot <- renderPlot({
    set.seed(1)
    ggplot(IRIS(), aes(x = Species, y = Sepal.Width))+
      geom_boxplot(na.rm = TRUE,outlier.shape = NA)+
      geom_jitter(
        na.rm = TRUE,
        width = .8,
        aes(shape = index, size = index, colour = index)
      )+
      theme(
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.background = element_blank(),
        panel.border = element_rect(colour = 'black', fill = NA),
        legend.position = "none"
      )+
      scale_shape_manual(values = c('FALSE'= 1,'TRUE'= 19))+
      scale_size_manual(values = c('FALSE' = 4, 'TRUE'= 2))+
      scale_colour_manual(values = c('TRUE' = "#428BCA", 'FALSE' = '#FAA634'))
  })

}

shinyApp(ui, server)

Как я сказал, код в основном работает, но он может быть непоследовательным. Иногда он не может найти точку, в других случаях он выбирает большую группу точек или выбирает точку на противоположной стороне поля. Я считаю, что лучший способ решить эту проблему-это иметь координату x и y, чтобы выбрать точку, однако, так как значения x генерируются случайным образом, мне нужно geom_jitter (), чтобы сказать мне, какие значения x он использует для данного участка, но я не смог найти никакого способа доступа к этому. Любая помощь в поиске этой информации была бы очень признательна.

1 ответ

  1. Моя благодарность aosmith за рассказ о функции layer_data () и Питеру Эллису за предложение использовать geom_point () вместо geom_jitter () оба комментария помогли мне решить мою проблему.

    Что мне нужно было сделать, так это создать новый объект участка в глобальной среде для дрожания точек. Затем используйте функцию layer_data() для возврата вновь созданных x-значений.

    Наконец, используя эти значения x, я создал новый объект эпюры и наложил поверх точек слои с помощью geom_point(). Вот полный код для всех заинтересованных.

    # ------------------------------Load Libraries---------------------------------
    
    library(shiny)
    library(ggplot2)
    library(dplyr)
    
    # ----------------------------Generate X Coords--------------------------------
    
    set.seed(1)
    g1 <- ggplot(iris, aes(x = Species, y = Sepal.Width))+
      geom_boxplot(na.rm = TRUE,outlier.shape = NA)+
      geom_jitter(na.rm = TRUE,width = .8)
    xPoints <- layer_data(g1, i = 2)$x
    
    # -------------------------Print Boxplot to Screen-----------------------------
    
    ui <- fluidPage(
      plotOutput('irisPlot', click = 'irisClick')
    )
    
    server <- function(input, output){
    
    # --------------------------Store Clicked Points-------------------------------  
    
      clicked <- reactiveValues(rows = rep(TRUE,nrow(iris)))
      rand <- reactiveValues(x = rep(NA,nrow(iris)))
    
    # ---------------------------Modify the Dataset--------------------------------  
    
      IRIS <- reactive({iris %>% mutate(index = clicked$rows)})
    
    # ---------------------Select Points Through Plot Click------------------------  
    
      observeEvent(
        input$irisClick,{
          nS <-data.frame( iris,  x = xPoints)
          point <- nearPoints(
            df = nS,
            coordinfo = input$irisClick,
            xvar = 'x',
            yvar = 'Sepal.Width',
            allRows = TRUE
          )
          clicked$rows <- xor(clicked$rows, point$selected_)
        })
    
    # --------------------------Generate the Boxplot-------------------------------  
    
      output$irisPlot <- renderPlot({
       ggplot(IRIS(), aes(x = Species, y = Sepal.Width))+
          geom_boxplot(na.rm = TRUE,outlier.shape = NA)+
          geom_point(
            aes(
              x = xPoints,
              y = iris$Sepal.Width,
              shape = index,
              size = index,
              colour = index 
            ),
            inherit.aes = FALSE
          )+
          theme(
            panel.grid.major = element_blank(),
            panel.grid.minor = element_blank(),
            panel.background = element_blank(),
            panel.border = element_rect(colour = 'black', fill = NA),
            legend.position = "none"
          )+
          scale_shape_manual(values = c('FALSE'= 1,'TRUE'= 19))+
          scale_size_manual(values = c('FALSE' = 4, 'TRUE'= 2))+
          scale_colour_manual(values = c('TRUE' = "#428BCA", 'FALSE' = '#FAA634'))
      })
      output$x <- renderPlot({
    
      })
    }
    
    shinyApp(ui, server)