R plotly：如何通过多个图的图例点击来观察痕迹是隐藏还是显示
R plotly: how to observe whether a trace is hidden or shown through legend clicks with multiple plots
我试图通过在 plotly 的交互式图例中取消选择来找出用户从散点图中隐藏了哪些轨迹。
我已阅读此 post，以及类似的问题 link 在下面的评论中提出，这使我更接近解决方案
当前的解决方案只是部分满足了我的需要。我正在寻找改进它的两件事是：
- 如何查看点击了哪个情节的图例（查看来源 'id'？）
- 我现在可以看到点击了图例条目，但我需要能够看到它是否被点击 'ON'（显示跟踪）或 'OFF'
我正在寻找的输出看起来像这样：
input$trace_plot1 ：然后是所有关闭和打开的跟踪的列表，或者每次单击时的单个跟踪 nr，但它告诉该特定跟踪现在是 "ON" 还是 "OFF"
我的目标是 link 视觉隐藏和显示数据中我的所有组的概览，用户现在可以给他们新的名称、颜色并选择使用后面有 T/F 状态开关的按钮保留或删除组。我想 link 按钮的 T/F 状态到 'show'/'hidden' 来自特定情节的痕迹（因为我的应用程序中有这些情节的 5 个副本显示分析过程不同阶段的数据。
这是我的尝试，它不会以某种方式对图例做出反应，只会对 zooom 做出反应：
library(plotly)
library(shiny)
library(htmlwidgets)
js <- c(
"function(el, x){",
" el.on('plotly_legendclick', function(evtData) {",
" Shiny.setInputValue('trace', evtData.data[evtData.curveNumber].name);",
" });",
"}")
iris$group <- c(rep(1,50), rep(2, 50), rep(3,50))
ui <- fluidPage(
plotlyOutput("plot1"),
plotlyOutput("plot2"),
verbatimTextOutput("legendItem")
)
server <- function(input, output){
output$plot1 <- renderPlotly({
p <- plot_ly(source = 'plotly1', data = iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~as.factor(group), type = 'scatter', mode = 'markers') %>%
layout(showlegend = TRUE)
p %>% onRender(js)
})
output$plot2 <- renderPlotly({
p <- plot_ly(source = 'plotly2', data = iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~as.factor(group), type = 'scatter', mode = 'markers') %>%
layout(showlegend = TRUE)
p %>% onRender(js)
})
output$legendItem <- renderPrint({
d <- input$trace
if (is.null(d)) "Clicked item appear here" else d
})
}
shinyApp(ui = ui, server = server)
编辑：工作解决方案感谢 S.L.
的广泛回答
library(plotly)
library(shiny)
library(htmlwidgets)
js <- c(
"function(el, x, inputName){",
" var id = el.getAttribute('id');",
" var d3 = Plotly.d3;",
" el.on('plotly_restyle', function(evtData) {",
" var out = {};",
" d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){",
" var trace = d3.select(this)[0][0].__data__[0].trace;",
" out[trace.name] = trace.visible;",
" });",
" Shiny.setInputValue(inputName, out);",
" });",
"}")
ui <- fluidPage(
plotlyOutput("plot1"),
plotlyOutput("plot2"),
verbatimTextOutput("tracesPlot1"),
verbatimTextOutput("tracesPlot2")
)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
p1 <- plot_ly()
p1 <- add_trace(p1, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl))
p1 %>% onRender(js, data = "tracesPlot1")
})
output$plot2 <- renderPlotly({
p2 <- plot_ly()
p2 <- add_trace(p2, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl))
p2 %>% onRender(js, data = "tracesPlot2") })
output$tracesPlot1 <- renderPrint({ unlist(input$tracesPlot1) })
output$tracesPlot2 <- renderPrint({unlist(input$tracesPlot2)
})
}
shinyApp(ui, server)
有帮助吗？
library(plotly)
library(shiny)
library(htmlwidgets)
js <- c(
"function(el, x){",
" el.on('plotly_legendclick', function(evtData) {",
" Shiny.setInputValue('trace', evtData.data[evtData.curveNumber].name);",
" });",
" el.on('plotly_restyle', function(evtData) {",
" Shiny.setInputValue('visibility', evtData[0].visible);",
" });",
"}")
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("legendItem")
)
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- plot_ly()
for(name in c("drat", "wt", "qsec"))
{
p = add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
}
p %>% onRender(js)
})
output$legendItem <- renderPrint({
trace <- input$trace
ifelse(is.null(trace),
"Clicked item will appear here",
paste0("Clicked: ", trace,
" --- Visibility: ", input$visibility)
)
})
}
shinyApp(ui, server)
编辑
双击图例项时，先前的解决方案存在问题。这是一个更好的解决方案：
library(plotly)
library(shiny)
library(htmlwidgets)
js <- c(
"function(el, x){",
" var d3 = Plotly.d3;",
" el.on('plotly_restyle', function(evtData) {",
" var out = {};",
" d3.select('g.legend').selectAll('.traces').each(function(){",
" var trace = d3.select(this)[0][0].__data__[0].trace;",
" out[trace.name] = trace.visible;",
" });",
" Shiny.setInputValue('traces', out);",
" });",
"}")
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("legendItem")
)
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- plot_ly()
for(name in c("drat", "wt", "qsec"))
{
p = add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
}
p %>% onRender(js)
})
output$legendItem <- renderPrint({
input$traces
})
}
shinyApp(ui, server)
如果您有多个绘图，请在图例选择器中添加绘图 ID，并使用函数生成 JavaScript 代码：
js <- function(i) {
c(
"function(el, x){",
" var id = el.getAttribute('id');",
" var d3 = Plotly.d3;",
" el.on('plotly_restyle', function(evtData) {",
" var out = {};",
" d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){",
" var trace = d3.select(this)[0][0].__data__[0].trace;",
" out[trace.name] = trace.visible;",
" });",
sprintf(" Shiny.setInputValue('traces%d', out);", i),
" });",
"}")
}
然后执行 p1 %>% onRender(js(1))、p2 %>% onRender(js(2))、...，您将在 input$traces1、input$traces2、...中获得有关跟踪可见性的信息。 =22=]
另一种方法是在 JavaScript 函数的第三个参数中传递所需的名称，借助 onRender 的 data 参数：
js <- c(
"function(el, x, inputName){",
" var id = el.getAttribute('id');",
" var d3 = Plotly.d3;",
" el.on('plotly_restyle', function(evtData) {",
" var out = {};",
" d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){",
" var trace = d3.select(this)[0][0].__data__[0].trace;",
" out[trace.name] = trace.visible;",
" });",
" Shiny.setInputValue(inputName, out);",
" });",
"}")
p1 %>% onRender(js, data = "tracesPlot1")
p2 %>% onRender(js, data = "tracesPlot2")
我试图通过在 plotly 的交互式图例中取消选择来找出用户从散点图中隐藏了哪些轨迹。
我已阅读此
当前的解决方案只是部分满足了我的需要。我正在寻找改进它的两件事是： - 如何查看点击了哪个情节的图例（查看来源 'id'？） - 我现在可以看到点击了图例条目，但我需要能够看到它是否被点击 'ON'（显示跟踪）或 'OFF'
我正在寻找的输出看起来像这样：
input$trace_plot1 ：然后是所有关闭和打开的跟踪的列表，或者每次单击时的单个跟踪 nr，但它告诉该特定跟踪现在是 "ON" 还是 "OFF"
我的目标是 link 视觉隐藏和显示数据中我的所有组的概览，用户现在可以给他们新的名称、颜色并选择使用后面有 T/F 状态开关的按钮保留或删除组。我想 link 按钮的 T/F 状态到 'show'/'hidden' 来自特定情节的痕迹（因为我的应用程序中有这些情节的 5 个副本显示分析过程不同阶段的数据。
这是我的尝试，它不会以某种方式对图例做出反应，只会对 zooom 做出反应：
library(plotly)
library(shiny)
library(htmlwidgets)
js <- c(
"function(el, x){",
" el.on('plotly_legendclick', function(evtData) {",
" Shiny.setInputValue('trace', evtData.data[evtData.curveNumber].name);",
" });",
"}")
iris$group <- c(rep(1,50), rep(2, 50), rep(3,50))
ui <- fluidPage(
plotlyOutput("plot1"),
plotlyOutput("plot2"),
verbatimTextOutput("legendItem")
)
server <- function(input, output){
output$plot1 <- renderPlotly({
p <- plot_ly(source = 'plotly1', data = iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~as.factor(group), type = 'scatter', mode = 'markers') %>%
layout(showlegend = TRUE)
p %>% onRender(js)
})
output$plot2 <- renderPlotly({
p <- plot_ly(source = 'plotly2', data = iris, x = ~Sepal.Length, y = ~Petal.Length, color = ~as.factor(group), type = 'scatter', mode = 'markers') %>%
layout(showlegend = TRUE)
p %>% onRender(js)
})
output$legendItem <- renderPrint({
d <- input$trace
if (is.null(d)) "Clicked item appear here" else d
})
}
shinyApp(ui = ui, server = server)
编辑：工作解决方案感谢 S.L.
的广泛回答library(plotly)
library(shiny)
library(htmlwidgets)
js <- c(
"function(el, x, inputName){",
" var id = el.getAttribute('id');",
" var d3 = Plotly.d3;",
" el.on('plotly_restyle', function(evtData) {",
" var out = {};",
" d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){",
" var trace = d3.select(this)[0][0].__data__[0].trace;",
" out[trace.name] = trace.visible;",
" });",
" Shiny.setInputValue(inputName, out);",
" });",
"}")
ui <- fluidPage(
plotlyOutput("plot1"),
plotlyOutput("plot2"),
verbatimTextOutput("tracesPlot1"),
verbatimTextOutput("tracesPlot2")
)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
p1 <- plot_ly()
p1 <- add_trace(p1, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl))
p1 %>% onRender(js, data = "tracesPlot1")
})
output$plot2 <- renderPlotly({
p2 <- plot_ly()
p2 <- add_trace(p2, data = mtcars, x = ~disp, y = ~mpg, type = 'scatter', mode = 'markers', color = ~as.factor(cyl))
p2 %>% onRender(js, data = "tracesPlot2") })
output$tracesPlot1 <- renderPrint({ unlist(input$tracesPlot1) })
output$tracesPlot2 <- renderPrint({unlist(input$tracesPlot2)
})
}
shinyApp(ui, server)
有帮助吗？
library(plotly)
library(shiny)
library(htmlwidgets)
js <- c(
"function(el, x){",
" el.on('plotly_legendclick', function(evtData) {",
" Shiny.setInputValue('trace', evtData.data[evtData.curveNumber].name);",
" });",
" el.on('plotly_restyle', function(evtData) {",
" Shiny.setInputValue('visibility', evtData[0].visible);",
" });",
"}")
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("legendItem")
)
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- plot_ly()
for(name in c("drat", "wt", "qsec"))
{
p = add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
}
p %>% onRender(js)
})
output$legendItem <- renderPrint({
trace <- input$trace
ifelse(is.null(trace),
"Clicked item will appear here",
paste0("Clicked: ", trace,
" --- Visibility: ", input$visibility)
)
})
}
shinyApp(ui, server)
编辑
双击图例项时，先前的解决方案存在问题。这是一个更好的解决方案：
library(plotly)
library(shiny)
library(htmlwidgets)
js <- c(
"function(el, x){",
" var d3 = Plotly.d3;",
" el.on('plotly_restyle', function(evtData) {",
" var out = {};",
" d3.select('g.legend').selectAll('.traces').each(function(){",
" var trace = d3.select(this)[0][0].__data__[0].trace;",
" out[trace.name] = trace.visible;",
" });",
" Shiny.setInputValue('traces', out);",
" });",
"}")
ui <- fluidPage(
plotlyOutput("plot"),
verbatimTextOutput("legendItem")
)
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- plot_ly()
for(name in c("drat", "wt", "qsec"))
{
p = add_markers(p, x = as.numeric(mtcars$cyl), y = as.numeric(mtcars[[name]]), name = name)
}
p %>% onRender(js)
})
output$legendItem <- renderPrint({
input$traces
})
}
shinyApp(ui, server)
如果您有多个绘图，请在图例选择器中添加绘图 ID，并使用函数生成 JavaScript 代码：
js <- function(i) {
c(
"function(el, x){",
" var id = el.getAttribute('id');",
" var d3 = Plotly.d3;",
" el.on('plotly_restyle', function(evtData) {",
" var out = {};",
" d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){",
" var trace = d3.select(this)[0][0].__data__[0].trace;",
" out[trace.name] = trace.visible;",
" });",
sprintf(" Shiny.setInputValue('traces%d', out);", i),
" });",
"}")
}
然后执行 p1 %>% onRender(js(1))、p2 %>% onRender(js(2))、...，您将在 input$traces1、input$traces2、...中获得有关跟踪可见性的信息。 =22=]
另一种方法是在 JavaScript 函数的第三个参数中传递所需的名称，借助 onRender 的 data 参数：
js <- c(
"function(el, x, inputName){",
" var id = el.getAttribute('id');",
" var d3 = Plotly.d3;",
" el.on('plotly_restyle', function(evtData) {",
" var out = {};",
" d3.select('#' + id + ' g.legend').selectAll('.traces').each(function(){",
" var trace = d3.select(this)[0][0].__data__[0].trace;",
" out[trace.name] = trace.visible;",
" });",
" Shiny.setInputValue(inputName, out);",
" });",
"}")
p1 %>% onRender(js, data = "tracesPlot1")
p2 %>% onRender(js, data = "tracesPlot2")