twang2218 / pmap / #95

pending completion

Build # #95

Build Type

push

jenkins

Committed by

web-flow

Commit Message

<a href="https://github.com/twang2218/pmap/commit/<a class=hub.com/twang2218/pmap/commit/750fcef65d4b3d87df3c5f9e9ba1e61fb7f69aa7">750fcef65<a href="https://github.com/twang2218/pmap/commit/750fcef65d4b3d87df3c5f9e9ba1e61fb7f69aa7">">Merge </a><a class="double-link" href="https://github.com/twang2218/pmap/commit/<a class="double-link" href="https://github.com/twang2218/pmap/commit/d4414c7aba6f3ddf9286376a12f0eb86a1ad7f6d">d4414c7ab</a>">d4414c7ab</a><a href="https://github.com/twang2218/pmap/commit/750fcef65d4b3d87df3c5f9e9ba1e61fb7f69aa7"> into 80b26a7f2">80b26a7f2</a>

Run Details

80 of 80 new or added lines in 4 files covered. (100.0%)

414 of 434 relevant lines covered (95.39%)

26.86 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

97.78

/R/generate_edges.R

#' @title Generate edges from event logs
#' @usage generate_edges(eventlog, distinct_case = FALSE, target_categories = NULL)
#' @param eventlog Event logs
#' @param distinct_case Whether should only count unique case
#' @param target_categories A vector contains the target activity categories. By default, it's `NULL`, which means every paths count. If it's contains the target activity category, then only paths reaches the target activity count.
#' @return a `data.frame` of edges with `from`, `to` and `amount` columns.
#' @description `eventlog` should be a `data.frame` or `data.table`, which contains, at least, following columns:
#'
#'  * `timestamp`: timestamp column which indicates when activity happened. The column's data type should be `POSIXct`, otherwise it will be converted to `POSIXct` automatically. (`POSIXct`)
#'  * `case_id`: case identifier. (`character`)
#'  * `activity`: activity name. (`character`)
#'  * `category`: activity category. (`character`)
#' @examples
#' # -----------------------------------------------------
#' # Generating edges and count every paths no matter whether
#' # it's from the same case or not.
#' # -----------------------------------------------------
#' eventlog <- generate_eventlog()
#' edges <- generate_edges(eventlog)
#' # Have a look on generated edges
#' head(edges)
#' # # A tibble: 6 x 7
#' #   from    to     amount mean_duration median_duration max_duration min_duration
#' #   <chr>   <chr>   <int> <chr>         <chr>           <chr>        <chr>
#' # 1 Activi… Activ…     12 1.02 weeks    1.12 weeks      1.91 weeks   2 hours
#' # 2 Activi… Activ…      5 3.59 days     4.41 days       1.03 weeks   17.33 hours
#' # 3 Activi… Activ…     10 1.13 weeks    7 days          2.93 weeks   1.51 days
#' # 4 Activi… Activ…      1 2.46 weeks    2.46 weeks      2.46 weeks   2.46 weeks
#' # 5 Activi… Activ…      3 1.72 weeks    1.2 weeks       2.79 weeks   1.16 weeks
#' # 6 Activi… Activ…      8 3.38 days     2.2 days        1.85 weeks   15.1 hours
#'
#' str(edges)
#' # Classes ‘tbl_df’, ‘tbl’ and 'data.frame':       161 obs. of  7 variables:
#' #  $ from           : chr  "Activity 1 (normal)" "Activity 1 (normal)" "Activity 1 (normal)"
#' # "Activity 1 (normal)" ...
#' #  $ to             : chr  "Activity 1 (normal)" "Activity 10 (phone)" "Activity 11 (phone)"
#' # "Activity 12 (phone)" ...
#' #  $ amount         : int  12 5 10 1 3 8 2 15 9 15 ...
#' #  $ mean_duration  : chr  "1.02 weeks" "3.59 days" "1.13 weeks" "2.46 weeks" ...
#' #  $ median_duration: chr  "1.12 weeks" "4.41 days" "7 days" "2.46 weeks" ...
#' #  $ max_duration   : chr  "1.91 weeks" "1.03 weeks" "2.93 weeks" "2.46 weeks" ...
#' #  $ min_duration   : chr  "2 hours" "17.33 hours" "1.51 days" "2.46 weeks" ...
#' #
#' # -----------------------------------------------------
#' # Generate edges by specify the target categories, and the paths
#' # not reaching the target category activities will be ignored.
#' # -----------------------------------------------------
#' edges <- generate_edges(eventlog, target_categories = c("target"))
#' str(edges)
#' # Classes ‘tbl_df’, ‘tbl’ and 'data.frame':       115 obs. of  7 variables:
#' #  $ from           : chr  "Activity 1 (normal)" "Activity 1 (normal)" "Activity 1 (normal)"
#' # "Activity 1 (normal)" ...
#' #  $ to             : chr  "Activity 1 (normal)" "Activity 11 (phone)" "Activity 13 (target)"
#' # "Activity 14 (target)" ...
#' #  $ amount         : int  1 3 1 4 2 6 1 1 3 1 ...
#' #  $ mean_duration  : chr  "4.4 days" "2.12 weeks" "2.89 hours" "1.47 weeks" ...
#' #  $ median_duration: chr  "4.4 days" "2.15 weeks" "2.89 hours" "1.04 weeks" ...
#' #  $ max_duration   : chr  "4.4 days" "2.16 weeks" "2.89 hours" "3.53 weeks" ...
#' #  $ min_duration   : chr  "4.4 days" "2.03 weeks" "2.89 hours" "1.76 days" ...
#' #
#' @importFrom dplyr        %>%
#' @importFrom dplyr        distinct
#' @importFrom dplyr        group_by
#' @importFrom dplyr        summarize
#' @importFrom dplyr        ungroup
#' @importFrom dplyr        mutate_if
#' @importFrom dplyr        mutate
#' @importFrom dplyr        left_join
#' @importFrom dplyr        inner_join
#' @importFrom dplyr        select
#' @importFrom dplyr        filter
#' @importFrom dplyr        n
#' @importFrom data.table   setorder
#' @importFrom data.table   as.data.table
#' @importFrom stats        median
#' @importFrom stringr      str_trim
#' @export
generate_edges <- function(eventlog, distinct_case = FALSE, target_categories = NULL) {
  empty_edges <- data.frame(from=as.Date(character()),
                            to=as.Date(character()),
                            amount=integer())

  # return empty edge if eventlog is empty
  if (nrow(eventlog) == 0) {
    return(empty_edges)
  }

  # make 'R CMD check' happy
  activity <- category <- is_target <- case_id <- timestamp <- last_target_date <-
  from <- from_cid <- from_time <- from_is_target <-
  to_cid <- to <-
  duration <- mean_duration <- median_duration <- max_duration <- min_duration <- NULL

  # make sure there is no factor in the `eventlog` and trim the SPACE
  eventlog <- eventlog %>%
    dplyr::mutate_if(is.factor, as.character) %>%
    dplyr::mutate_if(is.character, stringr::str_trim)

  target_categories <- stringr::str_trim(target_categories)

  # Attach `is_target` column
  if (length(target_categories) > 0) {
    categories <- eventlog %>%
      dplyr::distinct(category) %>%
      dplyr::left_join(
        data.frame(
          category = target_categories,
          is_target = TRUE,
          stringsAsFactors = FALSE
        ),
        by = "category"
      ) %>%
      dplyr::select(category, is_target) %>%
      dplyr::mutate(is_target = !is.na(is_target))

    eventlog <- dplyr::inner_join(eventlog, categories, by = "category")
  } else {
    eventlog <- dplyr::mutate(eventlog, is_target = FALSE)
  }

  has_timestamp <- "timestamp" %in% colnames(eventlog)

  # convert timestamp if it's not POSIXct yet.
  if (has_timestamp && !inherits(eventlog$timestamp, "POSIXct")) {
    eventlog <- dplyr::mutate(eventlog, timestamp = as.POSIXct(timestamp))
  }

  # Construct potential edges
  eventlog <- data.table::as.data.table(eventlog)
  if (has_timestamp) {
    eventlog <- eventlog %>% data.table::setorder(case_id, timestamp)
  } else {
    eventlog <- eventlog %>% data.table::setorder(case_id)
  }

  size <- nrow(eventlog)
  begin <- eventlog[-size, ]
  end <- eventlog[-1, ]

  edges <- data.frame(
      from = begin$activity,
      case_id = begin$case_id,
      from_is_target = begin$is_target,
      to = end$activity,
      to_cid = end$case_id,
      to_is_target = end$is_target,
      stringsAsFactors = FALSE
    )
  # add time related attribute if it's available
  if (has_timestamp) {
    edges <- dplyr::mutate(edges,
      from_time = begin$timestamp,
      to_time = end$timestamp,
      duration = end$time - begin$time,
    )
  }
  # filter the invalid rows
  edges <- dplyr::filter(edges, case_id == to_cid & !from_is_target)

  # prune edges by target_categories
  if (length(target_categories) > 0) {
    # find the last target activity date
    if (has_timestamp) {
      case_last_target_date <- eventlog %>%
        dplyr::filter(is_target) %>%
        dplyr::group_by(case_id) %>%
        dplyr::summarize(last_target_date = max(timestamp))

      # prune all the edges with activity after the last target activity date
      edges <- edges %>%
        dplyr::inner_join(case_last_target_date, by = "case_id") %>%
        dplyr::filter(from_time < last_target_date)
    }
  }

  if (nrow(edges) == 0) {
    return(empty_edges)
  }

  # Only count case once if `distinct_case` flag is set
  if (distinct_case) {
    edges <- dplyr::group_by(edges, from, to, case_id)
    if (has_timestamp) {
      edges <- dplyr::summarize(edges,
        mean_duration = mean(duration),
        median_duration = stats::median(duration),
        max_duration = max(duration),
        min_duration = min(duration)
      )
    } else {
      edges <- dplyr::summarize(edges,
        amount = n()
      )
    }
  } else {
    if (has_timestamp) {
      edges <- dplyr::mutate(
        edges,
        mean_duration = duration,
        median_duration = duration,
        max_duration = duration,
        min_duration = duration,
      )
    }
  }

  edges <- dplyr::group_by(edges, from, to)
  if (has_timestamp) {
    edges <- dplyr::summarize(edges,
      amount = n(),
      mean_duration = mean(mean_duration),
      median_duration = stats::median(median_duration),
      max_duration = max(max_duration),
      min_duration = min(min_duration)
    )
  } else {
    edges <- dplyr::summarize(edges,
      amount = n()
    )
  }
  edges <- dplyr::ungroup(edges) %>% data.table::setorder(from, to)

  return(edges)
}

