Etiquetas de puntos interactivos con gridSVG y ggplot2 v.0.9.0

Question

Me gustaría etiquetar puntos en un ggplot de forma interactiva, de modo que el mouse sobre un punto muestre una etiqueta.

Estoy tratando de adaptar la respuesta dada en this question para que funcione en la última versión de ggplot2. Influenciado por los comentarios en el grupo ggplot google, here, utilicé la última versión de geom-point-.r como una plantilla, agregando un campo "etiqueta" al argumento gp en varios lugares. Luego copié el código restante de la respuesta de Kohske. Pero no funciona, no hay etiquetas en el svg resultante, y no puedo entender por qué.

Me di cuenta de que todo en point_grobs_labels es nulo, y cuando miro grid.get(point_grob_names[1])$gp, no hay campo de etiqueta ...

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

Prueba esto:

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

no hubo grandes cambios, pero he tenido que añadir

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

y luego

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

también cambia a

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

porque tenemos 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" 
..... 

y luego las etiquetas (que maneja conseguir con otras modificaciones) siguen siendo los mismos, es decir, no reordenado por gears, solo dividido por él:

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

pero tener estos nombres de etiqueta como columna soluciona el problema.

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

Gracias a tracy por una buena pregunta y a Julius por la respuesta tan útil.

Para hacer que el javascript de Julius funcione en Chrome y Safari, tuve que reemplazar this.id con this.correspondingUseElement.id. Esto tiene sentido porque el elemento único SVG <circle> no tiene una identificación para cada punto geom, el id que queremos se adjunta a los elementos <use>.

Incluso eso no funcionó para mí en Firefox, así que lo cambié para adjuntar el detector de eventos a los elementos <use>. Tenga en cuenta que si el SVG es más complicado, podría tener <use> s además de los puntos geom, así que agregué un if para adjuntar el evento solo a los elementos geom_point.XX <use>. Esto funciona en Chrome, Safari y Firefox para mí:

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

(todo otro código mismo que Julius)

Answer 3

Nos lo resolvió mediante la detección del atributo de color en el .svg producido y el uso de CSS para detectar mouseover .Los resultados son visibles en los pasos 4,5,6 de esta demostración:

Showing svg highlighting using css

Ésta es mi primera respuesta stackoverflow - espero que me dieron la etiqueta correcta