# add interactive discrete legend guide to a ggplot -------
library(ggplot2)
library(ggiraph)
dat <- data.frame(
name = c( "Guy", "Ginette", "David", "Cedric", "Frederic" ),
gender = c( "Male", "Female", "Male", "Male", "Male" ),
height = c(169, 160, 171, 172, 171 ) )
p <- ggplot(dat, aes( x = name, y = height, fill = gender,
data_id = name ) ) +
geom_bar_interactive(stat = "identity")
# add interactive scale (guide is legend)
p1 <- p +
scale_fill_manual_interactive(
values = c(Male = "#0072B2", Female = "#009E73"),
data_id = c(Female = "Female", Male = "Male"),
tooltip = c(Male = "Male", Female = "Female")
)
x <- girafe(ggobj = p1)
if (interactive()) print(x)
# make the title interactive too
p2 <- p +
scale_fill_manual_interactive(
name = label_interactive("gender", tooltip="Gender levels", data_id="legend.title"),
values = c(Male = "#0072B2", Female = "#009E73"),
data_id = c(Female = "Female", Male = "Male"),
tooltip = c(Male = "Male", Female = "Female")
)
x <- girafe(ggobj = p2)
x <- girafe_options(x,
opts_hover_key(girafe_css("stroke:red", text="stroke:none;fill:red")))
if (interactive()) print(x)
# the interactive params can be functions too
p3 <- p +
scale_fill_manual_interactive(
name = label_interactive("gender", tooltip="Gender levels", data_id="legend.title"),
values = c(Male = "#0072B2", Female = "#009E73"),
data_id = function(breaks) { as.character(breaks)},
tooltip = function(breaks) { as.character(breaks)},
onclick = function(breaks) { paste0("alert(\"", as.character(breaks), "\")") }
)
x <- girafe(ggobj = p3)
x <- girafe_options(x,
opts_hover_key(girafe_css("stroke:red", text="stroke:none;fill:red")))
if (interactive()) print(x)
# also via the guide
p4 <- p + scale_fill_manual_interactive(
values = c(Male = "#0072B2", Female = "#009E73"),
data_id = function(breaks) { as.character(breaks)},
tooltip = function(breaks) { as.character(breaks)},
onclick = function(breaks) { paste0("alert(\"", as.character(breaks), "\")") },
guide = guide_legend_interactive(
title.theme = element_text_interactive(
size = 8,
data_id = "legend.title",
onclick = "alert(\"Gender levels\")",
tooltip = "Gender levels"
),
label.theme = element_text_interactive(
size = 8
)
)
)
x <- girafe(ggobj = p4)
x <- girafe_options(x,
opts_hover_key(girafe_css("stroke:red", text="stroke:none;fill:red")))
if (interactive()) print(x)
# make the legend labels interactive
p5 <- p +
scale_fill_manual_interactive(
name = label_interactive("gender", tooltip="Gender levels", data_id="legend.title"),
values = c(Male = "#0072B2", Female = "#009E73"),
data_id = function(breaks) { as.character(breaks)},
tooltip = function(breaks) { as.character(breaks)},
onclick = function(breaks) { paste0("alert(\"", as.character(breaks), "\")") },
labels = function(breaks) {
lapply(breaks, function(br) {
label_interactive(
as.character(br),
data_id = as.character(br),
onclick = paste0("alert(\"", as.character(br), "\")"),
tooltip = as.character(br)
)
})
}
)
x <- girafe(ggobj = p5)
x <- girafe_options(x,
opts_hover_key(girafe_css("stroke:red", text="stroke:none;fill:red")))
if (interactive()) print(x)
# add interactive continuous legend guide to a ggplot -------
library(ggplot2)
library(ggiraph)
set.seed(4393)
dsmall <- diamonds[sample(nrow(diamonds), 1000),]
p <- ggplot(dsmall, aes(x, y)) +
stat_density_2d(aes(
fill = stat(nlevel),
tooltip = paste("nlevel:", stat(nlevel))
),
geom = "interactive_polygon") +
facet_grid(. ~ cut)
# add interactive scale, by default the guide is a colourbar
p1 <- p + scale_fill_viridis_c_interactive(data_id = "nlevel",
tooltip = "nlevel")
x <- girafe(ggobj = p1)
if (interactive()) print(x)
# make it legend
p2 <- p + scale_fill_viridis_c_interactive(data_id = "nlevel",
tooltip = "nlevel",
guide = "legend")
x <- girafe(ggobj = p2)
if (interactive()) print(x)
# set the keys separately
p3 <- p + scale_fill_viridis_c_interactive(
data_id = function(breaks) {
as.character(breaks)
},
tooltip = function(breaks) {
as.character(breaks)
},
guide = "legend"
)
x <- girafe(ggobj = p3)
if (interactive()) print(x)
# make the title and labels interactive
p4 <- p + scale_fill_viridis_c_interactive(
data_id = function(breaks) {
as.character(breaks)
},
tooltip = function(breaks) {
as.character(breaks)
},
guide = "legend",
name = label_interactive("nlevel", data_id = "nlevel",
tooltip = "nlevel"),
labels = function(breaks) {
label_interactive(
as.character(breaks),
data_id = as.character(breaks),
onclick = paste0("alert(\"", as.character(breaks), "\")"),
tooltip = as.character(breaks)
)
}
)
x <- girafe(ggobj = p4)
x <- girafe_options(x,
opts_hover_key(girafe_css("stroke:red", text="stroke:none;fill:red")))
if (interactive()) print(x)
Run the code above in your browser using DataLab