这是上一篇文章(Add shaded rectangle with select Box corners in Plotly R)的延续。
我正在创建一个应用程序,如果用户在Plotly中使用Box Select工具,那么填充的矩形将出现在Box Select旁边。目前正在运作,如下面的MWE所示:
library(ggplot2)
library(shiny)
library(plotly)
library(htmlwidgets)
ui <- basicPage(
plotlyOutput("plot1")
)
server <- function(input, output) {
p <- ggplot(mtcars, aes(x = wt, y = mpg)) + geom_point(alpha=0) + xlim(0,5) +ylim(-3,3)
gp <- ggplotly(p)
set.seed(3)
myDF <- data.frame(X1=rnorm(10,-1), X2=rnorm(10,-1), X3=rnorm(10,-1), X4=rnorm(10,1), X5=rnorm(10,1), X6=rnorm(10,1))
colNms <- colnames(myDF)
nVar <- length(colNms)
output$plot1 <- renderPlotly({
gp %>% layout(dragmode="select") %>%
onRender("
function(el, x, data) {
var myDF = data.myDF
var Traces = [];
var dLength = myDF.length
var vLength = data.nVar
var cNames = data.colNms
for (a=0; a<dLength; a++){
xArr = [];
yArr = [];
for (b=0; b<vLength; b++){
xArr.push(b)
yArr.push(myDF[a][cNames[b]]);
}
var pcpLine = {
x: xArr,
y: yArr,
mode: 'lines',
line: {
color: 'orange',
width: 1
},
opacity: 0.9,
}
Traces.push(pcpLine);
}
Plotly.addTraces(el.id, Traces);
el.on('plotly_selected', function(e) {
var dLength = myDF.length
var selectedPCP = []
var xMin = e.range.x[0]
var xMax = e.range.x[1]
var yMin = e.range.y[0]
var yMax = e.range.y[1]
console.log([xMin, xMax, yMin, yMax])
var Traces = []
var drawRect = {
type: 'rect',
x0: xMin,
y0: yMin,
x1: xMax,
y1: yMax,
line: {
color: 'green',
width: 1
},
fillcolor: 'green'
}
var update = {
shapes:[drawRect]
}
Plotly.relayout(el.id, update)
})
}", data = list(myDF = myDF, nVar = nVar, colNms = colNms))})
}
shinyApp(ui, server)
目前,一旦用户创建了一个新的填充矩形,则前一个矩形会自动删除。我想要完成的是允许填充的矩形保持和累积。
任何有关如何实现这一目标的建议都将不胜感激!
答案 0 :(得分:0)
这就是你想要的,我做了以下补充:
rects
)中onInputChange
事件处理程序使它们可用于闪亮的程序。以下是代码:
library(ggplot2)
library(shiny)
library(plotly)
library(htmlwidgets)
ui <- basicPage(
plotlyOutput("plot1"),
verbatimTextOutput("rectdf")
)
server <- function(input, output) {
p <- ggplot(mtcars, aes(x = wt, y = mpg)) + geom_point(alpha=0) + xlim(0,5) +ylim(-3,3)
gp <- ggplotly(p)
set.seed(3)
myDF <- data.frame(X1=rnorm(10,-1), X2=rnorm(10,-1), X3=rnorm(10,-1), X4=rnorm(10,1), X5=rnorm(10,1), X6=rnorm(10,1))
colNms <- colnames(myDF)
nVar <- length(colNms)
inputRectDf <- reactive({
req(input$rects)
# data comes back as a big character vector
# so we reformat it as a dataframe here
df <- data.frame(t(matrix(input$rects,nrow=8)))
names(df) <- names(input$rects)[1:8]
return(df)
})
output$rectdf <- renderPrint({print(inputRectDf())})
output$plot1 <- renderPlotly({
gp %>% layout(dragmode="select") %>%
onRender("
function(el, x, data) {
var rects = [];
var myDF = data.myDF
var Traces = [];
var dLength = myDF.length
var vLength = data.nVar
var cNames = data.colNms
for (a=0; a<dLength; a++){
xArr = [];
yArr = [];
for (b=0; b<vLength; b++){
xArr.push(b)
yArr.push(myDF[a][cNames[b]]);
}
var pcpLine = {
x: xArr,
y: yArr,
mode: 'lines',
line: {
color: 'orange',
width: 1
},
opacity: 0.9,
}
Traces.push(pcpLine);
}
Plotly.addTraces(el.id, Traces);
el.on('plotly_selected', function(e) {
var dLength = myDF.length
var selectedPCP = []
var xMin = e.range.x[0]
var xMax = e.range.x[1]
var yMin = e.range.y[0]
var yMax = e.range.y[1]
console.log([xMin, xMax, yMin, yMax])
var Traces = []
var drawRect = {
type: 'rect',
x0: xMin,
y0: yMin,
x1: xMax,
y1: yMax,
line: {
color: 'green',
width: 1
},
fillcolor: 'green'
}
rects.push(drawRect);
var update = {
shapes:rects
}
Plotly.relayout(el.id, update)
Shiny.onInputChange('rects', rects); // make the rects available to shiny
})
}", data = list(myDF = myDF, nVar = nVar, colNms = colNms))})
}
shinyApp(ui, server)
这是输出,显示选择和输出的几个矩形: