r - 当已经有 event_data("plotly_click")
问题描述
我试图通过使用 r plotly 和 shinyevent_data()
重新创建一个示例来了解如何工作,章节Linking views with shiny:
https ://plotly-r.com/linking-views-with-shiny.html# fig:plotlyEvents所以我可以为已选择的栏着色。首先,当我运行代码时,我得到:
“警告:与“sub_category”源 ID 相关的“plotly_click”事件未注册。为了获取此事件数据,请添加到您希望从中获取事件数据event_register(p, 'plotly_click')
的绘图 ( )。警告:“plotly_click”p
事件绑定了“order_date”的源 ID。为了获取此事件数据,请添加到您希望从中获取事件数据event_register(p, 'plotly_click')
的绘图 ( )。警告:“plotly_click”事件绑定了源 ID ' p
sub_category' 未注册。为了获取此事件数据,请添加到您希望从中获取事件数据event_register(p, 'plotly_click')
的绘图 ( )。警告:绑定源 ID 为 'order_date' 的 'plotly_click' 事件未注册。在p
为了获得这个事件数据,请添加event_register(p, 'plotly_click')
到情节(p
) 您希望从中获取事件数据。"
然后我读到event_register()
我正在尝试修改代码,但除了破坏它之外,我没有取得太多成就。我也尝试highlight()
为点击的栏着色,但我想我在这个例子中没有正确使用它,因为代码再次中断。请您给我一些关于如何为选择的条和子类别着色以具有相同颜色的启发。非常感谢您的宝贵时间!
library(shiny)
library(plotly)
library(dplyr)
sales <- diamonds
sales$category = sales$cut
sales$sub_category = sales$color
sales$sales = sales$price
sales$order_date = sample(seq(as.Date('2020-01-01'), as.Date('2020-02-01'), by="day"),nrow(sales), replace = T)
ui <- fluidPage(
plotlyOutput("category", height = 200),
plotlyOutput("sub_category", height = 200),
plotlyOutput("sales", height = 300),
DT::dataTableOutput("datatable")
)
# avoid repeating this code
axis_titles <- . %>%
layout(
xaxis = list(title = ""),
yaxis = list(title = "Sales")
)
server <- function(input, output, session) {
# for maintaining the state of drill-down variables
category <- reactiveVal()
sub_category <- reactiveVal()
order_date <- reactiveVal()
# when clicking on a category,
observeEvent(event_data("plotly_click", source = "category"), {
category(event_data("plotly_click", source = "category")$x)
sub_category(NULL)
order_date(NULL)
})
observeEvent(event_data("plotly_click", source = "sub_category"), {
sub_category(
event_data("plotly_click", source = "sub_category")$x
)
order_date(NULL)
})
observeEvent(event_data("plotly_click", source = "order_date"), {
order_date(event_data("plotly_click", source = "order_date")$x)
})
output$category <- renderPlotly({
sales %>%
count(category, wt = sales) %>%
plot_ly(x = ~category, y = ~n, source = "category") %>%
axis_titles() %>%
layout(title = "Sales by category")
})
output$sub_category <- renderPlotly({
if (is.null(category())) return(NULL)
sales %>%
filter(category %in% category()) %>%
count(sub_category, wt = sales) %>%
plot_ly(x = ~sub_category, y = ~n, source = "sub_category") %>%
axis_titles() %>%
layout(title = category())
})
output$sales <- renderPlotly({
if (is.null(sub_category())) return(NULL)
sales %>%
filter(sub_category %in% sub_category()) %>%
count(order_date, wt = sales) %>%
plot_ly(x = ~order_date, y = ~n, source = "order_date") %>%
add_lines() %>%
axis_titles() %>%
layout(title = paste(sub_category(), "sales over time"))
})
output$datatable <- DT::renderDataTable({
if (is.null(order_date())) return(NULL)
sales %>%
filter(
sub_category %in% sub_category(),
as.Date(order_date) %in% as.Date(order_date())
)
})
}
shinyApp(ui, server)
解决方案
在这里,伙计,我只是根据您单击的内容添加了颜色。
线图默认是绿色的,所以我们不用担心。
对于第一个图,如果单击 category(),我将改变红色。出于某种原因,我无法直接对其进行变异,因此我在绘图之前创建了一个 plot_data 并使用 if else 语句来执行此操作(嵌套的 if_else 不起作用)
对于第二个绘图,如果单击 sub_category(),我将改变绿色。
希望这就是你要找的!
library(shiny)
library(plotly)
library(dplyr)
sales <- diamonds
sales$category = sales$cut
sales$sub_category = sales$color
sales$sales = sales$price
sales$order_date = sample(seq(as.Date('2020-01-01'), as.Date('2020-02-01'), by="day"),nrow(sales), replace = T)
ui <- fluidPage(
plotlyOutput("category", height = 200),
plotlyOutput("sub_category", height = 200),
plotlyOutput("sales", height = 300),
DT::dataTableOutput("datatable")
)
# avoid repeating this code
axis_titles <- . %>%
layout(
xaxis = list(title = ""),
yaxis = list(title = "Sales")
)
server <- function(input, output, session) {
# for maintaining the state of drill-down variables
category <- reactiveVal()
sub_category <- reactiveVal()
order_date <- reactiveVal()
# when clicking on a category,
observeEvent(event_data("plotly_click", source = "category"), {
category(event_data("plotly_click", source = "category")$x)
sub_category(NULL)
order_date(NULL)
})
observeEvent(event_data("plotly_click", source = "sub_category"), {
sub_category(
event_data("plotly_click", source = "sub_category")$x
)
order_date(NULL)
})
observeEvent(event_data("plotly_click", source = "order_date"), {
order_date(event_data("plotly_click", source = "order_date")$x)
})
output$category <- renderPlotly({
print(category())
if (is.null(category())) {
plot_data <- sales %>%
count(category, wt = sales) %>%
mutate(current_color = "blue")
} else {
plot_data <- sales %>%
count(category, wt = sales) %>%
mutate(current_color = if_else(category %in% category(), "red", "blue"))
}
plot_ly(
plot_data, x = ~category, y = ~n, source = "category", type = "bar",
marker = list(color = ~current_color)
) %>%
axis_titles() %>%
layout(title = "Sales by category")
})
output$sub_category <- renderPlotly({
if (is.null(category())) return(NULL)
sales %>%
filter(category %in% category()) %>%
count(sub_category, wt = sales) %>%
mutate(current_color = if_else(sub_category %in% sub_category(), "green", "red")) %>%
plot_ly(
x = ~sub_category, y = ~n, source = "sub_category", type = "bar",
marker = list(color = ~current_color)
) %>%
axis_titles() %>%
layout(title = category())
})
output$sales <- renderPlotly({
if (is.null(sub_category())) return(NULL)
sales %>%
filter(sub_category %in% sub_category()) %>%
count(order_date, wt = sales) %>%
plot_ly(x = ~order_date, y = ~n, source = "order_date", line = list(color = "green")) %>%
add_lines() %>%
axis_titles() %>%
layout(title = paste(sub_category(), "sales over time"))
})
output$datatable <- DT::renderDataTable({
if (is.null(order_date())) return(NULL)
sales %>%
filter(
sub_category %in% sub_category(),
as.Date(order_date) %in% as.Date(order_date())
)
})
}
shinyApp(ui, server)
推荐阅读
- gwt - 如何在 GWT 中获取图标的 Html 代码
- python - 如何测试进程是否在 AWS 上“在云中”
- excel - RemoveDuplicates 检索错误 5:在“列”参数上使用变量时,过程调用或参数无效
- flutter - 如何转换,替换飞镖中的字符串
- qt - 如何在 QML、Qt 中捕获没有鼠标区域的鼠标滚轮移动?
- c# - WPF ComboBox 忽略绑定
- mule - 如何在 dataweave 中使用 Excel 作为查找
- laravel - 我如何才能像 Laravel 中的 dd() 函数一样将变量数据作为字符串获取?
- authentication - Keycloak 是否支持某种形式的中间人身份验证?
- java - CloudSDK 能否帮助使用仅在运行时才知道的 OData 实体类型?