使用javascript基于交互式ggplot为过滤器创建选择

Question

我创建了以下 Rmarkdown 文件以基于单击交互式 ggplot 进行选择。

在 javascript 块中，我想使用从
获得的字母（A 或 B）而不是“A” 交互式ggplot中的onclick事件。如果用户点击多边形 B，那么“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);
 });
```

我怎样才能做到这一点？

请参阅Selecting a default value in an R plotly plot using a selectize box via crosstalk in R, using static html not shiny 了解类似问题。

编辑

更明确地说，我想根据所选矩形过滤下表：

```{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)
```

那么question_filter中的矩形应该等于ggplot图中选择的矩形。我从链接的问题中获得了以下块，并想调整此块以根据所选矩形显示表格。

```{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)
```

Answer 1

这样的事情呢？这是来自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))
```

你在情节中得到串扰DT

Answer 2

这里有一个稍微有用的问题：

---
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>

如您所见，它包含三个组件：

• 一个 filter_select
• 一个可反应的
• 你的情节

在幕后有一个 SharedData 对象封装了您的数据，并且知道它是如何被过滤的。

现在理想情况下，我会使用crosstalk.FilterHandle 来控制过滤，但它似乎与filter_select 不兼容。我宁愿更新选择值并在此基础上进行过滤，因为 FilterHandle 直接过滤数据，绕过实际的过滤器字符串，而是指示要显示的元素。这会产生一个更笨重的解决方案，我自己进行过滤，更新显示的元素，然后更新显示的实际搜索键。

就像现在一样，我只是在与图中字母对应的过滤器选项上触发.click()（使用jQuery）。我还必须在加载文档时聚焦和模糊以触发过滤器选项的构建，您将在上面的代码中看到。