本文介绍了与gridSVG和ggplot2 v.0.9.0的交互点标签的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我想在交互式ggplot中标记点,以便在点上移动显示标签。

I'd like to label points in a ggplot interactively, so that mousing over a point shows a label.

我试图修改给出的答案,以便它在最新版本的ggplot2。受到ggplot google群组评论的影响,,我使用最新版本的geom-point-.r作为模板,在各个地方为gp参数添加一个标签字段。然后我复制了kohske答案的剩余代码。但它不起作用 - 在生成的svg中没有任何标签,我不知道为什么。

I'm trying to adapt the answer given in this question so that it works in the latest version of ggplot2. Influenced by comments on the ggplot google group, here, I used the latest version of geom-point-.r as a template, adding a "label" field to the gp argument in various places. Then I copied the remaining code from kohske's answer. But it doesn't work -- there aren't any labels in the resulting svg, and I can't figure out why.

我注意到, code> point_grobs_labels 为null,当我查看 grid.get(point_grob_names [1])$ ​​gp 时,没有标签字段...

I did notice that everything in point_grobs_labels is null, and when I look at grid.get(point_grob_names[1])$gp, there is no label field...

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


推荐答案

试试这个:

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

没有太大变化,但我必须添加

there were no big changes, but I had to add

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

然后是

and then

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

也改为

also changes to

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 重新排列,仅由它们分隔:

and then labels (which we manage to get with other modifications) remain the same, i.e. not rearranged by gears, only split by it:

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

但将这些标签名称作为列修复了问题。

but having these label names as a column fixes the problem.

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

这篇关于与gridSVG和ggplot2 v.0.9.0的交互点标签的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!

09-05 20:37
查看更多