在下面闪亮的应用程序中，我使用plotly_click_event在我选择的绘图上对我的绘图进行子集设置。由于某种原因，当我点击一个点并得到Error in order: argument 1 is not a vector时，日期列似乎会给我带来问题。
library(shiny)
library(shinydashboard)
library(plotly)
library(dplyr)
library(ggplot2)
library(bupaR)
pr59<-structure(list(case_id = c("WC4120721", "WC4120667", "WC4120689",
"WC4121068", "WC4120667", "WC4120666", "WC4120667", "WC4121068",
"WC4120667", "WC4121068"), lifecycle = c(110, 110, 110, 110,
120, 110, 130, 120, 10, 130), action = c("WC4120721-CN354877",
"WC4120667-CN354878", "WC4120689-CN356752", "WC4121068-CN301950",
"WC4120667-CSW310", "WC4120666-CN354878", "WC4120667-CSW308",
"WC4121068-CSW303", "WC4120667-CSW309", "WC4121068-CSW308"),
activity = c("Forged Wire, Medium (Sport)", "Forged Wire, Medium (Sport)",
"Forged Wire, Medium (Sport)", "Forged Wire, Medium (Sport)",
"BBH-1&2", "Forged Wire, Medium (Sport)", "TCE Cleaning",
"SOLO Oil", "Tempering", "TCE Cleaning"), resource = c("3419",
"3216", "3409", "3201", "C3-100", "3216", "C3-080", "C3-030",
"C3-090", "C3-080"), timestamp = structure(c(1606964400,
1607115480, 1607435760, 1607568120, 1607630220, 1607670780,
1607685420, 1607710800, 1607729520, 1607744100), tzone = "", class = c("POSIXct",
"POSIXt")), .order = 1:10), row.names = c(NA, -10L), class = c("eventlog",
"log", "tbl_df", "tbl", "data.frame"), spec = structure(list(
cols = list(case_id = structure(list(), class = c("collector_character",
"collector")), lifecycle = structure(list(), class = c("collector_double",
"collector")), action = structure(list(), class = c("collector_character",
"collector")), activity = structure(list(), class = c("collector_character",
"collector")), resource = structure(list(), class = c("collector_character",
"collector")), timestamp = structure(list(), class = c("collector_character",
"collector"))), default = structure(list(), class = c("collector_guess",
"collector")), delim = ";"), class = "col_spec"), case_id = "case_id", activity_id = "activity", activity_instance_id = "action", lifecycle_id = "lifecycle", resource_id = "resource", timestamp = "timestamp")
ui <- tags$body(
dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
plotlyOutput("plot1"),
plotlyOutput("plot2"),
plotlyOutput("plot3")
)
)
)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
if (!is.null(myPlotEventData2())) {
displaydat1 <- subset(pr59, timestamp %in% myPlotEventData2()[1, 3])
} else if (!is.null(myPlotEventData3())){
displaydat1 <- subset(pr59, timestamp %in% myPlotEventData3()[1, 3])
} else {
displaydat1 <- pr59
}
dat <- displaydat1|> group_by(date = as.Date(timestamp)) |> bupaR::n_cases()
p <- ggplot(data = dat, aes(x = date, y = n_cases)) +
geom_area(fill = "#69b3a2", alpha = 0.4) +
geom_line(color = "#69b3a2", size = 0.5) +
geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
labs(title = "Cases per month", x = "timestamp", y = "Cases")
ggplotly(p, source = "myPlotSource1", customdata = ~ date)
})
output$plot2 <- renderPlotly({
if (!is.null(myPlotEventData1())) {
displaydat1 <- subset(pr59, timestamp %in% myPlotEventData1()[1, 3])
} else if (!is.null(myPlotEventData3())){
displaydat1 <- subset(pr59, timestamp %in% myPlotEventData3()[1, 3])
} else {
displaydat1 <- pr59
}
dat <- displaydat1|> group_by(date = as.Date(timestamp)) |> bupaR::n_cases()
p <- ggplot(data = dat, aes(x = date, y = n_cases)) +
geom_area(fill = "#69b3a2", alpha = 0.4) +
geom_line(color = "#69b3a2", size = 0.5) +
geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
labs(title = "Cases per month", x = "timestamp", y = "events")
ggplotly(p, source = "myPlotSource2", customdata = ~ date)
})
output$plot3 <- renderPlotly({
if (!is.null(myPlotEventData1())) {
displaydat1 <- subset(pr59, timestamp %in% myPlotEventData1()[1, 3])
} else if (!is.null(myPlotEventData2())){
displaydat1 <- subset(pr59, timestamp %in% myPlotEventData2()[1, 3])
} else {
displaydat1 <- pr59
}
dat <- displaydat1|> group_by(date = as.Date(timestamp)) |> bupaR::n_cases()
p <- ggplot(data = dat, aes(x =date, y = n_cases)) +
geom_area(fill = "#69b3a2", alpha = 0.4) +
geom_line(color = "#69b3a2", size = 0.5) +
geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
labs(title = "Cases per month", x = "timestamp", y = "objects")
ggplotly(p, source = "myPlotSource3", customdata = ~ date)
})
myPlotEventData1 <- reactive({
event_data(event = "plotly_click", source = "myPlotSource1")
})
myPlotEventData2 <- reactive({
event_data(event = "plotly_click", source = "myPlotSource2")
})
myPlotEventData3 <- reactive({
event_data(event = "plotly_click", source = "myPlotSource3")
})
}
shinyApp(ui, server)
上面代码的问题是，您试图将完整的时间戳与日期对象进行比较。此外，customdata或key参数属于ggplot的aes调用(您的方法适用于plot_ly()(。
请检查以下内容：
library(shiny)
library(shinydashboard)
library(plotly)
library(dplyr)
library(ggplot2)
library(bupaR)
pr59<-structure(list(case_id = c("WC4120721", "WC4120667", "WC4120689",
"WC4121068", "WC4120667", "WC4120666", "WC4120667", "WC4121068",
"WC4120667", "WC4121068"), lifecycle = c(110, 110, 110, 110,
120, 110, 130, 120, 10, 130), action = c("WC4120721-CN354877",
"WC4120667-CN354878", "WC4120689-CN356752", "WC4121068-CN301950",
"WC4120667-CSW310", "WC4120666-CN354878", "WC4120667-CSW308",
"WC4121068-CSW303", "WC4120667-CSW309", "WC4121068-CSW308"),
activity = c("Forged Wire, Medium (Sport)", "Forged Wire, Medium (Sport)",
"Forged Wire, Medium (Sport)", "Forged Wire, Medium (Sport)",
"BBH-1&2", "Forged Wire, Medium (Sport)", "TCE Cleaning",
"SOLO Oil", "Tempering", "TCE Cleaning"), resource = c("3419",
"3216", "3409", "3201", "C3-100", "3216", "C3-080", "C3-030",
"C3-090", "C3-080"), timestamp = structure(c(1606964400,
1607115480, 1607435760, 1607568120, 1607630220, 1607670780,
1607685420, 1607710800, 1607729520, 1607744100), tzone = "", class = c("POSIXct",
"POSIXt")), .order = 1:10), row.names = c(NA, -10L), class = c("eventlog",
"log", "tbl_df", "tbl", "data.frame"), spec = structure(list(
cols = list(case_id = structure(list(), class = c("collector_character",
"collector")), lifecycle = structure(list(), class = c("collector_double",
"collector")), action = structure(list(), class = c("collector_character",
"collector")), activity = structure(list(), class = c("collector_character",
"collector")), resource = structure(list(), class = c("collector_character",
"collector")), timestamp = structure(list(), class = c("collector_character",
"collector"))), default = structure(list(), class = c("collector_guess",
"collector")), delim = ";"), class = "col_spec"), case_id = "case_id", activity_id = "activity", activity_instance_id = "action", lifecycle_id = "lifecycle", resource_id = "resource", timestamp = "timestamp")
ui <- tags$body(
dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
plotlyOutput("plot1"),
plotlyOutput("plot2"),
plotlyOutput("plot3")
)
)
)
server <- function(input, output, session) {
output$plot1 <- renderPlotly({
if (!is.null(myPlotEventData2())) {
displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData2()$customdata))
} else if (!is.null(myPlotEventData3())){
displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData3()$customdata))
} else {
displaydat <- pr59
}
dat <- displaydat |> group_by(date = as.Date(timestamp)) |> bupaR::n_cases()
p <- ggplot(data = dat, aes(x = date, y = n_cases, customdata = date)) +
geom_area(fill = "#69b3a2", alpha = 0.4) +
geom_line(color = "#69b3a2", size = 0.5) +
geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
labs(title = "Cases per month", x = "timestamp", y = "Cases")
ggplotly(p, source = "myPlotSource1")
})
output$plot2 <- renderPlotly({
if (!is.null(myPlotEventData1())) {
displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData1()$customdata))
} else if (!is.null(myPlotEventData3())){
displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData3()$customdata))
} else {
displaydat <- pr59
}
dat <- displaydat|> group_by(date = as.Date(timestamp)) |> bupaR::n_cases()
p <- ggplot(data = dat, aes(x = date, y = n_cases, customdata = date)) +
geom_area(fill = "#69b3a2", alpha = 0.4) +
geom_line(color = "#69b3a2", size = 0.5) +
geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
labs(title = "Cases per month", x = "timestamp", y = "events")
ggplotly(p, source = "myPlotSource2")
})
output$plot3 <- renderPlotly({
if (!is.null(myPlotEventData1())) {
displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData1()$customdata))
} else if (!is.null(myPlotEventData2())){
displaydat <- subset(pr59, as.Date(timestamp) %in% as.Date(myPlotEventData2()$customdata))
} else {
displaydat <- pr59
}
dat <- displaydat |> group_by(date = as.Date(timestamp)) |> bupaR::n_cases()
p <- ggplot(data = dat, aes(x =date, y = n_cases, customdata = date)) +
geom_area(fill = "#69b3a2", alpha = 0.4) +
geom_line(color = "#69b3a2", size = 0.5) +
geom_point(size = 1, color = "#69b3a2") + scale_color_grey() + theme_classic() +
labs(title = "Cases per month", x = "timestamp", y = "objects")
ggplotly(p, source = "myPlotSource3")
})
myPlotEventData1 <- reactive({
event_data(event = "plotly_click", source = "myPlotSource1")
})
myPlotEventData2 <- reactive({
event_data(event = "plotly_click", source = "myPlotSource2")
})
myPlotEventData3 <- reactive({
event_data(event = "plotly_click", source = "myPlotSource3")
})
}
shinyApp(ui, server)