Nhãn điểm tương tác với lướiSVG và ggplot2 v.0.9.0

Question

Tôi muốn gắn nhãn các điểm trong một ggplot tương tác, để di chuột qua một điểm sẽ hiển thị nhãn.

Tôi đang cố gắng điều chỉnh câu trả lời được đưa ra trong this question để nó hoạt động trong phiên bản mới nhất của ggplot2. Bị ảnh hưởng bởi nhận xét trên nhóm google ggplot, here, tôi đã sử dụng phiên bản mới nhất của geom-point-.r làm mẫu, thêm trường "nhãn" vào đối số gp ở các vị trí khác nhau. Sau đó, tôi đã sao chép mã còn lại từ câu trả lời của kohske. Nhưng nó không hoạt động - không có bất kỳ nhãn nào trong svg kết quả, và tôi không thể hiểu tại sao.

tôi đã thông báo rằng tất cả mọi thứ trong point_grobs_labels là null, và khi tôi nhìn vào grid.get(point_grob_names[1])$gp, không có lĩnh vực nhãn ...

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

Hãy thử điều này:

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

không có lớn thay đổi, nhưng tôi phải thêm

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

và sau đó

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

cũng thay đổi để

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

vì chúng tôi có 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" 
..... 

và sau đó nhãn (mà chúng tôi quản lý để có được với những thay đổi khác) vẫn như cũ, tức là không sắp xếp lại bởi gears, chỉ chia cho nó:

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

nhưng có các tên nhãn này làm cột khắc phục sự cố.

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

Nhờ tracy cho một câu hỏi hay và Julius cho câu trả lời rất hữu ích.

Để làm cho javascript của Julius hoạt động cho tôi trong Chrome và Safari, tôi phải thay thế this.id bằng this.correspondingUseElement.id. Điều này có ý nghĩa bởi vì phần tử SVG đơn <circle> không có id cho mỗi geom_point, id mà chúng tôi muốn được gắn vào các phần tử <use>.

Thậm chí điều đó không hiệu quả đối với tôi trong Firefox, vì vậy tôi đã thay đổi nó để đính kèm trình xử lý sự kiện vào chính các thành phần <use>. Lưu ý rằng nếu SVG phức tạp hơn, nó có thể có <use> s khác với geom_points, vì vậy tôi đã thêm một if để chỉ đính kèm sự kiện vào phần tử geom_point.XX <use>. Này hoạt động trong Chrome, Safari, và Firefox cho tôi:

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

(tất cả các mã khác như Julius của)

Answer 3

Chúng tôi giải quyết điều này bằng cách phát hiện các thuộc tính màu trong .svg sản xuất và sử dụng css để phát hiện mouseover .Kết quả có thể nhìn thấy trong các bước 4,5,6 của demo này:

Showing svg highlighting using css

Đây là phản ứng đầu tiên của tôi stackoverflow - hy vọng tôi có các nghi thức đúng