1	#' @title Generate edges from event logs
2	#' @usage generate_edges(eventlog, distinct_case = FALSE, target_categories = NULL)
3	#' @param eventlog Event logs
4	#' @param distinct_case Whether should only count unique case
5	#' @param target_categories A vector contains the target activity categories. By default, it's `NULL`, which means every paths count. If it's contains the target activity category, then only paths reaches the target activity count.
6	#' @return a `data.frame` of edges with `from`, `to` and `amount` columns.
7	#' @description `eventlog` should be a `data.frame` or `data.table`, which contains, at least, following columns:
8	#'
9	#' * `timestamp`: timestamp column which indicates when activity happened. The column's data type should be `POSIXct`, otherwise it will be converted to `POSIXct` automatically. (`POSIXct`)
10	#' * `case_id`: case identifier. (`character`)
11	#' * `activity`: activity name. (`character`)
12	#' * `category`: activity category. (`character`)
13	#' @examples
14	#' # -----------------------------------------------------
15	#' # Generating edges and count every paths no matter whether
16	#' # it's from the same case or not.
17	#' # -----------------------------------------------------
18	#' eventlog <- generate_eventlog()
19	#' edges <- generate_edges(eventlog)
20	#' # Have a look on generated edges
21	#' head(edges)
22	#' # # A tibble: 6 x 7
23	#' # from to amount mean_duration median_duration max_duration min_duration
24	#' # <chr> <chr> <int> <chr> <chr> <chr> <chr>
25	#' # 1 Activi… Activ… 12 1.02 weeks 1.12 weeks 1.91 weeks 2 hours
26	#' # 2 Activi… Activ… 5 3.59 days 4.41 days 1.03 weeks 17.33 hours
27	#' # 3 Activi… Activ… 10 1.13 weeks 7 days 2.93 weeks 1.51 days
28	#' # 4 Activi… Activ… 1 2.46 weeks 2.46 weeks 2.46 weeks 2.46 weeks
29	#' # 5 Activi… Activ… 3 1.72 weeks 1.2 weeks 2.79 weeks 1.16 weeks
30	#' # 6 Activi… Activ… 8 3.38 days 2.2 days 1.85 weeks 15.1 hours
31	#'
32	#' str(edges)
33	#' # Classes ‘tbl_df’, ‘tbl’ and 'data.frame': 161 obs. of 7 variables:
34	#' # $ from : chr "Activity 1 (normal)" "Activity 1 (normal)" "Activity 1 (normal)"
35	#' # "Activity 1 (normal)" ...
36	#' # $ to : chr "Activity 1 (normal)" "Activity 10 (phone)" "Activity 11 (phone)"
37	#' # "Activity 12 (phone)" ...
38	#' # $ amount : int 12 5 10 1 3 8 2 15 9 15 ...
39	#' # $ mean_duration : chr "1.02 weeks" "3.59 days" "1.13 weeks" "2.46 weeks" ...
40	#' # $ median_duration: chr "1.12 weeks" "4.41 days" "7 days" "2.46 weeks" ...
41	#' # $ max_duration : chr "1.91 weeks" "1.03 weeks" "2.93 weeks" "2.46 weeks" ...
42	#' # $ min_duration : chr "2 hours" "17.33 hours" "1.51 days" "2.46 weeks" ...
43	#' #
44	#' # -----------------------------------------------------
45	#' # Generate edges by specify the target categories, and the paths
46	#' # not reaching the target category activities will be ignored.
47	#' # -----------------------------------------------------
48	#' edges <- generate_edges(eventlog, target_categories = c("target"))
49	#' str(edges)
50	#' # Classes ‘tbl_df’, ‘tbl’ and 'data.frame': 115 obs. of 7 variables:
51	#' # $ from : chr "Activity 1 (normal)" "Activity 1 (normal)" "Activity 1 (normal)"
52	#' # "Activity 1 (normal)" ...
53	#' # $ to : chr "Activity 1 (normal)" "Activity 11 (phone)" "Activity 13 (target)"
54	#' # "Activity 14 (target)" ...
55	#' # $ amount : int 1 3 1 4 2 6 1 1 3 1 ...
56	#' # $ mean_duration : chr "4.4 days" "2.12 weeks" "2.89 hours" "1.47 weeks" ...
57	#' # $ median_duration: chr "4.4 days" "2.15 weeks" "2.89 hours" "1.04 weeks" ...
58	#' # $ max_duration : chr "4.4 days" "2.16 weeks" "2.89 hours" "3.53 weeks" ...
59	#' # $ min_duration : chr "4.4 days" "2.03 weeks" "2.89 hours" "1.76 days" ...
60	#' #
61	#' @importFrom dplyr %>%
62	#' @importFrom dplyr distinct
63	#' @importFrom dplyr group_by
64	#' @importFrom dplyr summarize
65	#' @importFrom dplyr ungroup
66	#' @importFrom dplyr mutate_if
67	#' @importFrom dplyr mutate
68	#' @importFrom dplyr left_join
69	#' @importFrom dplyr inner_join
70	#' @importFrom dplyr select
71	#' @importFrom dplyr filter
72	#' @importFrom dplyr n
73	#' @importFrom data.table setorder
74	#' @importFrom data.table as.data.table
75	#' @importFrom stats median
76	#' @importFrom stringr str_trim
77	#' @export
78	generate_edges <- function(eventlog, distinct_case = FALSE, target_categories = NULL) {
79	empty_edges <- data.frame(from=as.Date(character()),	22✔
80	to=as.Date(character()),	22✔
81	amount=integer())	22✔
82
83	# return empty edge if eventlog is empty
84	if (nrow(eventlog) == 0) {	22✔
85	return(empty_edges)	1✔
86	}
87
88	# make 'R CMD check' happy
89	activity <- category <- is_target <- case_id <- timestamp <- last_target_date <-	21✔
90	from <- from_cid <- from_time <- from_is_target <-	21✔
91	to_cid <- to <-	21✔
92	duration <- mean_duration <- median_duration <- max_duration <- min_duration <- NULL	21✔
93
94	# make sure there is no factor in the `eventlog` and trim the SPACE
95	eventlog <- eventlog %>%	21✔
96	dplyr::mutate_if(is.factor, as.character) %>%	21✔
97	dplyr::mutate_if(is.character, stringr::str_trim)	21✔
98
99	target_categories <- stringr::str_trim(target_categories)	21✔
100
101	# Attach `is_target` column
102	if (length(target_categories) > 0) {	21✔
103	categories <- eventlog %>%	10✔
104	dplyr::distinct(category) %>%	10✔
105	dplyr::left_join(	10✔
106	data.frame(	10✔
107	category = target_categories,	10✔
108	is_target = TRUE,	10✔
109	stringsAsFactors = FALSE	10✔
110	),
111	by = "category"	10✔
112	) %>%
113	dplyr::select(category, is_target) %>%	10✔
114	dplyr::mutate(is_target = !is.na(is_target))	10✔
115
116	eventlog <- dplyr::inner_join(eventlog, categories, by = "category")	10✔
117	} else {
118	eventlog <- dplyr::mutate(eventlog, is_target = FALSE)	11✔
119	}
120
121	has_timestamp <- "timestamp" %in% colnames(eventlog)	21✔
122
123	# convert timestamp if it's not POSIXct yet.
124	if (has_timestamp && !inherits(eventlog$timestamp, "POSIXct")) {	21✔
125	eventlog <- dplyr::mutate(eventlog, timestamp = as.POSIXct(timestamp))	5✔
126	}
127
128	# Construct potential edges
129	eventlog <- data.table::as.data.table(eventlog)	21✔
130	if (has_timestamp) {	21✔
131	eventlog <- eventlog %>% data.table::setorder(case_id, timestamp)	19✔
132	} else {
133	eventlog <- eventlog %>% data.table::setorder(case_id)	2✔
134	}
135
136	size <- nrow(eventlog)	21✔
137	begin <- eventlog[-size, ]	21✔
138	end <- eventlog[-1, ]	21✔
139
140	edges <- data.frame(	21✔
141	from = begin$activity,	21✔
142	case_id = begin$case_id,	21✔
143	from_is_target = begin$is_target,	21✔
144	to = end$activity,	21✔
145	to_cid = end$case_id,	21✔
146	to_is_target = end$is_target,	21✔
147	stringsAsFactors = FALSE	21✔
148	)
149	# add time related attribute if it's available
150	if (has_timestamp) {	21✔
151	edges <- dplyr::mutate(edges,	19✔
152	from_time = begin$timestamp,	19✔
153	to_time = end$timestamp,	19✔
154	duration = end$time - begin$time,	19✔
155	)
156	}
157	# filter the invalid rows
158	edges <- dplyr::filter(edges, case_id == to_cid & !from_is_target)	21✔
159
160	# prune edges by target_categories
161	if (length(target_categories) > 0) {	21✔
162	# find the last target activity date
163	if (has_timestamp) {	10✔
164	case_last_target_date <- eventlog %>%	10✔
165	dplyr::filter(is_target) %>%	10✔
166	dplyr::group_by(case_id) %>%	10✔
167	dplyr::summarize(last_target_date = max(timestamp))	10✔
168
169	# prune all the edges with activity after the last target activity date
170	edges <- edges %>%	10✔
171	dplyr::inner_join(case_last_target_date, by = "case_id") %>%	10✔
172	dplyr::filter(from_time < last_target_date)	10✔
173	}
174	}
175
176	if (nrow(edges) == 0) {	21✔
177	return(empty_edges)	1✔
178	}
179
180	# Only count case once if `distinct_case` flag is set
181	if (distinct_case) {	20✔
182	edges <- dplyr::group_by(edges, from, to, case_id)	1✔
183	if (has_timestamp) {	1✔
184	edges <- dplyr::summarize(edges,	1✔
185	mean_duration = mean(duration),	1✔
186	median_duration = stats::median(duration),	1✔
187	max_duration = max(duration),	1✔
188	min_duration = min(duration)	1✔
189	)
190	} else {
191	edges <- dplyr::summarize(edges,	×
192	amount = n()	×
193	)
194	}
195	} else {
196	if (has_timestamp) {	19✔
197	edges <- dplyr::mutate(	17✔
198	edges,	17✔
199	mean_duration = duration,	17✔
200	median_duration = duration,	17✔
201	max_duration = duration,	17✔
202	min_duration = duration,	17✔
203	)
204	}
205	}
206
207	edges <- dplyr::group_by(edges, from, to)	20✔
208	if (has_timestamp) {	20✔
209	edges <- dplyr::summarize(edges,	18✔
210	amount = n(),	18✔
211	mean_duration = mean(mean_duration),	18✔
212	median_duration = stats::median(median_duration),	18✔
213	max_duration = max(max_duration),	18✔
214	min_duration = min(min_duration)	18✔
215	)
216	} else {
217	edges <- dplyr::summarize(edges,	2✔
218	amount = n()	2✔
219	)
220	}
221	edges <- dplyr::ungroup(edges) %>% data.table::setorder(from, to)	20✔
222
223	return(edges)	20✔
224	}

twang2218 / pmap / #95

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous