[英]shiny, ggvis, and add_tooltip with HTML
如何在ggvis交互式图形中使用tags$...
函数?
一个“小”和人为的例子:
library(ggvis)
library(shiny)
n <- 20
data <- data.frame(
xs = 1:n, ys = rnorm(n),
color = sample(c('red', 'green', 'blue'), n, replace = TRUE),
size = 25 * sample(6, n, replace = TRUE),
rownum = 1:n)
ttFunc1 <- function(x) {
paste('<table>',
paste(apply(data.frame(n = names(data),
x = unlist(format(data[x$rownum,]))), 1,
function(h) paste('<tr><td>', h[1],
'</td><td>', h[2],
'</td></tr>')),
collapse = ''),
'</table>')
}
ttFunc2 <- function(x) {
tags$table(
lapply(1:ncol(data),
function(cc) {
tags$tr(tags$td(names(data)[cc]),
tags$td(format(data[x$rownum,cc])))
}))
}
shinyApp(
ui = fluidPage(
uiOutput('gg_ui'),
ggvisOutput('gg')
),
server = function(input, output, session) {
data %>%
ggvis(~xs, ~ys, key := ~rownum) %>%
layer_points(fill := ~color, size := ~size) %>%
add_tooltip(ttFunc2, 'hover') %>%
bind_shiny('gg', 'gg_ui')
},
options = list(height = 500)
)
(诚然,这不是构建表格最优雅的。)
当我在add_tooltip(...)
行中使用ttFunc1
,工具提示会正确显示。 但是,当我使用相对等效的ttFunc2
时,它是一个空的工具提示。
ttFunc1(x=list(rownum=2))
与ttFunc2(x=list(rownum=2))
表明它们在功能上是等价的。
我错过了什么?
以下假设您安装了最新版本的Chrome并安装了开发人员工具。
让我们首先回顾一下ggvis的JavaScript代码 - 特别是它与Shiny的接口 。
像Shiny一样, ggvis通过httpuv包 (最初基于libuv C ++库)启用的HTTP请求与R后端进行通信。 特别是,它通过Websockets协议执行一些通信:R和JavaScript使用开放的Websockets连接不断地来回传递消息。
特别是,将鼠标悬停在工具提示上后,右键单击并选择“检查元素”,打开Chrome Developer控制台。
(如果你没有看到它,你可能需要启用它 - 谷歌是你的朋友)。 接下来,在选择"websocket/"
资源后, ttFunc2
出Network选项卡,重新加载页面,将鼠标悬停在数据点上,然后使用ttFunc2
观察内容:
您可以右键单击并将内容复制到文件中:
{
"custom": {
"ggvis_message": {
"type": "show_tooltip",
"id": null,
"data": {
"pagex": 382,
"pagey": 175,
"html": {
"name": "table",
"attribs": [],
"children": [
[
{
"name": "tr",
...
(我已经截断了一些内容)。 您可以注意到,ggvis正在使用工具提示正文接收消息,但结构化为JavaScript对象。 将此与ttFunc1
输出进行比较:
{
"custom": {
"ggvis_message": {
"type": "show_tooltip",
"id": null,
"data": {
"pagex": 264,
"pagey": 238,
"html": "<table> <tr><td> xs </td><td> 7 </td></tr><tr><td> ys </td><td> -0.07295337 </td></tr><tr><td> color </td><td> red </td></tr><tr><td> size </td><td> 150 </td></tr></table>"
}}}}
因此前一个请求是接收表示HTML的Javascript对象,后者正在接收原始HTML。 我们将暂时看到为什么会这样。 在此期间,请注意处理此消息的JavaScript代码 :
// Tooltip message handlers
ggvis.messages.addHandler("show_tooltip", function(data, id) {
/* jshint unused: false */
// Remove any existing tooltips
$('.ggvis-tooltip').remove();
// Add the tooltip div
var $el = $('<div id="ggvis-tooltip" class="ggvis-tooltip"></div>')
.appendTo('body');
$el.html(data.html);
...
啊哈! 因此,它使用jQuery将HTML直接设置为Websocket消息的html
元素。 由于jQuery从未期望与来自R htmltools
包的Web流输出进行交互,因此最终结果是它接收JavaScript对象而不是字符串,并且默认行为是通过不显示任何内容而无声地失败。
现在我们已经隔离了我们的bug,我们可以选择:我们可以在R端或JavaScript端修复它。 我提出前者,因为转换htmltools
输出应该不是前端代码的工作,并且违反了模块化等基本开发人员原则。
因此,我们必须弄清楚它在R方面的位置。 我们首先转到ggvis github代码并搜索"tooltip"
(知道这一点很有用 - 你可以使用Github搜索整个代码库!):
我们找到interact_tooltip.R
并注意函数:
show_tooltip <- function(session, l = 0, t = 0, html = "") {
ggvis_message(session, "show_tooltip",
list(pagex = l, pagey = t, html = html))
}
错误是在我们的例子中, html
是一个shiny.tag
对象而不是一个character
。 幸运的是,一个shiny.tag
可以使用as.character
转换为代表HTML,因为我们可以从控制台进行测试:
> as.character(tags$table(tags$tr(tags$td('test'))))
<table>
<tr>
<td>test</td>
</tr>
</table>
所以我们可以继续修复代码:
show_tooltip <- function(session, l = 0, t = 0, html = "") {
ggvis_message(session, "show_tooltip",
list(pagex = l, pagey = t, html = as.character(html)))
}
现在我们已经找到了解决方案,我们应该与朋友分享,以便他们也可以使用它。 我们可以通过在Github上分配存储库并提交拉取请求 (绿色大按钮)来完成此操作。
如果您想立即使用固定代码而无需等待Winston合并它,您可以输入
require(devtools); install_github('robertzk/ggvis')
并且将安装正确的版本(但是这篇文章是一周之后不要这样做,因为我的fork可能已经过时了)。 我已经使用ttFunc1
和ttFunc2
测试了它们,它们的行为现在是相同的。
可以深入了解包内部。 永远不要害怕!
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.