feat: refine L2 algorithm and update report

R/workpatterns_classify_bw.R

@@ -286,9 +286,9 @@ workpatterns_classify_bw <- function(data,
   ptn_data_personas[Active_Hours > exp_hours & Active_Hours==Day_Span , Personas_L2 := "4 Long continuous workday"]
   ptn_data_personas[Active_Hours > exp_hours & Active_Hours<Day_Span, Personas_L2 := "3 Long flexible workday"]
   ptn_data_personas[Active_Hours <= exp_hours & (Before_start>0|After_end>0), Personas_L2 := "2.2 Standard flexible (shifted schedule)"]
-  ptn_data_personas[Active_Hours <= exp_hours & (Before_start == 0|After_end == 0), Personas_L2 := "2.1 Standard flexible (expected schedule)"]
-  ptn_data_personas[Active_Hours == exp_hours & (Before_start>0|After_end>0), Personas_L2 := "1.2 Standard continuous (shifted schedule)"]
-  ptn_data_personas[Active_Hours == exp_hours & (Before_start == 0|After_end == 0), Personas_L2 := "1.1 Standard continuous (expected schedule)"]
+  ptn_data_personas[Active_Hours <= exp_hours & Before_start == 0 & After_end == 0, Personas_L2 := "2.1 Standard flexible (expected schedule)"]
+  ptn_data_personas[Active_Hours == exp_hours & (Before_start > 0 | After_end > 0) & Active_Hours == Day_Span, Personas_L2 := "1.2 Standard continuous (shifted schedule)"]
+  ptn_data_personas[Active_Hours == exp_hours & Before_start == 0 & After_end == 0 & Active_Hours == Day_Span, Personas_L2 := "1.1 Standard continuous (expected schedule)"]
   ptn_data_personas[Active_Hours >= 13, Personas_L2 := "5 Always on (13h+)"]
   ptn_data_personas[Active_Hours < 3, Personas_L2 := "0 Low Activity (< 3 hours on)"]
   ptn_data_personas[, Personas_L2 := factor(Personas_L2, levels = personas_levels_l2)]

R/workpatterns_report.R

@@ -58,14 +58,14 @@ workpatterns_report <- function(data,
   pd_id <-
     wp_list$data %>%
     mutate(PersonWeekId = paste0(PersonId,"_",Date)) %>%
-    select(PersonWeekId, Personas)
+    select(PersonWeekId, Personas, Personas_L2)
 
   ## plot table for `workpatterns_rank`
   plot_table_list <-
     data %>%
     mutate(PersonWeekId = paste0(PersonId,"_",Date)) %>%
     left_join(pd_id, by = "PersonWeekId") %>%
-    split(.$Personas)
+    split(.$Personas_L2)
 
   plot_rank_list <-
     plot_table_list %>%
@@ -132,7 +132,9 @@ workpatterns_report <- function(data,
       plot_rank_list[[4]],
       plot_rank_list[[5]],
       plot_rank_list[[6]],
-      plot_rank_list[[7]]) %>% # Expand objects to this list
+      plot_rank_list[[7]],
+      plot_rank_list[[8]]
+      ) %>% # Expand objects to this list
     purrr::map_if(is.data.frame, wpa::create_dt, rounding = 2) %>%
     purrr::map_if(is.character, md2html)
 
@@ -150,7 +152,9 @@ workpatterns_report <- function(data,
       paste(names(plot_table_list)[[4]]),
       paste(names(plot_table_list)[[5]]),
       paste(names(plot_table_list)[[6]]),
-      paste(names(plot_table_list)[[7]]))
+      paste(names(plot_table_list)[[7]]),
+      paste(names(plot_table_list)[[8]])
+      )
 
   ## Set header levels
   ## Makes use of level/header system for Markdown syntax