r - Create selection for filter based on interactive ggplot using javascript - Stack Overflow

admin管理员组

文章数量:1302869

I created the following Rmarkdown file to make a selection based on clicking an interactive ggplot.

In the javascript chunk I would like to use instead of "A" the letter (A or B) obtained from
the onclick event in the interactive ggplot. If the user clicks on polygon B then the "A" should bee a "B".

---
output:
  html_document
---

```{r, echo = FALSE, message = FALSE}
library(ggplot2)
library(ggiraph)

# Rectangle A
group_A <- data.frame(x1 = 0, 
                  x2 = 3, 
                  y1 = 0, 
                  y2 = 1, 
                  r = "A")

# Polygon B
group_B <- data.frame(x = c(3,4,4,0,0,3), 
                      y = c(0,0,2,2,1,1), 
                      r = "B")

p <- ggplot() + 
  geom_rect_interactive(data = group_A, 
                        aes(xmin = x1, xmax = x2, ymin = y1, 
                            ymax = y2, data_id = r, onclick = r), 
                        alpha = .1, color = "black") + 
  geom_polygon_interactive(data = group_B, 
                           aes(x = x, y = y, data_id = r, onclick = r), 
                           alpha = .1, color = "black") + 
  annotate("text", x = 0.1, y = .82, 
           label = "A",
           fontface = 2, hjust = 0) +
  annotate("text", x = 0.1, y = 1.82, 
           label = "B", 
           fontface = 2, hjust = 0) +
  theme_void()

girafe(ggobj = p)

```

Javascript chunk:

```{js}
$(document).ready(function() {
    document.getElementById("filter").getElementsByClassName("selectized"[0].selectize.setValue("A", false);
 });
```

How can I achieve this?

See Selecting a default value in an R plotly plot using a selectize box via crosstalk in R, using static html not shiny for a similar question.

Edit

More explicitly, I would like to filter the following table based on the chosen rectangle: 

```{r}

# example data 
dat <- tibble::tribble(~value, ~x, ~y, 
                          "A", 1, 1, 
                          "B", 2, 1,   
                          "A", 1, 2,    
                          "B", 2, 2,       
                          "A", 1, 3,    
                          "B", 2, 3,   
                          "A", 1, 2,       
                          "B", 2, 3)
```

Then the rectangle in question_filter should be equal to the chosen rectangle in the ggplot figure. I obtained the following chunk from the linked question, and would like to adjust this chunk to show the table based on the selected rectangle.

```{r}
library(crosstalk)
library(reactable)

# Initializing a crosstalk shared data object  
plotdat <- highlight_key(dat)

# Filter dropdown
question_filter <- crosstalk::filter_select(        
 "filter", "Select a group to examine",   
 plotdat, ~value, multiple = F
)

plot <- reactable(plotdat)

# Just putting things together for easy 
displayshiny::tags$div(class = 'flexbox', 
                       question_filter,
                       shiny::tags$br(),
                       plot)
```

I created the following Rmarkdown file to make a selection based on clicking an interactive ggplot.

In the javascript chunk I would like to use instead of "A" the letter (A or B) obtained from
the onclick event in the interactive ggplot. If the user clicks on polygon B then the "A" should bee a "B".

---
output:
  html_document
---

```{r, echo = FALSE, message = FALSE}
library(ggplot2)
library(ggiraph)

# Rectangle A
group_A <- data.frame(x1 = 0, 
                  x2 = 3, 
                  y1 = 0, 
                  y2 = 1, 
                  r = "A")

# Polygon B
group_B <- data.frame(x = c(3,4,4,0,0,3), 
                      y = c(0,0,2,2,1,1), 
                      r = "B")

p <- ggplot() + 
  geom_rect_interactive(data = group_A, 
                        aes(xmin = x1, xmax = x2, ymin = y1, 
                            ymax = y2, data_id = r, onclick = r), 
                        alpha = .1, color = "black") + 
  geom_polygon_interactive(data = group_B, 
                           aes(x = x, y = y, data_id = r, onclick = r), 
                           alpha = .1, color = "black") + 
  annotate("text", x = 0.1, y = .82, 
           label = "A",
           fontface = 2, hjust = 0) +
  annotate("text", x = 0.1, y = 1.82, 
           label = "B", 
           fontface = 2, hjust = 0) +
  theme_void()

girafe(ggobj = p)

```

Javascript chunk:

```{js}
$(document).ready(function() {
    document.getElementById("filter").getElementsByClassName("selectized"[0].selectize.setValue("A", false);
 });
```

How can I achieve this?

See Selecting a default value in an R plotly plot using a selectize box via crosstalk in R, using static html not shiny for a similar question.

Edit

More explicitly, I would like to filter the following table based on the chosen rectangle: 

```{r}

# example data 
dat <- tibble::tribble(~value, ~x, ~y, 
                          "A", 1, 1, 
                          "B", 2, 1,   
                          "A", 1, 2,    
                          "B", 2, 2,       
                          "A", 1, 3,    
                          "B", 2, 3,   
                          "A", 1, 2,       
                          "B", 2, 3)
```

