bupaR，光泽中的边选择

提前道歉如果这个问题是愚蠢的，我对Shinny是相当陌生的，而且我的脑袋还在绕着它转

是否有方法在ProcessAnimator运行的情况下在Shiny中选择一条边，并返回通过该边的所有案例ID（因此具有相同的先例和上升活动）？例如，我使用ProcessAnimator的示例代码：

服务器和用户界面代码：

library(processanimateR)
library(shiny)
library(shinycssloaders)
ianimate_process <- function(eventlog, min.time = 30, max.time = 600, default.time = 60) {
  
  ui <- function(request) {
    fluidPage(
      tags$head(tags$style("#process{height:90vh !important;}")),
      titlePanel("Hello processanimateR!"),
      
      sidebarLayout(
        
        sidebarPanel(
          width = 2,
          sliderInput("duration", "Animation duration", min.time, max.time, default.time),
          selectInput("type", "Animation type", c("relative", "absolute"), "relative"),
          selectInput("sizeAttribute", "Size attribute", c("none", colnames(eventlog)), "none"),
          selectInput("colorAttribute", "Color attribute", c("none", colnames(eventlog)), "none"),
          selectInput("orientation", "Orientation", c("horizontal"="LR", "vertical"="TB"), "horizontal"),
          h4("Selected cases"),
          textOutput("token_selection"),
          h4("Selected activities"),
          textOutput("activity_selection")
        ),
        
        mainPanel(
          width = 10,
          shinycssloaders::withSpinner(processanimaterOutput("process"))
        )
      )
    )
  }
  
  server <- function(session, input, output) {
    
    data <- reactive({
      
      if (input$colorAttribute != "none") {
        attr <- rlang::sym(input$colorAttribute)
        val <- eventlog %>% pull(!!attr)
        if (!(is.character(val) || is.factor(val))) {
          warning("Trying to use a numeric attribute for the token color!")
        }
      }
      
      if (input$sizeAttribute != "none") {
        # This only works for numeric attributes
        attr <- rlang::sym(input$sizeAttribute)
        val <- eventlog %>% pull(!!attr)
        if (!is.numeric(val)) {
          warning("Trying to use a non-numeric attribute for the token size!")
        }
      }
      
      eventlog
      
    })
    
    output$token_selection <- renderText({
      
      paste0(input$process_tokens, ",")
      
    })
    
    output$activity_selection <- renderText({
      
      paste0(input$process_activities, ",")
      
    })
    
    output$process <- renderProcessanimater(expr = {
      graph <- processmapR::process_map(data(), render = F)
      model <- DiagrammeR::add_global_graph_attrs(graph, attr = "rankdir", value = input$orientation, attr_type = "graph")
      if (input$sizeAttribute != "none" && input$colorAttribute != "none") {
        animate_process(data(), model,
                        mode = input$type,
                        legend = "color",
                        mapping = token_aes(color = token_scale(input$colorAttribute, scale = "ordinal", 
                                                                range = RColorBrewer::brewer.pal(5, "YlOrBr")),
                                            size = token_scale(input$sizeAttribute, scale = "linear", range = c(6,10))),
                        duration = input$duration)
      } else if (input$sizeAttribute != "none") {
        animate_process(data(), model,
                        mode = input$type,
                        legend = "size",
                        mapping = token_aes(size = token_scale(input$sizeAttribute, scale = "linear", range = c(6,10))),
                        duration = input$duration)
        
      } else if (input$colorAttribute != "none") {
        animate_process(data(), model,
                        mode = input$type,
                        legend = "color",
                        mapping = token_aes(color = token_scale(input$colorAttribute, scale = "ordinal", range = RColorBrewer::brewer.pal(5, "YlOrBr"))),
                        duration = input$duration)
      } else {
        animate_process(data(), model,
                        mode = input$type,
                        duration = input$duration)
      }
      
    })
    
  }
  
  shinyApp(ui, server, options = list(height = 500))
  
}

这给了我结果。是否有一种方法，单击准入NC和发布B之间的边缘，将两个案例ID返回到表中或控制台中？我注意到有一个活动监听器，我可以使用它进行长时间的变通（比如选择第一个活动，然后选择后续活动，并过滤事件日志以查找每一个按顺序包含这两个活动的案例），但我认为必须有一种更简单、更不容易出错的方法来实现这一点

有什么想法吗

library(eventdataR)
library(edeaR)
library(dplyr)
ianimate_process(sepsis %>%
                   filter_trace_frequency(percentage = 0.2) %>%
                   filter_activity(c("Return ER"), reverse = T) %>%
                   # we fix the datatype of some of the attributes to allow proper rendering of the token color
                   # the token size option currently only support numeric attributes
                   mutate_at(c("lacticacid", "leucocytes", "crp", "age"), as.numeric) %>%
                   mutate_at(c("disfuncorg", "sirscriteria2ormore", "infectionsuspected"), as.logical))