您可以使用 R/Shiny + d3.js 做到这一点：可以在下面找到预览、可重现的示例、代码和演练。
编辑：12/2018 - 查看 MrGrumble 的评论：
“使用 d3 v5，我必须将事件从 dragstart 和 dragend 重命名为 start 和 end，并将行 var drag = d3.behavior.drag() 更改为 var drag d3.drag()。”
可重现的例子：
最简单的方法是克隆此存储库 (https://github.com/Timag/DraggableRegressionPoints)。
预览：
对于糟糕的 gif 质量表示抱歉：
说明：
代码基于d3.js+shiny+R。它包括一个自定义闪亮功能，我将其命名为renderDragableChart()。您可以设置圆圈的颜色和半径。
实现可以在DragableFunctions.R找到。
R->d3.js->R的交互：
数据点的位置最初是在 R 中设置的。参见 server.R：
df <- data.frame(x = seq(20,150, length.out = 10) + rnorm(10)*8,
y = seq(20,150, length.out = 10) + rnorm(10)*8)
df$y[1] = df$y[1] + 80
图形通过 d3.js 渲染。必须在此处添加诸如线条等添加。
主要噱头应该是点是可拖动的，并且应该将更改发送到 R。
第一个用.on('dragstart', function(d, i) {}和.on('dragend', function(d, i) {}实现，后者用Shiny.onInputChange("JsData", coord);实现。
代码：
ui.R
包括在DragableFunctions.R 中定义的自定义闪亮函数DragableChartOutput()。
library(shiny)
shinyUI( bootstrapPage(
fluidRow(
column(width = 3,
DragableChartOutput("mychart")
),
column(width = 9,
verbatimTextOutput("regression")
)
)
))
server.R
除了自定义函数renderDragableChart()之外，也是基本的闪亮。
library(shiny)
options(digits=2)
df <- data.frame(x = seq(20,150, length.out = 10) + rnorm(10)*8,
y = seq(20,150, length.out = 10) + rnorm(10)*8)
df$y[1] = df$y[1] + 80
#plot(df)
shinyServer( function(input, output, session) {
output$mychart <- renderDragableChart({
df
}, r = 3, color = "purple")
output$regression <- renderPrint({
if(!is.null(input$JsData)){
mat <- matrix(as.integer(input$JsData), ncol = 2, byrow = TRUE)
summary(lm(mat[, 2] ~ mat[, 1]))
}else{
summary(lm(df$y ~ df$x))
}
})
})
函数在DragableFunctions.R中定义。注意，它也可以用library(htmlwidgets) 来实现。我决定长期实现它，因为它并不难，而且你对界面有更多的了解。
library(shiny)
dataSelect <- reactiveValues(type = "all")
# To be called from ui.R
DragableChartOutput <- function(inputId, width="500px", height="500px") {
style <- sprintf("width: %s; height: %s;",
validateCssUnit(width), validateCssUnit(height))
tagList(
tags$script(src = "d3.v3.min.js"),
includeScript("ChartRendering.js"),
div(id=inputId, class="Dragable", style = style,
tag("svg", list())
)
)
}
# To be called from server.R
renderDragableChart <- function(expr, env = parent.frame(), quoted = FALSE, color = "orange", r = 10) {
installExprFunction(expr, "data", env, quoted)
function(){
data <- lapply(1:dim(data())[1], function(idx) list(x = data()$x[idx], y = data()$y[idx], r = r))
list(data = data, col = color)
}
}
现在我们只剩下生成 d3.js 代码了。这是在 ChartRendering.js 中完成的。基本上必须创建圆圈并添加“可拖动功能”。拖动完成后，我们希望将更新的数据发送到 R。这在 .on('dragend',.) 和 Shiny.onInputChange("JsData", coord);}); 中实现。可以通过server.R 和input$JsData 访问此数据。
var col = "orange";
var coord = [];
var binding = new Shiny.OutputBinding();
binding.find = function(scope) {
return $(scope).find(".Dragable");
};
binding.renderValue = function(el, data) {
var $el = $(el);
var boxWidth = 600;
var boxHeight = 400;
dataArray = data.data
col = data.col
var box = d3.select(el)
.append('svg')
.attr('class', 'box')
.attr('width', boxWidth)
.attr('height', boxHeight);
var drag = d3.behavior.drag()
.on('dragstart', function(d, i) {
box.select("circle:nth-child(" + (i + 1) + ")")
.style('fill', 'red');
})
.on('drag', function(d, i) {
box.select("circle:nth-child(" + (i + 1) + ")")
.attr('cx', d3.event.x)
.attr('cy', d3.event.y);
})
.on('dragend', function(d, i) {
circle.style('fill', col);
coord = []
d3.range(1, (dataArray.length + 1)).forEach(function(entry) {
sel = box.select("circle:nth-child(" + (entry) + ")")
coord = d3.merge([coord, [sel.attr("cx"), sel.attr("cy")]])
})
console.log(coord)
Shiny.onInputChange("JsData", coord);
});
var circle = box.selectAll('.draggableCircle')
.data(dataArray)
.enter()
.append('svg:circle')
.attr('class', 'draggableCircle')
.attr('cx', function(d) { return d.x; })
.attr('cy', function(d) { return d.y; })
.attr('r', function(d) { return d.r; })
.call(drag)
.style('fill', col);
};
// Regsiter new Shiny binding
Shiny.outputBindings.register(binding, "shiny.Dragable");