Interactive point labels with gridSVG and ggplot2 v.0.9.0

Question

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

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.

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

score 12 · Accepted Answer · answered Jul 16 '12 at 12:50

Try this:

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)

because we have 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"
.....

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

Nice! Thank you! I was looking for a full, working example just like this one. I have a couple of questions, though: what role does "proto" play in the script? You're using it to redefine geom_point, right? I'm interested in creating interactive plots out of ggplot2 graphs I made . Can you recommend any tutorial/source on getting R to work with Javascript with RJSON and creating SVGs? — MatteoS, Jul 16 '12 at 15:30
@MatteoS, Unfortunately, I can't help you much here, mainly I just tried to find a solution to this particular problem. But you might be right, possibly redefining `geom_point` allows us to use these labels, which I would call the base at least in this case. So, I would offer you to explore this example, especially Javascript, `grid.get()` and `grid.ls()` parts. — Julius Vainora, Jul 16 '12 at 16:25
Thanks a lot Julius (and tracy for asking the question). Do you have any idea on how to adapt this approach to polygon geoms? — ferrouswheel, Dec 16 '13 at 02:04
@ferrouswheel, not really, since at least for me this version no longer works even with points. — Julius Vainora, Dec 16 '13 at 09:41

score 1 · Answer 2 · answered Apr 29 '13 at 19:02

Thanks to tracy for a good question and Julius for the very helpful answer.

To make Julius's javascript work for me in Chrome and Safari, I had to replace this.id with this.correspondingUseElement.id. This makes sense because the single <circle> SVG element doesn't have an id for each geom_point, the id we want is attached to the <use> elements.

Even that didn't work for me in Firefox, so I changed it to attach the event listener to the <use> elements themselves. Note that if the SVG is more complicated, it might have <use>s other than the geom_points, so I added an if to only attach the event to the geom_point.XX <use> elements. This works in Chrome, Safari, and Firefox for me:

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

(all other code same as Julius's)

score 0 · Answer 3 · answered May 25 '13 at 12:41

We solved this by detecting the color attribute in the produced .svg and using css to detect mouseover. Results are visible in steps 4,5,6 of this demo:

Showing svg highlighting using css

This is my first stackoverflow response - hope I got the etiquette right

score 0 · Answer 4 · answered Jun 20 '18 at 04:03

This is sort of a general answer. I'm just here to help you make the plot interactive. You can try this -

library(ggplot2)
library(plotly)

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

Enjoy!

Interactive point labels with gridSVG and ggplot2 v.0.9.0

4 Answers4

Linked