英文:
How to add links to similar jobs on ggplot points?
问题
我想创建一个工作相似性可视化,类似于这个网站上的:https://www.irecsolarcareermap.org/。
最初,我尝试使用力导向网络,但我注意到这个函数不支持分类的X和Y轴。
这一次,我尝试使用ggplot。基本的可视化看起来还可以,但我想在点击代表工作的圆圈时添加指向类似工作的链接。
"data.csv"文件包含诸如Occ1、Occ2、Full Transferability(相似性水平)和Occupation(用于合并)等列。它有超过10,000行,我需要将每个Occ1匹配到Occ2。
工作“Automotive Engineering Technician”应该有与“Electronic / Electrical Assembler”和“Electronics Assembler”的线条链接。
此外,“experience.csv”文件有Occupation和Strata.Level的列,共有126行。“jobType”文件有Occupation和Job_type的列,共有176行。
如果一个工作既不属于经验也不属于工作类型,我想将其删除。
我尝试过以下方法:
library(ggplot2)
library(plotly)
# 读取数据
data <- read.csv("data.csv")
experience <- read.csv("experience.csv")
jobType <- read.csv("JobType.csv")
# 基于Full Transferability筛选数据
filtered_data <- subset(data, Full.Transferability >= 0.9)
# 从筛选后的数据、jobType和experience获取所有唯一的职业
all_occupations <- unique(c(filtered_data$Occ1, filtered_data$Occ2, jobType$Occupation, experience$Occupation))
# 创建具有x和y坐标的节点数据框
nodes <- data.frame(
name = all_occupations,
x = jobType$Job_type[match(all_occupations, jobType$Occupation)],
y = experience$Strata.Level[match(all_occupations, experience$Occupation)]
)
# 删除具有缺失x或y值的行
nodes <- nodes[complete.cases(nodes$x, nodes$y), ]
# 创建一个带有抖动的散点图
gg <- ggplot(nodes, aes(x = x, y = y, text = 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()) +
geom_hline(aes(yintercept = y), color = "gray", linetype = "dashed") +
geom_vline(aes(xintercept = x), color = "gray", linetype = "dashed") +
coord_cartesian(clip = "off") +
theme(plot.margin = margin(20, 20, 20, 20))
# 将ggplot转换为plotly对象
p <- ggplotly(gg)
# 注册点击事件处理程序
event_register(p, "plotly_click")
# 定义处理点击事件的JavaScript函数
js <- "
function(eventData) {
var selectedJob = eventData.points[0].text;
alert('Selected job: ' + selectedJob);
}
"
# 将JavaScript函数添加到图中
p <- htmlwidgets::prependContent(p, htmltools::tags$script(js))
p
到目前为止,我已经获得了这个初始结果。
"Define JavaScript function to handle the click event" 不一定需要存在于弹出消息中。我只是尝试在点击工作时显示工作标题。
您知道如何使工作可点击并将它们链接到类似的工作吗?
英文:
I want to create a job similarity visualization that looks similar to the one found here: https://www.irecsolarcareermap.org/.
Initially, I tried using the force network, but I noticed that categorical X and Y axes are not available with this function.
This time, I'm attempting it with ggplot. The basic visualization looks okay, but I want to add links that point to similar jobs when I click on the circles representing the jobs.
The "data.csv" file contains columns such as Occ1, Occ2, Full Transferability (similarity level), and Occupation (for merging). It has over 10,000 rows, and I need to match each Occ1 to Occ2.
The job :Automotive Engineering Technician should have lines(link) to Electronic / Electrical Assembler and Electronics Assembler
Additionally, the "experience.csv" file has columns for Occupation and Strata.Level, with 126 rows. The "jobType" file has columns for Occupation and Job_type, with 176 rows.
If a job does not belong to both the experience and job types, I would like to remove it.
What I have tried is:
library(ggplot2)
library(plotly)
# Read the data
data <- read.csv("data.csv")
experience <- read.csv("experience.csv")
jobType <- read.csv("JobType.csv")
# Filter the data based on Full Transferability
filtered_data <- subset(data, Full.Transferability >= 0.9)
# Get all unique occupations from filtered data, jobType, and experience
all_occupations <- unique(c(filtered_data$Occ1, filtered_data$Occ2, jobType$Occupation, experience$Occupation))
# Create nodes dataframe with x and y coordinates
nodes <- data.frame(
name = all_occupations,
x = jobType$Job_type[match(all_occupations, jobType$Occupation)],
y = experience$Strata.Level[match(all_occupations, experience$Occupation)]
)
# Remove rows with missing x or y values
nodes <- nodes[complete.cases(nodes$x, nodes$y), ]
# Create a scatterplot with jittering
gg <- ggplot(nodes, aes(x = x, y = y, text = 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()) +
geom_hline(aes(yintercept = y), color = "gray", linetype = "dashed") +
geom_vline(aes(xintercept = x), color = "gray", linetype = "dashed") +
coord_cartesian(clip = "off") +
theme(plot.margin = margin(20, 20, 20, 20))
# Convert the ggplot to a plotly object
p <- ggplotly(gg)
# Register click event handler
event_register(p, "plotly_click")
# Define JavaScript function to handle the click event
js <- "
function(eventData) {
var selectedJob = eventData.points[0].text;
alert('Selected job: ' + selectedJob);
}
"
# Add the JavaScript function to the plot
p <- htmlwidgets::prependContent(p, htmltools::tags$script(js))
p
So far, I have gotten this initial result.
# Define JavaScript function to handle the click event
Does not necessary to be there for a pop-up message. I was just trying to show job titles when I click on jobs.
Do you know how to make jobs clickable and link them to similar jobs?"
答案1
得分: 5
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 = [];
<details>
<summary>英文:</summary>
### 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)
[![enter image description here][1]][1]
[![enter image description here][2]][2]
#### 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 /
coll1 = 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[nms1] = 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 */
})
}")
[![enter image description here][3]][3]
#### 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[nms1] = giveMe[ea] + 1;
hvr.push(oj);
}
Plotly.Fx.hover(el, hvr); / show tooltips for points */
})
}")
[![enter image description here][4]][4]
### 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[nms1] = 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).
[![enter image description here][5]][5]
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
[![enter image description here][6]][6]
### 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]);
})
}")
[![enter image description here][7]][7]
### 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.
[1]: https://i.stack.imgur.com/XJfri.png
[2]: https://i.stack.imgur.com/gOXV2.png
[3]: https://i.stack.imgur.com/lYjLd.png
[4]: https://i.stack.imgur.com/65lAk.png
[5]: https://i.stack.imgur.com/IGrOK.png
[6]: https://i.stack.imgur.com/Lz10d.png
[7]: https://i.stack.imgur.com/rhuuj.png
</details>
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论