r: crea una selección para el filtro basada en ggplot interactivo usando javascript

CorePress2024-01-24  9

Creé el siguiente archivo Rmarkdown para hacer una selección basada en hacer clic en un ggplot interactivo.

En el fragmento de JavaScript me gustaría utilizar en lugar de "A" la letra (A o B) obtenida de el evento onclick en el ggplot interactivo. Si el usuario hace clic en el polígono B, entonces el botón "A" debería convertirse en una "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);
 });
```

¿Cómo puedo lograr esto?

Consulte Seleccionar un valor predeterminado en un diagrama de R usando un cuadro de selección mediante diafonía en R, usando HTML estático no brillante para una pregunta similar.

Editar

Más explícitamente, me gustaría filtrar la siguiente tabla según el rectángulo elegido: 

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

Entonces el rectángulo en question_filter debe ser igual al rectángulo elegido en la figura de ggplot. Obtuve lo siguienteng fragmento de la pregunta vinculada y me gustaría ajustar este fragmento para mostrar la tabla según el rectángulo seleccionado.

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


------------------------------------

Aquí hay una solución un poco más útil al problema:

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

Como verás, tiene tres componentes:

un filtro_selección un reaccionable tu trama

Detrás de escena está el objeto SharedData que encapsula sus datos y sabe cómo se filtran.

Lo ideal sería usar crosstalk.FilterHandle para controlar el filtrado, pero no parece funcionar bien con filter_select. Prefiero actualizar el valor de selección y hacer que el filtrado se realice segúneso, mientras que FilterHandle filtra los datos directamente, omitiendo la cadena de filtro real y en su lugar dictando qué elementos mostrar. Lo que habría generado una solución más complicada en la que yo mismo hago el filtrado, actualizo los elementos mostrados y luego actualizo la clave de búsqueda real que se muestra.

Tal como está ahora, simplemente disparo un .click() en la opción de filtro correspondiente a la letra en el gráfico (usando jQuery). También tengo que enfocarme y desenfocarme al cargar el documento para activar la creación de las opciones de filtro, que verás en el código anterior.

3

Gracias Sirius, muy apreciado. De hecho, estaba buscando combinar la solución con selectize y reaccionable. Agregué un nuevo fragmento a mi pregunta con un marco de datos que me gustaría filtrar según el rectángulo seleccionado. ¿Cómo puedo ajustar su solución para que funcione con el filtrado de reactivos?

mharinga

6 de abril de 2021 a las 13:06

No hay ninguna opción más clara por el momento (para vaciar el campo de búsqueda), ¿tal vez eso también habría sido una buena adición?

- Sirio

6 de abril de 2021 a las 22:31

1

¡Solución perfecta! Esto es exactamente lo que estoy buscando. ¡Muchas gracias!

mharinga

7 de abril de 2021 a las 7:56



------------------------------------

¿Qué tal algo como esto? Esto es de Visualización interactiva de datos basada en web con R, plotly y shiny de Carson Sievert Publicado por 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))
```

Dónde se obtiene un DT de diafonía en plotly

Su guía para un futuro mejor - libreflare
Su guía para un futuro mejor - libreflare