在 htmlWidgets 的 onRender() 中修改选定点的有效方法
Efficient way to modify selected points in onRender() of htmlWidgets
我正在制作一个交互式图形，为 2 个定量变量（A 和 B）绘制黑点。用户可以select一个阈值。这样做之后，只会绘制高于该阈值大小的点，并且还会绘制一个表示未超过阈值的区域的灰色矩形。这一切似乎工作正常。
然而，我现在想要实现的是让用户select某些点。这样做时，selected 点应该从黑色变为红色。当用户 select 点的新子集时，先前 selected 点 return 从红色变为黑色。换句话说，图中唯一出现红色的点应该是最后 selected.
不幸的是，这部分似乎不起作用。现在的问题是：
1) selected 点永久保持红色。
2) 如果已经是红色的点被selected，有时未selected 的黑点变成红色。您可以在 post.
底部看到此错误的示例（在图片中）
我相信这会发生，因为我只是绘制了一条全新的与 x 和 y 值对应的红点轨迹 selected（这在下面的代码中注释为“// 添加用户- selected 点为红色")。因此，红点成为它们自己的实体。
我的问题是：什么是解决这个问题的有效方法（以便 selected 点变成红色直到另一个子集被 selected？）我使用有效这个词，因为我我正在处理大型数据集（100-1,000 点），因此我正在寻找节省计算速度的方法。简单地将 selected 的黑色点修改为红色而不是完全重绘叠加的红色点可能更有效？但是，我不确定如何使用 Plotly 跟踪语法来实现这一点。
如有任何帮助，我们将不胜感激。
下面是我的脚本的简化版本。
library(plotly)
library(GGally)
library(htmlwidgets)
ui <- shinyUI(fluidPage(
sliderInput("thresh", "Threshold:", min = 0, max = 3, value=1, step=1),
plotlyOutput("myPlot"),
textOutput("selectedValues")
))
server <- shinyServer(function(input, output) {
thresh <- reactive(input$thresh)
set.seed(1)
dat <- data.frame(Row = paste0("Row",sample(c(1:20),20)), A=4*rnorm(20), B=4*rnorm(20))
dat$Row <- as.character(dat$Row)
minVal = min(dat[,-1])
maxVal = max(dat[,-1])
gg <- ggplot(data = dat, aes(x=A, y=B)) + coord_cartesian(xlim = c(minVal, maxVal), ylim = c(minVal, maxVal))
ggY <- ggplotly(gg)
output$myPlot <- renderPlotly(ggY %>% onRender("
function(el, x, data) {
var Points = [];
var Traces = [];
var selRows = [];
data.dat.forEach(function(row){
if(Math.abs(row['B']) > data.thresh) selRows.push(row);});
var xArr = [];
var yArr = [];
var keepIndex = [];
for (a=0; a<selRows.length; a++){
xArr.push(selRows[a]['A'])
yArr.push(selRows[a]['B'])
keepIndex.push(selRows[a]['Row'])
}
Points.push(keepIndex);
// Add points above the threshold in black
var tracePoints = {
x: xArr,
y: yArr,
hoverinfo: 'none',
mode: 'markers',
marker: {
color: 'black',
size: 4
}
};
// Add upper horizontal line of gray box
var hiLine = {
x: [-15,15],
y: [data.thresh,data.thresh],
mode: 'lines',
line: {
color: 'gray',
width: 1
},
opacity: 0.25,
hoverinfo: 'none'
};
// Add lower horizontal line of gray box
var lowLine = {
x: [-15,15],
y: [-1*data.thresh,-1*data.thresh],
mode: 'lines',
fill: 'tonexty',
line: {
color: 'gray',
width: 1
},
opacity: 0.25,
hoverinfo: 'none'
};
Traces.push(tracePoints);
Traces.push(hiLine);
Traces.push(lowLine);
Plotly.addTraces(el.id, Traces);
var idRows = []
for (a=0; a<data.dat.length; a++){
idRows.push(data.dat[a]['Row'])
}
el.on('plotly_selected', function(e) {
numSel = e.points.length
cN = e.points[0].curveNumber;
var pointNumbers = [];
var selData = [];
for (a=0; a<numSel; a++){
pointNumbers.push(e.points[a].pointNumber)
selData.push(data.dat[idRows.indexOf(Points[0][pointNumbers[a]])])
}
Shiny.onInputChange('selData', selData);
var Traces = [];
var xArr = [];
var yArr = [];
for (a=0; a<selData.length; a++){
xArr.push(selData[a]['A'])
yArr.push(selData[a]['B'])
}
// Add user-selected points in red
var traceRed = {
x: xArr,
y: yArr,
mode: 'markers',
marker: {
color: 'red',
size: 4
},
hoverinfo: 'none'
};
Traces.push(traceRed);
Plotly.addTraces(el.id, Traces);
})
}", data = list(dat=dat, thresh=thresh())))
selData <- reactive(input$selData)
output$selectedValues <- renderPrint({selData()})
})
shinyApp(ui, server)
错误示例如下：
说，我用所有默认打开应用程序，我只是 Plotly-select 右上角的四个点。结果看起来不错，因为只有这四个点是红色的，如下所示：
现在，假设我重新select 前四点。结果看起来不再好，因为即使这四个点被涂成红色，另外两个点也被错误地涂成红色：
处理这个问题的最简单方法是简单地跟踪您是否有 selected 的东西，如果有以前的 select离子。为此，进行了以下更改：
- 添加了一个计数器
nseltrace 来跟踪我们select编辑东西的频率
- 添加了一个
Plotly.deleteTraces 语句来删除最后一条轨迹（可以用索引 -1 指定。
- 该删除操作由
if (nseltrace>0) 语句保护。
- 重新格式化您的 selection 点以将它们放入数据框中（它们作为字符向量一起出现）
- 使用
verbatumTextOutput 打印出来，因为它是一种更干净的格式。
更新：
- 添加了一个守卫，只有 select 个属于
curveNumber 1 的点，即原始数据，而不是后面的 selected 痕迹。这导致已经 selected 的点被输入到新的 selected 列表中两次。
至于这是否是最有效的方式，显然要视情况而定。您在以前的非 selected 表示上绘制了 selected 点，最坏的情况是两倍，但是点绘制速度非常快，并且对于一小部分点来说典型的减速甚至可能无法衡量。我不会优化它，除非后来证明它是一个问题，然后我会使用最新的 plotly，因为 plotly 代码库中目前正在进行大量优化（和错误删除）。
代码如下：
library(plotly)
library(GGally)
library(htmlwidgets)
library(shiny)
ui <- shinyUI(fluidPage(
sliderInput("thresh", "Threshold:", min = 0, max = 3, value=1, step=1),
plotlyOutput("myPlot"),
verbatimTextOutput("selectedValues")
))
server <- shinyServer(function(input, output) {
thresh <- reactive(input$thresh)
set.seed(1)
dat <- data.frame(Row = paste0("Row",sample(c(1:20),20)), A=4*rnorm(20), B=4*rnorm(20))
dat$Row <- as.character(dat$Row)
minVal = min(dat[,-1])
maxVal = max(dat[,-1])
gg <- ggplot(data = dat, aes(x=A, y=B)) + coord_cartesian(xlim = c(minVal, maxVal), ylim = c(minVal, maxVal))
ggY <- ggplotly(gg)
output$myPlot <- renderPlotly(ggY %>% onRender("
function(el, x, data) {
var Points = [];
var Traces = [];
var selRows = [];
data.dat.forEach(function(row){
if(Math.abs(row['B']) > data.thresh) selRows.push(row);});
var xArr = [];
var yArr = [];
var keepIndex = [];
for (a=0; a<selRows.length; a++){
xArr.push(selRows[a]['A'])
yArr.push(selRows[a]['B'])
keepIndex.push(selRows[a]['Row'])
}
Points.push(keepIndex);
// Add points above the threshold in black
var tracePoints = {
x: xArr,
y: yArr,
hoverinfo: 'none',
mode: 'markers',
marker: {
color: 'black',
size: 4
}
};
// Add upper horizontal line of gray box
var hiLine = {
x: [-15,15],
y: [data.thresh,data.thresh],
mode: 'lines',
line: {
color: 'gray',
width: 1
},
opacity: 0.25,
hoverinfo: 'none'
};
// Add lower horizontal line of gray box
var lowLine = {
x: [-15,15],
y: [-1*data.thresh,-1*data.thresh],
mode: 'lines',
fill: 'tonexty',
line: {
color: 'gray',
width: 1
},
opacity: 0.25,
hoverinfo: 'none'
};
Traces.push(tracePoints);
Traces.push(hiLine);
Traces.push(lowLine);
Plotly.addTraces(el.id, Traces);
var idRows = []
for (a=0; a<data.dat.length; a++){
idRows.push(data.dat[a]['Row'])
}
var nseltrace = 0;
el.on('plotly_selected', function(e) {
console.log(e.points)
numSel = e.points.length
var pointNumbers = [];
var selData = [];
for (a=0; a<numSel; a++){
if (e.points[a].curveNumber==1){ // restrict to points in the original curve
pointNumbers.push(e.points[a].pointNumber)
selData.push(data.dat[idRows.indexOf(Points[0][pointNumbers[a]])])
}
}
Shiny.onInputChange('selData', selData);
var Traces = [];
var xArr = [];
var yArr = [];
for (a=0; a<selData.length; a++){
xArr.push(selData[a]['A'])
yArr.push(selData[a]['B'])
}
// Add user-selected points in red
var traceRed = {
x: xArr,
y: yArr,
mode: 'markers',
marker: {
color: 'red',
size: 4
},
hoverinfo: 'none'
};
if (nseltrace>0){
Plotly.deleteTraces(el.id,-1)
}
Traces.push(traceRed);
nseltrace = nseltrace+1
Plotly.addTraces(el.id, Traces);
})
}", data = list(dat=dat, thresh=thresh())))
selData <- reactive({
req(input$selData)
rawc <- input$selData
df <- data.frame(t(matrix(rawc,nrow=3)))
names(df) <- names(rawc)[1:3]
df
})
output$selectedValues <- renderPrint({selData()})
})
shinyApp(ui, server)
这是一个屏幕截图：
我正在制作一个交互式图形，为 2 个定量变量（A 和 B）绘制黑点。用户可以select一个阈值。这样做之后，只会绘制高于该阈值大小的点，并且还会绘制一个表示未超过阈值的区域的灰色矩形。这一切似乎工作正常。
然而，我现在想要实现的是让用户select某些点。这样做时，selected 点应该从黑色变为红色。当用户 select 点的新子集时，先前 selected 点 return 从红色变为黑色。换句话说，图中唯一出现红色的点应该是最后 selected.
不幸的是，这部分似乎不起作用。现在的问题是：
1) selected 点永久保持红色。 2) 如果已经是红色的点被selected，有时未selected 的黑点变成红色。您可以在 post.
底部看到此错误的示例（在图片中）我相信这会发生，因为我只是绘制了一条全新的与 x 和 y 值对应的红点轨迹 selected（这在下面的代码中注释为“// 添加用户- selected 点为红色")。因此，红点成为它们自己的实体。
我的问题是：什么是解决这个问题的有效方法（以便 selected 点变成红色直到另一个子集被 selected？）我使用有效这个词，因为我我正在处理大型数据集（100-1,000 点），因此我正在寻找节省计算速度的方法。简单地将 selected 的黑色点修改为红色而不是完全重绘叠加的红色点可能更有效？但是，我不确定如何使用 Plotly 跟踪语法来实现这一点。
如有任何帮助，我们将不胜感激。
下面是我的脚本的简化版本。
library(plotly)
library(GGally)
library(htmlwidgets)
ui <- shinyUI(fluidPage(
sliderInput("thresh", "Threshold:", min = 0, max = 3, value=1, step=1),
plotlyOutput("myPlot"),
textOutput("selectedValues")
))
server <- shinyServer(function(input, output) {
thresh <- reactive(input$thresh)
set.seed(1)
dat <- data.frame(Row = paste0("Row",sample(c(1:20),20)), A=4*rnorm(20), B=4*rnorm(20))
dat$Row <- as.character(dat$Row)
minVal = min(dat[,-1])
maxVal = max(dat[,-1])
gg <- ggplot(data = dat, aes(x=A, y=B)) + coord_cartesian(xlim = c(minVal, maxVal), ylim = c(minVal, maxVal))
ggY <- ggplotly(gg)
output$myPlot <- renderPlotly(ggY %>% onRender("
function(el, x, data) {
var Points = [];
var Traces = [];
var selRows = [];
data.dat.forEach(function(row){
if(Math.abs(row['B']) > data.thresh) selRows.push(row);});
var xArr = [];
var yArr = [];
var keepIndex = [];
for (a=0; a<selRows.length; a++){
xArr.push(selRows[a]['A'])
yArr.push(selRows[a]['B'])
keepIndex.push(selRows[a]['Row'])
}
Points.push(keepIndex);
// Add points above the threshold in black
var tracePoints = {
x: xArr,
y: yArr,
hoverinfo: 'none',
mode: 'markers',
marker: {
color: 'black',
size: 4
}
};
// Add upper horizontal line of gray box
var hiLine = {
x: [-15,15],
y: [data.thresh,data.thresh],
mode: 'lines',
line: {
color: 'gray',
width: 1
},
opacity: 0.25,
hoverinfo: 'none'
};
// Add lower horizontal line of gray box
var lowLine = {
x: [-15,15],
y: [-1*data.thresh,-1*data.thresh],
mode: 'lines',
fill: 'tonexty',
line: {
color: 'gray',
width: 1
},
opacity: 0.25,
hoverinfo: 'none'
};
Traces.push(tracePoints);
Traces.push(hiLine);
Traces.push(lowLine);
Plotly.addTraces(el.id, Traces);
var idRows = []
for (a=0; a<data.dat.length; a++){
idRows.push(data.dat[a]['Row'])
}
el.on('plotly_selected', function(e) {
numSel = e.points.length
cN = e.points[0].curveNumber;
var pointNumbers = [];
var selData = [];
for (a=0; a<numSel; a++){
pointNumbers.push(e.points[a].pointNumber)
selData.push(data.dat[idRows.indexOf(Points[0][pointNumbers[a]])])
}
Shiny.onInputChange('selData', selData);
var Traces = [];
var xArr = [];
var yArr = [];
for (a=0; a<selData.length; a++){
xArr.push(selData[a]['A'])
yArr.push(selData[a]['B'])
}
// Add user-selected points in red
var traceRed = {
x: xArr,
y: yArr,
mode: 'markers',
marker: {
color: 'red',
size: 4
},
hoverinfo: 'none'
};
Traces.push(traceRed);
Plotly.addTraces(el.id, Traces);
})
}", data = list(dat=dat, thresh=thresh())))
selData <- reactive(input$selData)
output$selectedValues <- renderPrint({selData()})
})
shinyApp(ui, server)
错误示例如下：
说，我用所有默认打开应用程序，我只是 Plotly-select 右上角的四个点。结果看起来不错，因为只有这四个点是红色的，如下所示：
现在，假设我重新select 前四点。结果看起来不再好，因为即使这四个点被涂成红色，另外两个点也被错误地涂成红色：
处理这个问题的最简单方法是简单地跟踪您是否有 selected 的东西，如果有以前的 select离子。为此，进行了以下更改：
- 添加了一个计数器
nseltrace来跟踪我们select编辑东西的频率 - 添加了一个
Plotly.deleteTraces语句来删除最后一条轨迹（可以用索引 -1 指定。 - 该删除操作由
if (nseltrace>0)语句保护。 - 重新格式化您的 selection 点以将它们放入数据框中（它们作为字符向量一起出现）
- 使用
verbatumTextOutput打印出来，因为它是一种更干净的格式。
更新：
- 添加了一个守卫，只有 select 个属于
curveNumber1 的点，即原始数据，而不是后面的 selected 痕迹。这导致已经 selected 的点被输入到新的 selected 列表中两次。
至于这是否是最有效的方式，显然要视情况而定。您在以前的非 selected 表示上绘制了 selected 点，最坏的情况是两倍，但是点绘制速度非常快，并且对于一小部分点来说典型的减速甚至可能无法衡量。我不会优化它，除非后来证明它是一个问题，然后我会使用最新的 plotly，因为 plotly 代码库中目前正在进行大量优化（和错误删除）。
代码如下：
library(plotly)
library(GGally)
library(htmlwidgets)
library(shiny)
ui <- shinyUI(fluidPage(
sliderInput("thresh", "Threshold:", min = 0, max = 3, value=1, step=1),
plotlyOutput("myPlot"),
verbatimTextOutput("selectedValues")
))
server <- shinyServer(function(input, output) {
thresh <- reactive(input$thresh)
set.seed(1)
dat <- data.frame(Row = paste0("Row",sample(c(1:20),20)), A=4*rnorm(20), B=4*rnorm(20))
dat$Row <- as.character(dat$Row)
minVal = min(dat[,-1])
maxVal = max(dat[,-1])
gg <- ggplot(data = dat, aes(x=A, y=B)) + coord_cartesian(xlim = c(minVal, maxVal), ylim = c(minVal, maxVal))
ggY <- ggplotly(gg)
output$myPlot <- renderPlotly(ggY %>% onRender("
function(el, x, data) {
var Points = [];
var Traces = [];
var selRows = [];
data.dat.forEach(function(row){
if(Math.abs(row['B']) > data.thresh) selRows.push(row);});
var xArr = [];
var yArr = [];
var keepIndex = [];
for (a=0; a<selRows.length; a++){
xArr.push(selRows[a]['A'])
yArr.push(selRows[a]['B'])
keepIndex.push(selRows[a]['Row'])
}
Points.push(keepIndex);
// Add points above the threshold in black
var tracePoints = {
x: xArr,
y: yArr,
hoverinfo: 'none',
mode: 'markers',
marker: {
color: 'black',
size: 4
}
};
// Add upper horizontal line of gray box
var hiLine = {
x: [-15,15],
y: [data.thresh,data.thresh],
mode: 'lines',
line: {
color: 'gray',
width: 1
},
opacity: 0.25,
hoverinfo: 'none'
};
// Add lower horizontal line of gray box
var lowLine = {
x: [-15,15],
y: [-1*data.thresh,-1*data.thresh],
mode: 'lines',
fill: 'tonexty',
line: {
color: 'gray',
width: 1
},
opacity: 0.25,
hoverinfo: 'none'
};
Traces.push(tracePoints);
Traces.push(hiLine);
Traces.push(lowLine);
Plotly.addTraces(el.id, Traces);
var idRows = []
for (a=0; a<data.dat.length; a++){
idRows.push(data.dat[a]['Row'])
}
var nseltrace = 0;
el.on('plotly_selected', function(e) {
console.log(e.points)
numSel = e.points.length
var pointNumbers = [];
var selData = [];
for (a=0; a<numSel; a++){
if (e.points[a].curveNumber==1){ // restrict to points in the original curve
pointNumbers.push(e.points[a].pointNumber)
selData.push(data.dat[idRows.indexOf(Points[0][pointNumbers[a]])])
}
}
Shiny.onInputChange('selData', selData);
var Traces = [];
var xArr = [];
var yArr = [];
for (a=0; a<selData.length; a++){
xArr.push(selData[a]['A'])
yArr.push(selData[a]['B'])
}
// Add user-selected points in red
var traceRed = {
x: xArr,
y: yArr,
mode: 'markers',
marker: {
color: 'red',
size: 4
},
hoverinfo: 'none'
};
if (nseltrace>0){
Plotly.deleteTraces(el.id,-1)
}
Traces.push(traceRed);
nseltrace = nseltrace+1
Plotly.addTraces(el.id, Traces);
})
}", data = list(dat=dat, thresh=thresh())))
selData <- reactive({
req(input$selData)
rawc <- input$selData
df <- data.frame(t(matrix(rawc,nrow=3)))
names(df) <- names(rawc)[1:3]
df
})
output$selectedValues <- renderPrint({selData()})
})
shinyApp(ui, server)
这是一个屏幕截图：