adding/removing 跟踪每个 onclick 事件
adding/removing traces in plotly per onclick event
我正在尝试打印交互式饼图。单击绘图时,应添加另一条轨迹。我为此使用 event_data。添加跟踪后,下次单击页面上的任意位置时,跟踪将被删除。我没有找到解决方案。我不知道如何在再次点击后覆盖 onclick-event。
下一个问题是删除之前添加的跟踪。我想我可以像
那样使用 plotlyProxy
之后你可以看到我的代码
library(shiny)
library(data.table)
library(plotly)
ui <- basicPage(
mainPanel(
fluidRow(column(8, plotly::plotlyOutput("myplot", height = "800px")))
)
)
server <- function(input, output, session) {
testdata = data.frame("Orga" = c("Li", "La", "Le", "Lu", "De", "Va", "Xul", "Jin"),
"Dachorga" = c("Bla", "Bla", "Blu", "Blu", "Blub", "Blub", "Lol", "Lol"),
"Umsatz.Orga" = c(20000, 10000, 12000, 3000, 100, 2400, 205000, 95000))
testdata = data.table(testdata)
testdata_agg = testdata[, sum(Umsatz.Orga), by=Dachorga]
output$myplot <- renderPlotly({
p <- testdata_agg %>%
group_by(Dachorga) %>%
plot_ly(labels = ~Dachorga, values = ~V1, hoverinfo = 'label+percent+value') %>%
add_pie(hole = 0.6) %>%
layout(title = "Donut charts using Plotly", showlegend = F,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
d <- event_data("plotly_click")
if (!is.null(d)) {
p = add_pie(p, data = testdata[Dachorga == "Bla"], labels = ~Orga, values = ~Umsatz.Orga, hole = 0.5,
hoverinfo = 'label+percent+value', domain = list(
x = c(0.1, 0.9),
y = c(0.1, 0.9)),
marker = list(hover = list(color = "white")))
}
p
})
}
shinyApp(ui = ui, server = server)
抱歉我的英语不好,在此先感谢
可以使用一个小 javascript 代码来检测对文档的一次点击,并使用 Shiny.setInputValue
将结果发送到闪亮的服务器。然后可以借助一个反应值来控制剧情。
library(shiny)
library(data.table)
library(plotly)
js <- "
$(document).ready(function(){
$(document).on('click', function(){
Shiny.setInputValue('click_on_doc', true, {priority: 'event'});
})
})"
ui <- basicPage(
tags$head(tags$script(HTML(js))),
mainPanel(
fluidRow(column(8, plotly::plotlyOutput("myplot", height = "800px")))
)
)
server <- function(input, output, session) {
testdata <- data.frame("Orga" = c("Li", "La", "Le", "Lu", "De", "Va", "Xul", "Jin"),
"Dachorga" = c("Bla", "Bla", "Blu", "Blu", "Blub", "Blub", "Lol", "Lol"),
"Umsatz.Orga" = c(20000, 10000, 12000, 3000, 100, 2400, 205000, 95000))
testdata <- data.table(testdata)
testdata_agg <- testdata[, sum(Umsatz.Orga), by=Dachorga]
plot <- testdata_agg %>%
group_by(Dachorga) %>%
plot_ly(labels = ~Dachorga, values = ~V1, hoverinfo = 'label+percent+value') %>%
add_pie(hole = 0.6) %>%
layout(title = "Donut charts using Plotly", showlegend = F,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
click <- reactiveVal(FALSE)
observe({
event <- !is.null(event_data("plotly_click"))
click(event)
})
observeEvent(input$click_on_doc, {
click(FALSE)
})
output$myplot <- renderPlotly({
if (click()) {
p <- add_pie(plot, data = testdata[Dachorga == "Bla"], labels = ~Orga,
values = ~Umsatz.Orga, hole = 0.5,
hoverinfo = 'label+percent+value', domain = list(
x = c(0.1, 0.9),
y = c(0.1, 0.9)),
marker = list(hover = list(color = "white")))
}else{
p <- plot
}
p
})
}
shinyApp(ui = ui, server = server)
我没听懂你的"next problem"。也许打开一个新问题并尝试澄清。
我正在尝试打印交互式饼图。单击绘图时,应添加另一条轨迹。我为此使用 event_data。添加跟踪后,下次单击页面上的任意位置时,跟踪将被删除。我没有找到解决方案。我不知道如何在再次点击后覆盖 onclick-event。
下一个问题是删除之前添加的跟踪。我想我可以像
之后你可以看到我的代码
library(shiny)
library(data.table)
library(plotly)
ui <- basicPage(
mainPanel(
fluidRow(column(8, plotly::plotlyOutput("myplot", height = "800px")))
)
)
server <- function(input, output, session) {
testdata = data.frame("Orga" = c("Li", "La", "Le", "Lu", "De", "Va", "Xul", "Jin"),
"Dachorga" = c("Bla", "Bla", "Blu", "Blu", "Blub", "Blub", "Lol", "Lol"),
"Umsatz.Orga" = c(20000, 10000, 12000, 3000, 100, 2400, 205000, 95000))
testdata = data.table(testdata)
testdata_agg = testdata[, sum(Umsatz.Orga), by=Dachorga]
output$myplot <- renderPlotly({
p <- testdata_agg %>%
group_by(Dachorga) %>%
plot_ly(labels = ~Dachorga, values = ~V1, hoverinfo = 'label+percent+value') %>%
add_pie(hole = 0.6) %>%
layout(title = "Donut charts using Plotly", showlegend = F,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
d <- event_data("plotly_click")
if (!is.null(d)) {
p = add_pie(p, data = testdata[Dachorga == "Bla"], labels = ~Orga, values = ~Umsatz.Orga, hole = 0.5,
hoverinfo = 'label+percent+value', domain = list(
x = c(0.1, 0.9),
y = c(0.1, 0.9)),
marker = list(hover = list(color = "white")))
}
p
})
}
shinyApp(ui = ui, server = server)
抱歉我的英语不好,在此先感谢
可以使用一个小 javascript 代码来检测对文档的一次点击,并使用 Shiny.setInputValue
将结果发送到闪亮的服务器。然后可以借助一个反应值来控制剧情。
library(shiny)
library(data.table)
library(plotly)
js <- "
$(document).ready(function(){
$(document).on('click', function(){
Shiny.setInputValue('click_on_doc', true, {priority: 'event'});
})
})"
ui <- basicPage(
tags$head(tags$script(HTML(js))),
mainPanel(
fluidRow(column(8, plotly::plotlyOutput("myplot", height = "800px")))
)
)
server <- function(input, output, session) {
testdata <- data.frame("Orga" = c("Li", "La", "Le", "Lu", "De", "Va", "Xul", "Jin"),
"Dachorga" = c("Bla", "Bla", "Blu", "Blu", "Blub", "Blub", "Lol", "Lol"),
"Umsatz.Orga" = c(20000, 10000, 12000, 3000, 100, 2400, 205000, 95000))
testdata <- data.table(testdata)
testdata_agg <- testdata[, sum(Umsatz.Orga), by=Dachorga]
plot <- testdata_agg %>%
group_by(Dachorga) %>%
plot_ly(labels = ~Dachorga, values = ~V1, hoverinfo = 'label+percent+value') %>%
add_pie(hole = 0.6) %>%
layout(title = "Donut charts using Plotly", showlegend = F,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
click <- reactiveVal(FALSE)
observe({
event <- !is.null(event_data("plotly_click"))
click(event)
})
observeEvent(input$click_on_doc, {
click(FALSE)
})
output$myplot <- renderPlotly({
if (click()) {
p <- add_pie(plot, data = testdata[Dachorga == "Bla"], labels = ~Orga,
values = ~Umsatz.Orga, hole = 0.5,
hoverinfo = 'label+percent+value', domain = list(
x = c(0.1, 0.9),
y = c(0.1, 0.9)),
marker = list(hover = list(color = "white")))
}else{
p <- plot
}
p
})
}
shinyApp(ui = ui, server = server)
我没听懂你的"next problem"。也许打开一个新问题并尝试澄清。