带有HTML的shiny,ggvis和add_tooltip

时间:2014-07-31 22:58:58

标签: r shiny ggvis

如何在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)
)

(不可否认,构建表格并不是最优雅的。)

当我在ttFunc1行中使用add_tooltip(...)时,工具提示会正确显示。但是,当我使用相对等效的ttFunc2时,它是一个空的工具提示。

ttFunc1(x=list(rownum=2))ttFunc2(x=list(rownum=2))的比较表明它们在功能上是等效的。

我错过了什么?

1 个答案:

答案 0 :(得分:16)

以下假设您安装了最新版本的Chrome并安装了开发人员工具。

前奏

让我们首先回顾一下ggvis的JavaScript代码 - specifically its interface with Shiny

与Shiny一样,ggvis通过httpuv package(最初基于libuv C ++库)启用的HTTP请求与R后端进行通信。特别是,它通过Websockets protocol执行一些通信:R和JavaScript使用开放的Websockets连接不断地来回传递消息。

使用Chrome开发者工具进行调试

特别是,将鼠标悬停在工具提示上后,右键单击并选择“检查元素”,打开Chrome Developer控制台。

enter image description here

(如果你没有看到它,你可能需要启用它 - 谷歌是你的朋友)。接下来,选择ttFunc2资源后,打开网络选项卡,重新加载页面,将鼠标悬停在数据点上,然后使用 "websocket/" 观察内容:

enter image description here

您可以右键单击并将内容复制到文件中:

{
   "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。我们将暂时看到为什么会这样。在此期间,请注意the JavaScript code that is processing this message

 // 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对象而不是字符串,并且默认行为是通过不显示任何内容而无声地失败

到修复

现在我们已经隔离了我们的错误,我们可以选择:我们可以在R端或JavaScript端修复此问题。我提出前者,因为转换htmltools输出应该不是前端代码的工作,并且违反了模块化等基本开发人员原则。

因此,我们必须弄清楚它在R方面的位置。我们首先转到ggvis github code并搜索"tooltip"(这有用的知道 - 您可以使用Github搜索整个代码库!):

enter image description here

我们找到interact_tooltip.R并注意函数:

show_tooltip <- function(session, l = 0, t = 0, html = "") {
  ggvis_message(session, "show_tooltip",
  list(pagex = l, pagey = t, html = html))
}

在我们的示例中,错误是htmlshiny.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上分配存储库和submitting a pull request(绿色大按钮)来实现这一点。

enter image description here

enter image description here

如果您想立即使用固定代码而无需等待Winston合并,您可以输入

require(devtools); install_github('robertzk/ggvis')

并且将安装正确的版本(但是这篇文章是一周之后不要这样做,因为我的fork可能已经过时了)。我使用ttFunc1ttFunc2对它进行了测试,现在它们的行为相同。

可以深入了解包内部。永远不要害怕!