logo标签列表

使用gridSVG和ggplot2 v.0.9.0实现交互式点标签

rggplot2
15
我想要以交互方式标记ggplot中的点，这样悬停在点上会显示标签。我试图改编在这个问题中给出的答案，使其适用于最新版本的ggplot2。受到ggplot Google小组这里的评论的影响，我使用了最新版本的geom-point-.r作为模板，在各个地方的gp参数中添加了“label”字段。然后，我从kohske的答案中复制了剩余的代码。但是它没有起作用--结果的svg中没有任何标签，而我无法弄清原因。我注意到point_grobs_labels中的所有内容都为空，并且当我查看grid.get（point_grob_names [1]）$ gp 时，没有标签字段...
library(ggplot2)
library(gridSVG)
library(proto)
library(rjson)

geom_point2 <- function (mapping = NULL, data = NULL, stat = "identity", 
                         position = "identity",
                         na.rm = FALSE, ...) {
  ggplot2:::GeomPoint$new(mapping = mapping, data = data, stat = stat, 
                          position = position, 
                          na.rm = na.rm, ...)
}

GeomPoint2 <- proto(ggplot2:::Geom, {
  objname <- "point"

  draw_groups <- function(., ...) .$draw(...)
  draw <- function(., data, scales, coordinates, na.rm = FALSE, ...) {    
    data <- remove_missing(data, na.rm, 
                           c("x", "y", "size", "shape"), name = "geom_point")
    if (empty(data)) return(zeroGrob())

    with(coord_transform(coordinates, data, scales), 
         ggname(.$my_name(), pointsGrob(x, y, size=unit(size, "mm"), pch=shape, 
                                        gp=gpar(
                                          col=alpha(colour, alpha),
                                          fill = alpha(fill, alpha),  
                                          label = label, 
                                          fontsize = size * .pt)))
    )
  }

  draw_legend <- function(., data, ...) {
    data <- aesdefaults(data, .$default_aes(), list(...))

    with(data,
         pointsGrob(0.5, 0.5, size=unit(size, "mm"), pch=shape, 
                    gp=gpar(
                      col = alpha(colour, alpha), 
                      fill = alpha(fill, alpha), 
                      label = label,
                      fontsize = size * .pt)
         )
    )
  }

  default_stat <- function(.) StatIdentity
  required_aes <- c("x", "y")
  default_aes <- function(.) aes(shape=16, colour="black", size=2, 
                                 fill = NA, alpha = NA, label = NA)

})

p <- ggplot(mtcars, aes(mpg, wt, label = rownames(mtcars))) + geom_point2() + facet_wrap(~ gear)
print(p)

grob_names <- grid.ls(print = FALSE)$name
point_grob_names <- sort(grob_names[grepl("point", grob_names)])
point_grobs_labels <- lapply(point_grob_names, function(x) grid.get(x)$gp$label)  

jlabel <- toJSON(point_grobs_labels)

grid.text("value", 0.05, 0.05, just = c(0, 0), name = "text_place", gp = gpar(col = "red"))

script <- '
var txt = null;
function f() {
var id = this.id.match(/geom_point2.([0-9]+)\\.points.*\\.([0-9]+)$/);
txt.textContent = label[id[1]-1][id[2]-1];
}

window.addEventListener("load",function(){
var es = document.getElementsByTagName("circle");
for (i=0; i<es.length; ++i) es[i].addEventListener("mouseover", f, false);

txt = (document.getElementById("text_place").getElementsByTagName("tspan"))[0];

},false);
'

grid.script(script = script)
grid.script(script = paste("var label = ", jlabel))

gridToSVG()
4个回答
12

试试这个：

library(ggplot2)
library(gridSVG)
library(proto)
library(rjson)
mtcars2 <- data.frame(mtcars, names = rownames(mtcars))

geom_point2 <- function (...) {
  GeomPoint2$new(...)
}

GeomPoint2 <- proto(ggplot2:::Geom, {
  objname <- "point"

  draw_groups <- function(., ...) .$draw(...)
  draw <- function(., data, scales, coordinates, na.rm = FALSE, ...) {    
    data <- remove_missing(data, na.rm, 
                           c("x", "y", "size", "shape"), name = "geom_point")
    if (empty(data)) return(zeroGrob())
    name <- paste(.$my_name(), data$PANEL[1], sep = ".")
    with(coord_transform(coordinates, data, scales), 
         ggname(name, pointsGrob(x, y, size=unit(size, "mm"), pch=shape, 
                                        gp=gpar(
                                          col=alpha(colour, alpha),
                                          fill = alpha(fill, alpha),  
                                          label = label, 
                                          fontsize = size * .pt)))
    )
  }

  draw_legend <- function(., data, ...) {
    data <- aesdefaults(data, .$default_aes(), list(...))

    with(data,
         pointsGrob(0.5, 0.5, size=unit(size, "mm"), pch=shape, 
                    gp=gpar(
                      col = alpha(colour, alpha), 
                      fill = alpha(fill, alpha), 
                      label = label,
                      fontsize = size * .pt)
         )
    )
  }

  default_stat <- function(.) StatIdentity
  required_aes <- c("x", "y")
  default_aes <- function(.) aes(shape=16, colour="black", size=2, 
                                 fill = NA, alpha = NA, label = NA)

})

p <- ggplot(mtcars2, aes(mpg, wt, label = names)) + geom_point2() +facet_wrap(~ gear)
print(p)

