我想在ggplot标记点的交互方式，使鼠标悬停在一个点显示的标签。
我在努力适应中给出的回答这个问题 ，使其工作在GGPLOT2的最新版本。 通过在谷歌ggplot组评论的影响， 在这里 ，我使用了最新版本的geom点-.R为模板，添加一个“标签”字段中各个地方的GP参数。 然后，我复制从kohske的回答其余代码。 但是，这是行不通的 - 有没有在产生的任何SVG标签，我想不通为什么。
我也注意到，一切都在point_grobs_labels是空的，当我看着grid.get(point_grob_names[1])$gp ，没有标签领域...
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()
没有大的变化，但我不得不添加
mtcars2 <- data.frame(mtcars, names = rownames(mtcars))
然后
p <- ggplot(mtcars, aes(mpg, wt, label = rownames(mtcars)))
+ geom_point2() + facet_wrap(~ gear)
也变为
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 ，只有把它拆分：
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]]
....
但有这些标签名称为列修复该问题。
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]]
....
由于麦蒂一个很好的问题，朱利叶斯的非常有用的答案。
为了让朱利叶斯的我在Chrome和Safari浏览器的JavaScript的工作，我不得不更换this.id与this.correspondingUseElement.id 。 这是有意义的，因为单<circle> SVG元件不具有为每个geom_point的ID，我们想要的ID被附加到的<use>元素。
即使是那些没有在Firefox为我工作，所以我改成了事件监听器连接到<use>元素本身。 请注意，如果SVG更复杂，它可能有<use>比那geom_points其他，所以我说的if只重视该事件的geom_point.XX <use>元素。 这个工程在Chrome，Safari浏览器和Firefox对我来说：
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);
（所有其他的代码一样朱利叶斯的）
我们通过检测在所产生的.svg颜色属性和使用CSS检测鼠标悬停解决了这个。 结果在这个步骤演示4,5,6可见：
显示用css SVG高亮
这是我的第一个计算器响应 - 希望我得到了正确的礼仪
这是那种一般的答案。 我只是在这里帮助你做出的情节互动。 你可以试试这个 -
library(ggplot2)
library(plotly)
# Plot how you would normally code for ggplot2
p <- ggplot(data,... 'add your variables and subsequent plots')
ggplotly(p)
请享用！
