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

Answer 1

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

Answer 2

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)

Answer 3

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

Answer 4

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!