grob_names <- grid.ls(print = FALSE)$name
point_grob_names <- sort(grob_names[grepl("point", grob_names)])
point_grobs_labels <- lapply(point_grob_names, function(x) grid.get(x)$gp$label)

jlabel <- toJSON(point_grobs_labels)

grid.text("value", 0.05, 0.05, just = c(0, 0), name = "text_place", gp = gpar(col = "red"))

script <- '
var txt = null;
function f() {
    var id = this.id.match(/geom_point.([0-9]+)\\.points.*\\.([0-9]+)$/);
    txt.textContent = label[id[1]-1][id[2]-1];
}

window.addEventListener("load",function(){
    var es = document.getElementsByTagName("circle");
    for (i=0; i<es.length; ++i) es[i].addEventListener("mouseover", f, false);

    txt = (document.getElementById("text_place").getElementsByTagName("tspan"))[0];

},false);
'
grid.script(script = paste("var label = ", jlabel))
grid.script(script = script)

gridToSVG()

没有太大的变化，但我不得不添加一些内容。

mtcars2 <- data.frame(mtcars, names = rownames(mtcars))

然后

p <- ggplot(mtcars, aes(mpg, wt, label = rownames(mtcars)))
     + geom_point2() + facet_wrap(~ gear)

也会改变为

p <- ggplot(mtcars2, aes(mpg, wt, label = names)) 
     + geom_point2() +facet_wrap(~ gear)

因为我们有rownames(mtcars)

rownames(mtcars)
 [1] "Mazda RX4"           "Mazda RX4 Wag"       "Datsun 710"          "Hornet 4 Drive"     
 [5] "Hornet Sportabout"   "Valiant"             "Duster 360"          "Merc 240D"          
 [9] "Merc 230"            "Merc 280"            "Merc 280C"           "Merc 450SE"
.....

然后标签（我们通过其他修改得到）保持不变，即不会被 gears 重新排列，只会被它分割：

point_grobs_labels
[[1]]
 [1] "Mazda RX4"          "Mazda RX4 Wag"      "Datsun 710"         "Hornet 4 Drive"    
 [5] "Hornet Sportabout"  "Valiant"            "Duster 360"         "Merc 240D"         
 [9] "Merc 230"           "Merc 280"           "Merc 280C"          "Merc 450SE"        
[13] "Merc 450SL"         "Merc 450SLC"        "Cadillac Fleetwood"
[[2]]
....

但是将这些标签名称作为一列可以解决问题。

point_grobs_labels 
[[1]]
 [1] "Hornet 4 Drive"      "Hornet Sportabout"   "Valiant"             "Duster 360"         
 [5] "Merc 450SE"          "Merc 450SL"          "Merc 450SLC"         "Cadillac Fleetwood" 
 [9] "Lincoln Continental" "Chrysler Imperial"   "Toyota Corona"       "Dodge Challenger"   
[13] "AMC Javelin"         "Camaro Z28"          "Pontiac Firebird"   

[[2]]
....
太好了！谢谢你！我一直在寻找一个完整的、可工作的例子，就像这个一样。不过我有几个问题：脚本中的“proto”扮演什么角色？你是用它来重新定义geom_point，对吧？我想要将我制作的ggplot2图形创建为交互式图表。你能推荐一些使用RJSON与创建SVG的Javascript教程或资源吗？ - MatteoS
@MatteoS，很抱歉我在这里无法提供太多帮助，主要是我只是试图找到解决这个特定问题的方法。但你可能是对的，重新定义geom_point可能允许我们使用这些标签，在这种情况下至少我会称之为基础。因此，我建议您探索这个例子，特别是JavaScript，grid.get()和grid.ls()部分。 - Julius Vainora
非常感谢Julius（以及Tracy提出的问题）。您有没有想过如何将这种方法应用于多边形几何图形？ - ferrouswheel
@ferrouswheel，其实不是这样的，因为对于我来说，即使使用点数，这个版本也不再起作用了。 - Julius Vainora
1

感谢tracy提出了一个好问题，Julius给出了非常有帮助的答案。

为了让Julius的javascript在Chrome和Safari中适用于我，我不得不用this.correspondingUseElement.id替换this.id。这是有道理的，因为单个的<circle> SVG元素没有每个geom_point的id，我们想要的id附加在<use>元素上。

即使如此，在Firefox中对我也没有用，所以我改为将事件监听器附加到<use>元素本身。请注意，如果SVG更复杂，它可能会有除geom_points之外的其他<use>，因此我添加了一个if，仅将事件附加到geom_point.XX <use>元素。这对我来说在Chrome、Safari和Firefox中都有效：

window.addEventListener("load",function(){
  var es = document.getElementsByTagName("use"); 
  for (i=0; i<es.length; ++i) {
    if(es[i].id.search(/geom_point.([0-9]+)\.points.*\.([0-9]+)$/) >= 0) es[i].addEventListener("mouseover", f, false);
  }
  txt = (document.getElementById("text_place").getElementsByTagName("tspan"))[0];
},false);

（其他代码与Julius的相同）

0

这是一个比较通用的回答。我在这里帮助您使情节互动起来。您可以尝试这个 - 

library(ggplot2)
library(plotly)

# Plot how you would normally code for ggplot2
p <- ggplot(data,... 'add your variables and subsequent plots')
ggplotly(p)

享受吧！

0
我们通过检测生成的 .svg 中的颜色属性，并使用 css 检测鼠标悬停来解决了这个问题。结果在此演示的步骤 4、5、6 中可见：

使用 css 显示 svg 高亮

这是我在 stackoverflow 上的第一个回答，希望我的礼仪做得对。
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接