Skip to content

Commit

Permalink
Update idle time
Browse files Browse the repository at this point in the history
  • Loading branch information
gertjanssenswillen committed Dec 2, 2024
1 parent 93775d3 commit f8590bd
Show file tree
Hide file tree
Showing 43 changed files with 430 additions and 283 deletions.
5 changes: 3 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -30,9 +30,10 @@ Imports:
cli (>= 3.2.0),
zoo,
hms,
lifecycle
lifecycle,
magrittr
Encoding: UTF-8
RoxygenNote: 7.2.3
RoxygenNote: 7.3.2
URL:
https://bupar.net/,
https://github.com/bupaverse/edeaR/,
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -266,6 +266,7 @@ importFrom(lubridate,seconds)
importFrom(lubridate,wday)
importFrom(lubridate,year)
importFrom(lubridate,ymd_hms)
importFrom(magrittr,"%>%")
importFrom(rlang,arg_match)
importFrom(rlang,caller_env)
importFrom(rlang,expr_text)
Expand Down
18 changes: 10 additions & 8 deletions R/idle_time.R
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@
#'
#' @export idle_time
idle_time <- function(log,
level = c("log", "trace", "case", "resource"),
level = c("log", "trace", "case", "resource", "flow"),
append = deprecated(),
append_column = NULL,
units = c("auto", "secs", "mins", "hours", "days", "weeks"),
Expand All @@ -38,7 +38,7 @@ idle_time <- function(log,
#' @describeIn idle_time Computes the idle time for an [`eventlog`][`bupaR::eventlog`].
#' @export
idle_time.eventlog <- function(log,
level = c("log", "trace", "case", "resource"),
level = c("log", "trace", "case", "resource", "flow"),
append = deprecated(),
append_column = NULL,
units = c("auto", "secs", "mins", "hours", "days", "weeks"),
Expand All @@ -61,7 +61,8 @@ idle_time.eventlog <- function(log,
log = idle_time_log,
case = idle_time_case,
trace = idle_time_trace,
resource = idle_time_resource)
resource = idle_time_resource,
flow = idle_time_flow)

output <- FUN(log = log, units = units)

Expand All @@ -82,7 +83,7 @@ idle_time.eventlog <- function(log,
#' @describeIn idle_time Computes the idle time for a [`grouped_eventlog`][`bupaR::grouped_eventlog`].
#' @export
idle_time.grouped_eventlog <- function(log,
level = c("log", "case", "trace", "resource"),
level = c("log", "case", "trace", "resource", "flow"),
append = deprecated(),
append_column = NULL,
units = c("auto", "secs", "mins", "hours", "days", "weeks"),
Expand All @@ -105,7 +106,8 @@ idle_time.grouped_eventlog <- function(log,
log = idle_time_log,
case = idle_time_case,
trace = idle_time_trace,
resource = idle_time_resource)
resource = idle_time_resource,
flow = idle_time_flow)

output <- bupaR:::apply_grouped_fun(log, fun = FUN, units, .ignore_groups = FALSE, .keep_groups = FALSE, .returns_log = FALSE)

Expand All @@ -130,7 +132,7 @@ idle_time.grouped_eventlog <- function(log,
#' @describeIn idle_time Computes the idle time for an [`activitylog`][`bupaR::activitylog`].
#' @export
idle_time.activitylog <- function(log,
level = c("log", "trace", "case", "resource"),
level = c("log", "trace", "case", "resource", "flow"),
append = deprecated(),
append_column = NULL,
units = c("auto", "secs", "mins", "hours", "days", "weeks"),
Expand All @@ -154,7 +156,7 @@ idle_time.activitylog <- function(log,
#' @describeIn idle_time Computes the idle time for a [`grouped_activitylog`][`bupaR::grouped_activitylog`].
#' @export
idle_time.grouped_activitylog <- function(log,
level = c("log", "trace", "case", "resource"),
level = c("log", "trace", "case", "resource", "flow"),
append = deprecated(),
append_column = NULL,
units = c("auto", "secs", "mins", "hours", "days", "weeks"),
Expand All @@ -173,4 +175,4 @@ idle_time.grouped_activitylog <- function(log,
append_column = append_column,
units = units,
sort = sort)
}
}
64 changes: 64 additions & 0 deletions R/idle_time_flow.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,64 @@
idle_time_flow <- function(log, units) {

# activate <- NULL
# active <- NULL
# ts <- NULL
# next_ts <- NULL
# dur <- NULL

# patients %>%
# mutate(activate = ifelse((!!lifecycle_id_(log)) == "start", 1, ifelse((!!lifecycle_id_(log)) == "complete", -1, 0))) %>%
# group_by_case() %>%
# arrange(!!timestamp_(log), .order) %>%
# mutate(active = cumsum(activate),
# ts = !!timestamp_(log),
# next_ts = lead(!!timestamp_(log))) %>%
# mutate(dur = difftime(next_ts, ts, units = units)) %>%
# filter(active == 0 & !is.na(dur)) %>%
# summarize(idle_time = sum(dur)) -> output

dt <- data.table(log)

LCID <- NULL
activate <- NULL
TS <- NULL
active <- NULL
next_TS <- NULL
dur <- NULL
CID <- NULL
AID <- NULL
AIID <- NULL
start <- NULL


# Override column names for handling
setnames(dt,
old = c(lifecycle_id(log), case_id(log), timestamp(log), activity_id(log), activity_instance_id(log)),
new = c("LCID", "CID", "TS", "AID", "AIID"))

dt[, .("start" = min(TS), "complete" = max(TS)), by = .(CID,AID, AIID)] -> dt

dt <- gather(dt, LCID, TS, start, complete ) %>% data.table()

dt[, "activate" := fcase(LCID == "start", 1L,
LCID == "complete", -1L,
default = 0L)]
# Order by timestamp and .order per case
setorderv(dt, cols = c("TS"))

dt[,":="("active" = cumsum(activate),
"next_TS" = shift(TS, type = "lead"),
"next_ACT" = shift(AID, type = "lead")),
by = "CID"][,
"dur" := difftime(next_TS, TS, units = units)][
active == 0L & !is.na(dur)] -> dt

# Revert column names to original
setnames(dt, old = c("CID","AID", "next_ACT", "dur", "AIID"), new = c(case_id(log), "from", "to", "idle_time", activity_instance_id(log)))

output <- as_tibble(dt) %>%
select(-LCID, -TS, -next_TS, -active, -activate)

attr(output, "units") <- attr(output[["idle_time"]], "units")
return(output)
}
4 changes: 4 additions & 0 deletions R/processing_time_activity_instance.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,10 @@ processing_time_activity_instance <- function(log, units, work_schedule) {
e <- NULL
timestamp_classifier <- NULL
activity_id_identifier <- NULL
lifecycle_id_identifier <- NULL
next_TS <- NULL
activate <- NULL
dur <- NULL
elapsed <- NULL


Expand Down
2 changes: 1 addition & 1 deletion R/processing_time_case.R
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@ processing_time_case <- function(log, units, work_schedule) {
dict <- dict %>%
full_join(raw, by = activity_instance_id(log)) %>%
group_by(!!case_id_(log)) %>%
summarize(processing_time = sum(processing_time)) %>%
summarize(processing_time = sum(processing_time, na.rm = T)) %>%
select(!!case_id_(log), processing_time)

attr(dict, "units") <- time_units
Expand Down
19 changes: 11 additions & 8 deletions R/throughput_time.R
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,8 @@
#' * On `"case"` level, the throughput time is defined as the total duration of the case, or the difference between
#' the timestamp of the end event and the timestamp of the start event of the case. Possible [`idle_time()`] is also included
#' in this calculation.
#'
#' * On `"activity-instance"` level, the throughput time of each activity instance. Throughput here is defined as the difference between the first and last event, without considering the lifecycle status. For the lifecycle-aware throughput time (e.g. not incorporating the time the activity is "suspended"), see processing time.
#' * on `'activity` level, summary statistics describing the throuhgput time of activity instances (see above) per activity type.
#' For other levels (e.g. `"activity"`, `"resource"`, or `"resource-activity"`), the throughput time is equal
#' to the [`processing_time()`] and are, therefore, not supported by this method.
#'
Expand All @@ -30,7 +31,7 @@
#'
#' @export throughput_time
throughput_time <- function(log,
level = c("log", "trace", "case"),
level = c("log", "trace", "case", "activity","activity-instance"),
append = deprecated(),
append_column = NULL,
units = c("auto", "secs", "mins", "hours", "days", "weeks"),
Expand All @@ -43,7 +44,7 @@ throughput_time <- function(log,
#' @describeIn throughput_time Computes throughput time for an [`eventlog`][`bupaR::eventlog`].
#' @export
throughput_time.eventlog <- function(log,
level = c("log", "trace", "case"),
level = c("log", "trace", "case", "activity","activity-instance"),
append = deprecated(),
append_column = NULL,
units = c("auto", "secs", "mins", "hours", "days", "weeks"),
Expand All @@ -65,7 +66,9 @@ throughput_time.eventlog <- function(log,
FUN <- switch(level,
log = throughput_time_log,
case = throughput_time_case,
trace = throughput_time_trace)
trace = throughput_time_trace,
"activity-instance" = throughput_time_activity_instance,
activity = throughput_time_activity)

output <- FUN(log = log, units = units, work_schedule = work_schedule)

Expand All @@ -86,7 +89,7 @@ throughput_time.eventlog <- function(log,
#' @describeIn throughput_time Computes throughput time for a [`grouped_eventlog`][`bupaR::grouped_eventlog`].
#' @export
throughput_time.grouped_eventlog <- function(log,
level = c("log", "trace", "case"),
level = c("log", "trace", "case", "activity","activity-instance"),
append = deprecated(),
append_column = NULL,
units = c("auto", "secs", "mins", "hours", "days", "weeks"),
Expand Down Expand Up @@ -140,7 +143,7 @@ throughput_time.grouped_eventlog <- function(log,
#' @describeIn throughput_time Computes throughput time for an [`activitylog`][`bupaR::activitylog`].
#' @export
throughput_time.activitylog <- function(log,
level = c("log", "trace", "case"),
level = c("log", "trace", "case", "activity","activity-instance"),
append = deprecated(),
append_column = NULL,
units = c("auto", "secs", "mins", "hours", "days", "weeks"),
Expand All @@ -166,7 +169,7 @@ throughput_time.activitylog <- function(log,
#' @describeIn throughput_time Computes throughput time for a [`grouped_activitylog`][`bupaR::grouped_activitylog`].
#' @export
throughput_time.grouped_activitylog <- function(log,
level = c("log", "trace", "case"),
level = c("log", "trace", "case", "activity","activity-instance"),
append = deprecated(),
append_column = NULL,
units = c("auto", "secs", "mins", "hours", "days", "weeks"),
Expand All @@ -187,4 +190,4 @@ throughput_time.grouped_activitylog <- function(log,
units = units,
sort = sort,
work_schedule = work_schedule)
}
}
24 changes: 24 additions & 0 deletions R/throughput_time_activity.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,24 @@

throughput_time_activity <- function(log, units, work_schedule) {

relative_frequency <- NULL

throughput_time_activity_instance(log, units = units, work_schedule = work_schedule) -> raw
log %>%
as.data.frame() %>%
distinct(!!sym(activity_id(log)), !!sym(activity_instance_id(log))) -> aid_a_link
# Store time units, because dplyr transformations remove the attributes.
time_units <- attr(raw, "units")


merge(raw, aid_a_link, by = activity_instance_id(log)) %>%
group_by(!!sym(activity_id(log))) %>%
grouped_summary_statistics("throughput_time", relative_frequency = n()) %>%
mutate(relative_frequency = relative_frequency/sum(relative_frequency)) %>%
arrange(desc(relative_frequency)) %>%
select(!!sym(activity_id(log)), relative_frequency, everything()) -> output

attr(output, "raw") <- raw
attr(output, "units") <- time_units
return(output)
}
33 changes: 33 additions & 0 deletions R/throughput_time_activity_instance.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,33 @@

throughput_time_activity_instance <- function(log, units, work_schedule = NULL) {

s <- NULL
elapsed <- NULL

timestamp_classifier <- NULL
activity_instance_classifier <- activity_instance_id(log)
colnames(log)[colnames(log) == timestamp(log)] <- "timestamp_classifier"
colnames(log)[colnames(log) == activity_instance_classifier] <- "activity_instance_classifier"

e <- log %>%
as.data.table %>%
.[, .(s = min(timestamp_classifier),
e = max(timestamp_classifier)), .(activity_instance_classifier)]
colnames(e)[colnames(e) == "activity_instance_classifier"] <- activity_instance_classifier

intervals <- as.data.frame(e)

if(is.null(work_schedule)) {
intervals %>%
mutate(throughput_time = difftime(e, s, units = units)) %>%
select(-s, -e) -> output
} else {

calculate_work_schedule_times(intervals, work_schedule, units) %>%
select(-s, -e) %>%
rename(throughput_time = elapsed) -> output
}

attr(output, "units") <- attr(output[["throughput_time"]], "units")
return(output)
}
18 changes: 9 additions & 9 deletions R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -187,13 +187,13 @@ summary_statistics <- function(vector) {

vector %>%
as_tibble() %>%
summarise("min" = min(vector),
"q1" = quantile(vector, probs = 0.25),
"median" = median(vector),
"mean" = mean(vector),
"q3" = quantile(vector, probs = 0.75),
"max" = max(vector),
"st_dev" = sd(vector),
summarise("min" = suppressWarnings(min(vector, na.rm = T)),
"q1" = quantile(vector, probs = 0.25, na.rm = T),
"median" = median(vector, na.rm = T),
"mean" = mean(vector, na.rm = T),
"q3" = quantile(vector, probs = 0.75, na.rm = T),
"max" = max(vector, na.rm = T),
"st_dev" = suppressWarnings(sd(vector, na.rm = T)),
"iqr" = .data[["q3"]] - .data[["q1"]]) -> s

return(s)
Expand All @@ -202,12 +202,12 @@ summary_statistics <- function(vector) {
grouped_summary_statistics <- function(data.frame, values, na.rm = T, ...) {
values <- sym(values)
data.frame %>%
summarize(min = min(!!values,na.rm = na.rm),
summarize(min = suppressWarnings(min(!!values,na.rm = na.rm)),
q1 = quantile(!!values, 0.25, na.rm = na.rm),
mean = mean(!!values, na.rm = na.rm),
median = median(!!values, na.rm = na.rm),
q3 = quantile(!!values, 0.75, na.rm = na.rm),
max = max(!!values, na.rm = na.rm),
max = suppressWarnings(max(!!values, na.rm = na.rm)),
st_dev = sd(!!values, na.rm = na.rm),
iqr = IQR(!!values, na.rm = na.rm),
total = sum(!!values, na.rm = na.rm),
Expand Down
2 changes: 1 addition & 1 deletion man/edeaR.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

16 changes: 8 additions & 8 deletions man/filter_activity.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit f8590bd

Please sign in to comment.