Then the rectangle in question_filter should be equal to the chosen rectangle in the ggplot figure. I obtained the following chunk from the linked question, and would like to adjust this chunk to show the table based on the selected rectangle.

```{r}
library(crosstalk)
library(reactable)

# Initializing a crosstalk shared data object  
plotdat <- highlight_key(dat)

# Filter dropdown
question_filter <- crosstalk::filter_select(        
 "filter", "Select a group to examine",   
 plotdat, ~value, multiple = F
)

plot <- reactable(plotdat)

# Just putting things together for easy 
displayshiny::tags$div(class = 'flexbox', 
                       question_filter,
                       shiny::tags$br(),
                       plot)
```

• javascript
• r
• ggplot2
• r-markdown
• ggiraph

Share Improve this question Follow edited Apr 6, 2021 at 13:05 mharinga asked Mar 27, 2021 at 12:29 mharingamharinga 1,7801111 silver badges2525 bronze badges

Add a ment  | 

2 Answers 2

Sorted by: Reset to default 6 +50

Here's a slightly more useful take on the problem:

---
output:
  html_document
---

```{r setup, include=FALSE}
library(ggplot2)
library(ggiraph)
knitr::opts_chunk$set(echo = TRUE)
library(knitr)
library(crosstalk)
library(reactable)
library(tibble)
```

```{r, echo = FALSE, message = FALSE}

dat <- tibble::tribble(~value, ~x, ~y,
                          "A", 1, 1,
                          "B", 2, 1,
                          "A", 1, 2,
                          "B", 2, 2,
                          "A", 1, 3,
                          "B", 2, 3,
                          "A", 1, 2,
                          "B", 2, 3)

shared_dat <- SharedData$new( dat, group="abSelector" )

# Rectangle A
group_A <- data.frame(x1 = 0,
                  x2 = 3,
                  y1 = 0,
                  y2 = 1,
                  r = "A")

# Polygon B
group_B <- data.frame(x = c(3,4,4,0,0,3),
                      y = c(0,0,2,2,1,1),
                      r = "B")

p <- ggplot() +
  geom_rect_interactive(data = group_A,
                        aes(xmin = x1, xmax = x2, ymin = y1,
                            ymax = y2, data_id = r,
                            onclick = paste0("filterOn(\"",r,"\")")
                            ),
                        alpha = .1, color = "black") +
  geom_polygon_interactive(data = group_B,
                           aes(x = x, y = y, data_id = r,
                            onclick = paste0("filterOn(\"",r,"\")")
                               ),
                           alpha = .1, color = "black") +
  annotate("text", x = 0.1, y = .82,
           label = "A",
           fontface = 2, hjust = 0) +
  annotate("text", x = 0.1, y = 1.82,
           label = "B",
           fontface = 2, hjust = 0) +
  theme_void()

g <- girafe(ggobj = p)

rt <- reactable(
    shared_dat,
    elementId = "ABtable"
)

fs <- filter_select("letterFilter", "Filter", shared_dat, group=~value, multiple=FALSE )

bscols(
    list( fs, rt ),
    g
)

```

<script>

$(function() {
    // Necessary to trigger selectize initialization
    $("#letterFilter input").focus();
    setTimeout( function(){ $("#letterFilter input").blur(); }, 0);
});

filterOn = function(letter) {
    var obj = $("#letterFilter div[data-value='" + letter + "']");
    obj.click();
}

</script>

As you will see, there are three ponents to it:

• a filter_select
• a reactable
• your plot

Behind the scenes there's the SharedData object encapsulating your data and that know's how its being filtered.

Now ideally I'd use a crosstalk.FilterHandle to control the filtering, but it doesn't seem to play well with filter_select. I'd rather updat the selectize value and have the filtering happen based onthat, where as the FilterHandle filters the data directly, bypassing the actual filter string and instead dictating which elements to show. Which would have made for a more clunky solution in which I do the filtering myself, update shown elements, and then update the actual search key shown.

As it is now, I just fire a .click() on the filter option corresponding to the letter in the plot (using jQuery). I also have to focus and blur upon loading the document to trigger building of the filter options, which you will see in the code above.

What about something like this? This is from Interactive web-based data visualization with R, plotly, and shiny by Carson Sievert Published by CRC press

---
title: "Untitled"
author: "Daniel"
date: "4/7/2021"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

```{r}


library(ggplot2)
library(plotly)
library(DT)

m<-highlight_key(mpg)
p<-ggplot(m,aes(displ,hwy))+geom_point(aes(color = cyl)) + geom_smooth(se = TRUE)
gg<-highlight(ggplotly(p),"plotly_selected")
m<-highlight_key(mpg)
p<-ggplot(m,aes(displ,hwy))+geom_point(aes(color = cyl)) + geom_smooth(se = TRUE)
gg<-highlight(ggplotly(p),"plotly_selected")
crosstalk::bscols(gg,DT::datatable(m))
```

Where you get a crosstalk DT in plotly

本文标签： rCreate selection for filter based on interactive ggplot using javascriptStack Overflow