mha*_*nga 3 javascript r ggplot2 r-markdown ggiraph
我创建了以下 Rmarkdown 文件,以根据单击交互式 ggplot 进行选择。
\n在 javascript 块中,我想使用从
交互式 ggplot 中的 onclick 事件获得的字母(A 或 B)来代替“A”。如果用户单击多边形 B,则“A”应变为“B”。
---\noutput:\n html_document\n---\n\n```{r, echo = FALSE, message = FALSE}\nlibrary(ggplot2)\nlibrary(ggiraph)\n\n# Rectangle A\ngroup_A <- data.frame(x1 = 0, \n x2 = 3, \n y1 = 0, \n y2 = 1, \n r = "A")\n\n# Polygon B\ngroup_B <- data.frame(x = c(3,4,4,0,0,3), \n y = c(0,0,2,2,1,1), \n r = "B")\n\np <- ggplot() + \n geom_rect_interactive(data = group_A, \n aes(xmin = x1, xmax = x2, ymin = y1, \n ymax = y2, data_id = r, onclick = r), \n alpha = .1, color = "black") + \n geom_polygon_interactive(data = group_B, \n aes(x = x, y = y, data_id = r, onclick = r), \n alpha = .1, color = "black") + \n annotate("text", x = 0.1, y = .82, \n label = "A",\n fontface = 2, hjust = 0) +\n annotate("text", x = 0.1, y = 1.82, \n label = "B", \n fontface = 2, hjust = 0) +\n theme_void()\n\ngirafe(ggobj = p)\n\n```\n\nJavascript chunk:\n\n```{js}\n$(document).ready(function() {\n document.getElementById("filter").getElementsByClassName("selectized"[0].selectize.setValue("A", false);\n });\n```\nRun Code Online (Sandbox Code Playgroud)\n我怎样才能实现这个目标?
\n请参阅通过 R 中的串扰使用选择框在 R 绘图中选择默认值,对于类似的问题使用静态 html 不闪亮。
\n编辑
\n更明确地说,我想根据所选的\xc2\xa0矩形过滤下表:\xc2\xa0
\n```{r}\n\n# example data\xc2\xa0\ndat <- tibble::tribble(~value, ~x, ~y,\xc2\xa0\n \xc2\xa0 \xc2\xa0\xc2\xa0 \xc2\xa0 "A", 1, 1,\xc2\xa0\n \xc2\xa0 \xc2\xa0 \xc2\xa0 \xc2\xa0 "B", 2, 1,\xc2\xa0 \xc2\xa0\n \xc2\xa0 \xc2\xa0 "A", 1, 2,\xc2\xa0 \xc2\xa0 \n \xc2\xa0 \xc2\xa0 \xc2\xa0 \xc2\xa0 "B", 2, 2,\xc2\xa0 \xc2\xa0 \xc2\xa0 \xc2\xa0\n \xc2\xa0 \xc2\xa0 "A", 1, 3,\xc2\xa0 \xc2\xa0 \n \xc2\xa0 \xc2\xa0 \xc2\xa0 \xc2\xa0 "B", 2, 3,\xc2\xa0 \xc2\xa0\n \xc2\xa0 \xc2\xa0 "A", 1, 2,\xc2\xa0 \xc2\xa0 \xc2\xa0 \xc2\xa0\n \xc2\xa0 \xc2\xa0 \xc2\xa0 \xc2\xa0 "B", 2, 3)\n```\nRun Code Online (Sandbox Code Playgroud)\n那么 中的矩形question_filter应该等于 ggplot 图中选择的矩形。我从链接的问题中获得了以下块,并且想调整该块以根据所选矩形显示表格。
```{r}\nlibrary(crosstalk)\nlibrary(reactable)\n\n# Initializing a crosstalk shared data object \xc2\xa0\nplotdat <- highlight_key(dat)\n\n# Filter dropdown\nquestion_filter <- crosstalk::filter_select(\xc2\xa0 \xc2\xa0 \n "filter", "Select a group to examine",\xc2\xa0 \xc2\xa0\n plotdat, ~value, multiple = F\n)\n\nplot <- reactable(plotdat)\n\n# Just putting things together for easy \ndisplayshiny::tags$div(class = \'flexbox\',\xc2\xa0\n question_filter,\n shiny::tags$br(),\n plot)\n```\nRun Code Online (Sandbox Code Playgroud)\n
这是解决这个问题的一个稍微有用的方法:
---
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>
Run Code Online (Sandbox Code Playgroud)
正如您将看到的,它由三个组成部分组成:
在幕后,SharedData 对象封装了您的数据,并且知道如何过滤数据。
现在理想情况下我会使用 acrosstalk.FilterHandle来控制过滤,但它似乎不能很好地配合filter_select. 我宁愿更新选择值并基于该值进行过滤,因为 FilterHandle 直接过滤数据,绕过实际的过滤字符串,而是指示要显示哪些元素。这将是一个更笨重的解决方案,我自己进行过滤,更新显示的元素,然后更新显示的实际搜索键。
现在,我只是触发与.click() 图中字母相对应的过滤器选项(使用 jQuery)。我还必须在加载文档时进行聚焦和模糊,以触发过滤器选项的构建,您将在上面的代码中看到。
像这样的事情怎么办?这是来自Carson Sievert 的 R、plotly 和闪亮的基于交互式网络的数据可视化,由 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))
```
Run Code Online (Sandbox Code Playgroud)
在plotly中你可以在哪里得到串扰DT