Token/Activity input selection inconsistent ordering

[JesseVent]

I've noticed that when selecting the input tokens or activities in a shiny app there seems to be inconsistencies with the ordering they are applied in when multiple elements are selected.

I was expecting the order they get added would be in sequence that the user clicks them so either appended to the end of the vector or inserted at beginning.

I was attempting to dynamically display additional information based on the token/activity selected, but allow user to continue clicking through different elements and see the relative sections be updated based on the selected value. I did try various things to try capture the list before it changes and after, but I couldn't handle all the scenarios.

Below is a modification to your vignette or example available on https://jessevent.shinyapps.io/loan-process/ where when clicking on the elements you can see the drill-through sections doesn't update after randomly selecting a few sequences of inputs.

Thanks

library(shiny)
library(processanimateR)
library(eventdataR)
library(jsonlite)
library(timevis)
library(tidyverse)
library(bupaR)

shinyAnimation <- function(eventlog, min.time = 30, max.time = 600, default.time = 60) {
  animationUI <- function(id, title) {
    ns <- NS(id)
    tagList(
      h2(title),
      processanimaterOutput(ns("process")),
      h4("Selected cases"),
      textOutput(ns("token_selection")),
      h4("Selected activities"),
      textOutput(ns("activity_selection")),
      fluidRow(
        h2(textOutput(ns("activity_title"))),
        column(4, h3("Resources"), verbatimTextOutput(ns("activity_count"))),
        column(4, h3("Processing Time"), verbatimTextOutput(ns("activity_pro_time"))),
        column(4, h3("Throughput Time"), verbatimTextOutput(ns("activity_thr_time"))),
        timevisOutput(ns("activity_timeline"))),
      fluidRow(
        h2(textOutput(ns("patient_selection"))),
        timevisOutput(ns("timeline")))
    )
  }

  animation <- function(input, output, session, ...) {

    output$token_selection <- renderText({
      if (is.null(input$process_tokens)) {
        "None"
      } else {
        paste0(input$process_tokens, collapse = ",")
      }
    })

    time_log <- reactive({
      tokens <- tail(input$process_tokens, 1)
      log <- eventlog %>% as.data.frame() %>%
        subset(patient == as.character(tokens)) %>%
        select(handling_id, handling, registration_type, time) %>%
        group_by(handling_id, handling) %>%
        spread(registration_type, time) %>%
        ungroup(handling_id, handling) %>%
        mutate(handling=as.character(handling))
      if(length(log) == 4) {
        names(log) <- c("id","content","end","start")
      }
      return(log)
    })

    output$activity_selection <- renderText({
      if (is.null(input$process_activities)) {
        "None"
      } else {
        activities <- jsonlite::fromJSON(input$process_activities)
        paste0("(", activities$id, ",", activities$activity, ")", collapse = ",")
      }
    })

    activity_log <- reactive({
      activities <- jsonlite::fromJSON(input$process_activities)
      log <-  patients %>% filter_activity(head(activities$activity, 1))
    })

    activity_time_log <- reactive({
      log <- activity_log() %>% as.data.frame() %>%
        select(handling_id, handling, registration_type, time) %>%
        group_by(handling_id, handling) %>%
        spread(registration_type, time) %>%
        ungroup(handling_id, handling) %>%
        mutate(handling=as.character(handling))
      if(length(log) == 4) {
        names(log) <- c("id","content","end","start")
      }
      return(log)
    })

    output$activity_title <- renderText({
      if (is.null(input$process_activities)) {
        "No Activity Selected"
      } else {
        act <- unique(activity_log()$handling)
        title <- paste("Summary details for", act)}
    })

    output$activity_pro_time <- renderText({
      req(input$process_activities)
      processing_time(activity_log())
    })
    output$activity_thr_time <- renderText({
      req(input$process_activities)
      throughput_time(activity_log())
    })
    output$activity_count <- renderText({
      req(input$process_activities)
      counts <- activity_presence(activity_log())
      counts <- paste("Absolute:",counts$absolute, "Relative:", counts$relative)
    })
    output$process <- renderProcessanimater(expr = {
      animate_process(eventlog, ...)
    })
    output$timeline <- renderTimevis({
      req(input$process_tokens)
      time_log() %>% timevis(fit = TRUE)
    })
    output$activity_timeline <- renderTimevis({
      req(input$process_activities)
      max_date <- activity_time_log() %>%  summarise(max = max(end))
      max_date <- as.Date(max_date$max)
      activity_time_log() %>% timevis(fit = TRUE) %>% setWindow(max_date - 8, max_date)
    })

    output$patient_selection <- renderText({
      if (is.null(input$process_tokens)) {
        "No Patient Selected"
      } else {
        paste("Patient",tail(input$process_tokens, 1), "Timeline")}
    })
  }

  ui <- fluidPage(
    animationUI("module", "Select Inputs")
  )

  server <- function(input, output, session) {
    callModule(animation, "module")
  }
  shinyApp(ui, server, options = list(height = 500))
}

shinyAnimation(patients)

[fmannhardt]

Thanks for the detailed error report and nice app you built. Timevis is a nice complement to drill-down, I have not used it together so far, but will draw inspiration from your example. :-)

I compile the list of selected tokens based on the order in which they are inserted into the DOM. So no selection order is maintained currently. Would need some work to change this since I am currently storing the selection directly in the data property of the DOM elements.

I guess what you actually need is a single/multiple selection toggle, right? That would be easy to implement with the current code. Will put that on the TODO for v1.0.0 release.

[JesseVent]

That new commit works amazingly! Exactly what I was looking for, v1.0.0 release feels a lot smoother as well.

Another bit of functionality I think complements the process map functionality (in shiny apps anyway) is use of the dropdownButton from the shinyWidgets package. Makes it a whole lot cleaner implementing parameters and inputs for the process map.

Example available at shinyapps.io/jessevent/loan-process and code example at loan-app-process/01-shiny-timeline-app.R

Thanks!