Another Update
This update adds functionality that meets your latest request.
- When you hover over any point, you will see the tooltip only.
- If you click on a point, you will see lines that connect to the associated jobs.
- If you move the mouse (e.g.,
unhover, mousemove)
- original tooltip (lines' origin point) will persist
- if you hover over any point connected by a line, you'll see that tooltip, as well
- if you hover over a different point connected by a line— the origin and a new tooltip will be persistent (other tips will go away) -- in other words, at most you will see two tooltips at one time
- If you double click
- all lines will change to visible: false
- no persistent tooltips
- If you click, without having 'double clicked' or clearing the board, it will behave as if you double-clicked, then clicked (removes any previous lines; creates a new origin for persistent tooltip)
Option 4
Max: 1 set of lines and 2 tooltips; click to activate; double-click to clear
p %>% htmlwidgets::onRender(
"function(el, x) {
nms = ['curveNumber', 'pointNumber'];
coll = []; /* for persistent tooltip */
giveMe = []; /* for connected data points */
oArr = el.data[0]; /* the x, y data for the scatter trace */
redu = function(val, arr) { /* closest data point in array*/
return arr.reduce((these, those) => {
return Math.abs(those - val) < Math.abs(these - val) ? those : these;
});
}
closest = function(xval, yval) { /* p.xvals/yvals from pt data; arr is x/y data obj */
/* id nearest x and nearest y, make sure they match, if no match, take larger index */
xpt = redu(xval, oArr.x); /* get closest data point for x axis*/
ypt = redu(yval, oArr.y); /* get closest data point for y axis*/
xi = oArr.x.indexOf(xpt); /* get index value for x data point */
yi = oArr.x.indexOf(ypt); /* get index value for x data point */
return xi > yi ? xi : yi; /* if the indices != return larger # */
}
el.on('plotly_hover', function(p) {
pt = p; /* global: for use in unhover */
})
el.on('plotly_unhover', function(p) { /* create persistent tooltips */
if(coll.length > 0){ /* if click occurred else no persistence */
if(giveMe.length < 1) return; /* are there lines connecting points? */
if(!Array.isArray(giveMe)) giveMe = [giveMe]; /* make sure its an array */
whatNow = closest(pt.xvals[0], pt.yvals[0]); /* mouse on connected point? */
if(giveMe.includes(whatNow)) { /* if hover pointIndex is connected */
coll[1] = whatNow; /* add connected point to array for tips */
hvr = []; /* clear array for curve & point list */
for(ea in coll) { /* create list for hovering */
var oj = {}; oj[nms[0]] = 0;
oj[nms[1]] = coll[ea];
hvr.push(oj);
}
} else {
hvr = [{'curveNumber': 0, 'pointNumber': coll[0]}]; /* if coll, create tooltip */
}
Plotly.Fx.hover(el, hvr); /* persistent tooltips */
}
})
el.on('plotly_click', function(p) { /* create persistent lines upon click */
/* if any lines already vis-- hide them */
Plotly.restyle(el, {'visible': false}, pt.xaxes[0]._traceIndices.slice(1,));
giveIt = p.points[0].pointIndex; /* capture scatter index for curve number */
if(p.points[0].customdata) {
giveMe = p.points[0].customdata; /* get point's array of customdata */
} else {giveMe = []}
coll[0] = giveIt; /* collect index for persistent tooltip */
Plotly.restyle(el, {'visible': true}, [giveIt + 1]);
})
el.on('plotly_doubleclick', function(p) { /* remove lines & pers tooltips */
Plotly.restyle(el, {'visible': false}, pt.xaxes[0]._traceIndices.slice(1,));
coll = []; /* reset arrays, until next double click */
giveMe = [];
})
}")
This is an explanation of what is happening in this code (in general).
coll will contain the point indices for persistent tooltips
giveMe will contain the indices of connected data points (the customdata that is added to the plot)
oArr, redu(), & closest() are used to calculate the closest data point (when you make a tooltip persistent, Plotly won't identify or calculate new hover points, but it still captures screen position.
On hover just captures the hover data as a global variable. The hover data contains the screen position of the mouse.
On click any visible lines are removed; the point clicked will become a persistent tooltip; lines are drawn to connected data. Additionally, the connected data point indices from customdata are captured (this is giveMe). giveMe is utilized in unhover.
On unhover, if an origin has been selected (a point was clicked and there are lines on the graph), then... (if no click has occurred, then this function does nothing). If giveMe is empty, indicating no connected data (there are no lines)--no persistent tooltip is created. If there are connections, then all mouse moves are calculated to determine if the mouse is over a data point connected by a line. (There is a lot happening here behind the scenes.) This function uses oArr, redu, and closest for this purpose and creates a second tooltip when criteria are met.
On doubleclick, lines & tooltips' persistence is removed.
Updated by request
I created two new options. The first is what you asked for. However, it's pretty clunky. I think you may prefer the second option.
I noticed that when I created nodes3 wasn't creating the data as I had intended it. This led me to discover several weaknesses in the lapply, as well. These are fixed here, as well.
There are updates to the lapply that are specific to the 2nd option, but regardless of what option you use, it will work.
# create a simulation of jobs that match
nodes3 <- lapply(1:nrow(nodes), function(k) {
thisOne <- nodes$name[k]
mtch <- nodes$name[
grep(pattern = paste0("^", substr(thisOne, 1, 1)), nodes$name)]
mtch <- mtch[!mtch %in% thisOne]
if(length(mtch) < 1) {
data.frame(occ1 = character(), occ2 = character(), # if no matches
x = factor(), y = factor())
} else {
data.frame(occ1 = rep(thisOne, length(mtch)), occ2 = mtch, # if matches
x = nodes$x[k], y = nodes$y[k])
}
}) %>% bind_rows()
cdt = list() # list for the connected data point indices (used for 2nd option)
# retain order of points in lines' traces
invisible(lapply(1:nrow(df3), function(j) {
dt <- df3[j, ] # point the lines will originate from
mtch <- nodes3 %>%
filter(x == dt$x1, y == dt$y1, occ1 == dt$nm) %>% # matching occ2
select(occ2) %>% unlist(use.names = F)
nodes4 <- df3[df3$nm %in% mtch, ] # extract matched x, y positions
if(nrow(nodes4) < 1) {
p <<- p %>% # create trace so indices remain correct!
add_lines(x = rep(df3[j, ]$x, 2), y = rep(df3[j, ]$y, 2), visible = F) # create lines
return() # if no similar occupations
}
# create segment vectors for x and y
xs <- lapply(1:nrow(nodes4), function(m) {c(dt$x, nodes4[m, ]$x, NA)}) %>% unlist()
ys <- lapply(1:nrow(nodes4), function(m) {c(dt$y, nodes4[m, ]$y, NA)}) %>% unlist()
# get row numbers of connected data
vect <- which(df3$x %in% nodes4$x & df3$y %in% nodes4$y)
cdt[[j]] <<- vect - 1 # 0 ind in JS, so subtract one from every value
p <<- p %>%
add_lines(x = xs, y = ys, visible = F) # create lines
}))
p
p$x$data[[1]]$customdata <- cdt # add vectors to plot (used for 2nd option)
Option 1
In the first option, I used plotly_doubleclick. To make this work, I've modified the creation of p. I did this because I can't double-click my mouse fast enough for Plotly to register the action without this argument.
p <- ggplotly(gg) %>% config(doubleClickDelay = 1000)
Leaving the lines up until clicking becomes a hot mess really quickly. It took me making it to find the potential issues with it.
p %>% htmlwidgets::onRender(
"function(el, x) {
giveMe = Array();
el.on('plotly_hover', function(p) { /* when hovering add lines */
tellMe = p.points[0].pointIndex; /* capture scatter index for curve number */
giveMe.push(tellMe + 1);
Plotly.restyle(el, {'visible': true}, giveMe);
})
el.on('plotly_doubleclick', function(p) { /* when unhovering remove lines */
Plotly.restyle(el, {'visible': false}, giveMe);
giveMe = []; /* clear list after changing to visible = F */
})
}")
Option 2
This version uses plot_click, in addition to the hovering methods. When you hover/unhover, it will still show hide the lines. However, when you click on a data point, it will show the tooltips for every point that has a line to it.
Before the lapply is called, I create an empty list. This list will store the row numbers of the data that are connected by lines which will translate to indices of the points in the plot.
After the lapply is called, I add this list of vectors to the first trace as customdata. So that these indices can be accessed in the Javascript.
Here's the code to create the custom featured tooltips via clicking. I want to specify--clicking anywhere won't work, you have to click on the data point you're interested in.
p %>% htmlwidgets::onRender(
"function(el, x) {
nms = ['curveNumber', 'pointNumber'];
el.on('plotly_hover', function(p) { /* when hovering add lines */
tellMe = p.points[0].pointIndex; /* capture scatter index for curve number */
Plotly.restyle(el, {'visible': true}, [tellMe + 1]);
})
el.on('plotly_unhover', function(p) { /* when unhovering remove lines */
Plotly.restyle(el, {'visible': false}, [tellMe + 1]);
})
el.on('plotly_click', function(p) {
var giveMe = p.points[0].customdata; /* get point's array of customdata */
giveMe.push(tellMe); /* add current pointIndex to list */
hvr = []; /* clear array for curve & point list*/
for(ea in giveMe) { /* create list for hovering */
var oj = {}; oj[nms[0]] = 0;
oj[nms[1]] = giveMe[ea] + 1;
hvr.push(oj);
}
Plotly.Fx.hover(el, hvr); /* show tooltips for points */
})
}")
All the code altogether (with update)
library(tidyverse)
library(plotly)
gg <- ggplot(nodes, aes(x = x, y = y, text = paste0("Selected Jobs: ", name))) +
geom_jitter(width = 0.2, height = 0.2, size = 1, color = "steelblue") +
labs(x = "Job Type", y = "Experience Level") +
theme_minimal() +
theme(panel.grid = element_blank()) +
coord_cartesian(clip = "off") +
theme(plot.margin = margin(20, 20, 20, 20))
# slow click speed required (used with option 1)
p <- ggplotly(gg) %>% config(doubleClickDelay = 1000)
# capture jitter data
df3 <- data.frame(x = p$x$data[[1]]$x, y = p$x$data[[1]]$y,
nm = nodes$name, x1 = nodes$x, y1 = nodes$y)
# create a simulation of jobs that match
nodes3 <- lapply(1:nrow(nodes), function(k) {
thisOne <- nodes$name[k]
mtch <- nodes$name[
grep(pattern = paste0("^", substr(thisOne, 1, 1)), nodes$name)]
mtch <- mtch[!mtch %in% thisOne]
if(length(mtch) < 1) {
data.frame(occ1 = character(), occ2 = character(), # if no matches
x = factor(), y = factor())
} else {
data.frame(occ1 = rep(thisOne, length(mtch)), occ2 = mtch, # if matches
x = nodes$x[k], y = nodes$y[k])
}
}) %>% bind_rows()
cdt = list() # list for the connected data point indices (used for 2nd option)
# retain order of points in lines' traces
invisible(lapply(1:nrow(df3), function(j) {
dt <- df3[j, ] # point the lines will originate from
mtch <- nodes3 %>%
filter(x == dt$x1, y == dt$y1, occ1 == dt$nm) %>% # matching occ2
select(occ2) %>% unlist(use.names = F)
nodes4 <- df3[df3$nm %in% mtch, ] # extract matched x, y positions
if(nrow(nodes4) < 1) {
p <<- p %>% # create trace so indices remain correct!
add_lines(x = rep(df3[j, ]$x, 2), y = rep(df3[j, ]$y, 2), visible = F) # create lines
return() # if no similar occupations
}
# create segment vectors for x and y
xs <- lapply(1:nrow(nodes4), function(m) {c(dt$x, nodes4[m, ]$x, NA)}) %>% unlist()
ys <- lapply(1:nrow(nodes4), function(m) {c(dt$y, nodes4[m, ]$y, NA)}) %>% unlist()
# get row numbers of connected data
vect <- which(df3$x %in% nodes4$x & df3$y %in% nodes4$y)
cdt[[j]] <<- vect - 1 # 0 ind in JS, so subtract one from every value
p <<- p %>%
add_lines(x = xs, y = ys, visible = F) # create lines
}))
p
p$x$data[[1]]$customdata <- cdt # add vectors to plot (used for 2nd option)
#------- Option 1 from update: -------
# hover to show lines, click to remove lines
p %>% htmlwidgets::onRender(
"function(el, x) {
giveMe = Array();
el.on('plotly_hover', function(p) { /* when hovering add lines */
tellMe = p.points[0].pointIndex; /* capture scatter index for curve number */
giveMe.push(tellMe + 1);
Plotly.restyle(el, {'visible': true}, giveMe);
})
el.on('plotly_doubleclick', function(p) { /* when unhovering remove lines */
Plotly.restyle(el, {'visible': false}, giveMe);
giveMe = []; /* clear list after changing to visible = F */
})
}")
#------- Option 2 from update: -------
# hover/unhover to show/hide lines; click show tooltips
p %>% htmlwidgets::onRender(
"function(el, x) {
nms = ['curveNumber', 'pointNumber'];
el.on('plotly_hover', function(p) { /* when hovering add lines */
tellMe = p.points[0].pointIndex; /* capture scatter index for curve number */
Plotly.restyle(el, {'visible': true}, [tellMe + 1]);
})
el.on('plotly_unhover', function(p) { /* when unhovering remove lines */
Plotly.restyle(el, {'visible': false}, [tellMe + 1]);
})
el.on('plotly_click', function(p) {
var giveMe = p.points[0].customdata; /* get point's array of customdata */
if(giveMe.length < 1) return;
if(!Array.isArray(giveMe)) giveMe = [giveMe];
giveMe.push(tellMe); /* add current pointIndex to list */
hvr = []; /* clear array for curve & point list*/
for(ea in giveMe) { /* create list for hovering */
var oj = {}; oj[nms[0]] = 0;
oj[nms[1]] = giveMe[ea];
hvr.push(oj);
}
Plotly.Fx.hover(el, hvr); /* show tooltips for points */
})
}")
#------- Original hover/unhover calls in answer -------
# hover/unhover to show/hide lines
p %>% htmlwidgets::onRender(
"function(el, x) {
el.on('plotly_hover', function(p) { /* when hovering add lines */
tellMe = p.points[0].pointIndex; /* capture scatter index for curve number */
Plotly.restyle(el, {'visible': true}, [tellMe + 1]);
})
el.on('plotly_unhover', function(p) { /* when unhovering remove lines */
Plotly.restyle(el, {'visible': false}, [tellMe + 1]);
})
}")
Originally...
Things to note:
- I don't have the data that connects similar occupations, I only have the
dput for nodes. In lieu of having the connected jobs, I created a fake set of connected jobs.
- If the appearance or functionality isn't what you were looking for, let me know what you imagined differently and I can edit my answer.
- At the end of my answer I have added all of the code altogether for easier copy + paste.
Because this would be a hot mess if all the lines were always visible, I've modified this so that when you hover it creates the lines (as in your example plot that you provided a link for in your question).
Because you're using ggplot's jitter functionality, every time you run the plot, it jitters slightly differently. In order to create the segments, create the object gg and p as you already have. (So the jitter positions are permanent.)
You can modify gg slightly so that you don't need to modify the hover text after the fact. Instead of text = name, use text = paste0("Selected Jobs: ", name). In my code, you'll see that there is no event_register or prepend (all of which are replaced by this modification in ggplot).
library(plotly)
library(tidyverse)
gg <- ggplot(nodes, aes(x = x, y = y, text = paste0("Selected Jobs: ", name))) +
geom_jitter(width = 0.2, height = 0.2, size = 1, color = "steelblue") +
labs(x = "Job Type", y = "Experience Level") +
theme_minimal() +
theme(panel.grid = element_blank()) +
coord_cartesian(clip = "off") +
theme(plot.margin = margin(20, 20, 20, 20))
p <- ggplotly(gg) # create plotly object to get jitter x, y
First step:
Extract the jittered data from your plotly object. These are the x and y that represent the scattered points' positions on the plot.
# capture jitter data & combine with nodes data
df3 <- data.frame(x = p$x$data[[1]]$x, y = p$x$data[[1]]$y,
nm = nodes$name, x1 = nodes$x, y1 = nodes$y)
Interim step:
Here is where I created a fake set of data to simulate the connection between jobs. You won't need to create this data, but I included it for reproducibility.
# create a simulation of jobs that match
nodes3 <- lapply(1:nrow(nodes), function(k) {
thisOne <- nodes$name[k]
mtch <- nodes$name[grep(pattern = paste0("^", substr(nodes$name, 1, 1)), nodes$name)]
mtch <- mtch[!mtch %in% thisOne]
data.frame(occ1 = rep(thisOne, length(mtch)), occ2 = mtch,
x = nodes$x[k], y = nodes$y[k])
}) %>% bind_rows()
Second step:
Now it's time to create the lines. You will create a Plotly trace for each row in the Nodes data. In other words, a set of lines for each scatter point on the plot. It's important to go through the rows as you fed it to Plotly, the order in which you create the lines is important! The functionality in the disappearing/reappearing lines is built on assuming the lines are created in the same order as the data scatter points.
I used lapply to go through each row in df3 (same number of rows in nodes). Using the nm in df3 (name in nodes), the data I created is filtered for matching occupations.
I only used the occupation, but you identified other criteria in your question. Again, I don't have that data, so I can't create those filters for you. Ideally, you would create a data set with this content prefiltered. However, when you look at this code, you will see how I filtered and you can change those filters here, as well.
After the matching 'points' positions are identified, I create vectors that represent line segments. There is no inherent mode for line segments in Plotly.
Here's an example of what that looks like in Plotly. If I wanted 2 segments that started at (1, 1) and ended at (2, 5) and (3, 7), this is what my x and y vectors would look like
x = c(1, 2, NA, 1, 3)
y = c(1, 5, NA, 1, 7)
An NA is placed between each start and end position.
Since there may be no similar professions, I use an if statement to look for no matches. Since there may many matching professions, each vector (x and y) are created using lapply to go through each match to create the vector.
Once x and y are identified, the lines trace is created and added to the plot. These traces are visible = F.
# retain order of points in lines' traces
invisible(lapply(1:nrow(df3), function(j) {
dt <- df3[j, ] # the row the lines will originate from
mtch <- nodes3 %>%
filter(x == dt$x1, y == dt$y1, occ1 == dt$nm) %>% # extract all matching occ2
select(occ2) %>% unlist()
nodes4 <- df3[df3$nm %in% mtch, ] # extract matched x, y positions
if(nrow(nodes4) < 1) return() # where there are no similar occupations
xs <- lapply(1:nrow(nodes4), function(m) {c(dt$x, nodes4[m, ]$x, NA)}) %>% unlist()
ys <- lapply(1:nrow(nodes4), function(m) {c(dt$y, nodes4[m, ]$y, NA)}) %>% unlist()
p <<- p %>% # add lines to plot
add_lines(x = xs[-(length(xs) - 1)], y = ys[-(length(xs) - 1)], visible = F)
}))
Final step:
Now it's time to add the functionality that makes the lines appear and disappear when you hover over a data point.
I used htmlwidgets::onRender(), Plotly's events plotly_hover and plotly_unhover, and Plotly.restyle to make this happen.
When you hover over a point, the event data includes the point index and the curve number. The curve number is the index of the trace. The curve number can also be used in Plotly.restyle. When I create the object tellMe, by leaving off what type of variable it is, I've created a global variable, thus allowing me to use this value in another function (created in one function, but used in two functions). Using the trace index (+ 1, as the scatter points is the first trace) you'll toggle the visibility of that data points' line segments.
p %>% htmlwidgets::onRender(
"function(el, x) {
el.on('plotly_hover', function(p) { /* when hovering add lines */
tellMe = p.points[0].pointIndex; /* capture scatter index for curve number */
Plotly.restyle(el, {'visible': true}, [tellMe + 1]);
})
el.on('plotly_unhover', function(p) { /* when unhovering remove lines */
Plotly.restyle(el, {'visible': false}, [tellMe + 1]);
})
}")
All the code in one place
library(plotly)
library(tidyverse)
gg <- ggplot(nodes, aes(x = x, y = y, text = paste0("Selected Jobs: ", name))) +
geom_jitter(width = 0.2, height = 0.2, size = 1, color = "steelblue") +
labs(x = "Job Type", y = "Experience Level") +
theme_minimal() +
theme(panel.grid = element_blank()) +
coord_cartesian(clip = "off") +
theme(plot.margin = margin(20, 20, 20, 20))
p <- ggplotly(gg)
# capture jitter data
df3 <- data.frame(x = p$x$data[[1]]$x, y = p$x$data[[1]]$y,
nm = nodes$name, x1 = nodes$x, y1 = nodes$y)
# create a simulation of jobs that match
nodes3 <- lapply(1:nrow(nodes), function(k) {
thisOne <- nodes$name[k]
mtch <- nodes$name[grep(pattern = paste0("^", substr(nodes$name, 1, 1)), nodes$name)]
mtch <- mtch[!mtch %in% thisOne]
data.frame(occ1 = rep(thisOne, length(mtch)), occ2 = mtch,
x = nodes$x[k], y = nodes$y[k])
}) %>% bind_rows()
# retain order of points in lines' traces
invisible(lapply(1:nrow(df3), function(j) {
dt <- df3[j, ] # the row the lines will originate from
mtch <- nodes3 %>%
filter(x == dt$x1, y == dt$y1, occ1 == dt$nm) %>% # extract all matching occ2
select(occ2) %>% unlist()
nodes4 <- df3[df3$nm %in% mtch, ] # extract matched x, y positions
if(nrow(nodes4) < 1) return() # where there are no similar occupations
xs <- lapply(1:nrow(nodes4), function(m) {c(dt$x, nodes4[m, ]$x, NA)}) %>% unlist()
ys <- lapply(1:nrow(nodes4), function(m) {c(dt$y, nodes4[m, ]$y, NA)}) %>% unlist()
p <<- p %>% # add lines to plot
add_lines(x = xs[-(length(xs) - 1)], y = ys[-(length(xs) - 1)], visible = F)
}))
p %>% htmlwidgets::onRender( # show me what you've got!
"function(el, x) {
el.on('plotly_hover', function(p) { /* when hovering add lines */
tellMe = p.points[0].pointIndex; /* capture scatter index for curve number */
Plotly.restyle(el, {'visible': true}, [tellMe + 1]);
})
el.on('plotly_unhover', function(p) { /* when unhovering remove lines */
Plotly.restyle(el, {'visible': false}, [tellMe + 1]);
})
}")
BTW, if you want all of the segments to be the same color, add the argument, color = I("black") (or whatever color you're looking for) to the add_lines(... when creating the line segments.
