Merge pull request #132 from microsoft/feature/visual-improvements

Aesthetics: update plots look and feel for consistency

.github/analyst_guide.md

@@ -38,6 +38,7 @@ To get the most out of **wpa**, make sure to leverage these additional resources
 
 1. Our official [**wpa** cheat sheet](https://github.com/microsoft/wpa/blob/main/man/figures/wpa%20cheatsheet.pdf).
 2. A growing list of [articles](https://microsoft.github.io/wpa/articles/) with detailed walkthroughs, written by multiple contributors. 
+3. Our [Microsoft Learn module](https://docs.microsoft.com/en-us/learn/modules/workplace-analytics-r-package/) _Analyze Microsoft Workplace Analytics data using the wpa R package_, which takes you step-by-step through the R package and its key features. 
 
 ## Ready to go?
 

.github/pull_request_template.md

@@ -10,6 +10,7 @@ The changes made in this PR are:
 # Checks
 - [ ] All R CMD checks pass 
 - [ ] `roxygen2::roxygenise()` has been run prior to merging to ensure that `.Rd` and `NAMESPACE` files are up to date.
+- [ ] `NEWS.md` has been updated.
 
 # Notes
 This fixes #<issue_number>

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: wpa
 Type: Package
 Title: Tools for Analysing and Visualising Workplace Analytics Data
-Version: 1.4.3.9000
+Version: 1.5.0
 Authors@R: c(
     person(given = "Martin", family = "Chan", role = c("aut", "cre"), email = "[email protected]"),
     person(given = "Carlos", family = "Morales", role = "aut", email = "[email protected]"),

NAMESPACE

@@ -78,6 +78,7 @@ export(heat_colours)
 export(hr_trend)
 export(hrvar_count)
 export(hrvar_count_all)
+export(hrvar_trend)
 export(identify_churn)
 export(identify_holidayweeks)
 export(identify_inactiveweeks)

NEWS.md

@@ -1,6 +1,11 @@
-# wpa (development version)
+# wpa 1.5.0
 
 - Improved aesthetics on plots
+- New visuals, with abbreviated labels added to archetypes generated by `workpatterns_classify()` (#130, #132)
+
+New functions:
+- `hrvar_trend()` (#132)
+- `one2one_freq()` (#132)
 
 # wpa 1.4.3
 

R/IV_by_Period.R

@@ -16,7 +16,7 @@
 #'
 #' @param data Person Query as a dataframe including date column named "Date"
 #'   This function assumes the data format is `MM/DD/YYYY` as is standard in a
-#'   WpA query output.
+#'   Workplace Analytics query output.
 #' @param before_start Start date of "before" time period in `YYYY-MM-DD`.
 #'   Defaults to earliest date in dataset.
 #' @param before_end End date of "before" time period in `YYYY-MM-DD`

R/check_query.R

@@ -27,8 +27,7 @@
 #'
 #' See `Value` for more information.
 #'
-#' @param validation Logical value to specify whether to return a check used by
-#'   the `validation_report()`. Defaults to `FALSE`. To hide checks on variable
+#' @param validation Logical value to specify whether to show summarized version. Defaults to `FALSE`. To hide checks on variable
 #'   names, set `validation` to `TRUE`.
 #'
 #' @return
@@ -80,9 +79,8 @@ check_query <- function(data, return = "message", validation = FALSE){
 #'
 check_person_query <- function(data, return){
 
-  ## Query Type - Initialise
-  ## Uses `identify_query()`
-  main_chunk <- paste0("The data used is a ", identify_query(data), " from ", wrap(data %>% count(Domain) %>% arrange(-n) %>% slice(1) %>% pull(Domain), wrapper = "`"))
+  ## Query Type - Uses `identify_query()`
+    main_chunk <- paste0("The data used is a ", identify_query(data))
 
   ## PersonId
   if(!("PersonId" %in% names(data))){
@@ -101,6 +99,39 @@ check_person_query <- function(data, return){
     main_chunk <- paste(main_chunk, new_chunk, sep = "\n\n")
   }
 
+ ## Extract unique identifiers of query ------------------------------------
+
+	extracted_chr <-
+	  data %>%
+	  hrvar_count_all(return = "table") %>%
+	  filter(`Unique values`==1) %>%
+	  pull(Attributes)
+
+	if (length(extracted_chr)>1) {
+
+		extractHRValues <- function(data, hrvar){
+			data %>%
+		    summarise(FirstValue = first(!!sym(hrvar))) %>%
+		    mutate(HRAttribute = wrap(hrvar, wrapper = "`")) %>%
+		    select(HRAttribute, FirstValue) %>%
+		    mutate(FirstValue = as.character(FirstValue)) # Coerce type
+			}
+
+		result <-
+		  extracted_chr %>%
+		  purrr::map(function(x){ extractHRValues(data = data, hrvar = x)}) %>%
+		  bind_rows()
+
+     new_chunk <- paste("Unique identifiers include:",
+                        result %>%
+                          mutate(identifier = paste(HRAttribute, "is", FirstValue)) %>%
+                          pull(identifier) %>%
+                          paste(collapse = "; "))
+
+     main_chunk <- paste(main_chunk, new_chunk, sep = "\n\n")
+	 }
+
+
   ## HR Variables
   hr_chr <- extract_hr(data, max_unique = 200) %>% wrap(wrapper = "`")
   new_chunk <- paste("There are", length(hr_chr), "(estimated) HR attributes in the data:" )
@@ -197,6 +228,40 @@ check_query_validation <- function(data, return){
     main_chunk <- paste(main_chunk, new_chunk, sep = "\n\n")
   }
 
+ ## Extract unique identifiers of query ------------------------------------
+
+	extracted_chr <-  data %>%
+	  hrvar_count_all(return = "table") %>%
+	  filter(`Unique values`==1) %>%
+	  pull(Attributes)
+
+	if (length(extracted_chr) > 1) {
+
+
+	  extractHRValues <- function(data, hrvar){
+	    data %>%
+	      summarise(FirstValue = first(!!sym(hrvar))) %>%
+	      mutate(HRAttribute = wrap(hrvar, wrapper = "`")) %>%
+	      select(HRAttribute, FirstValue) %>%
+	      mutate(FirstValue = as.character(FirstValue)) # Coerce type
+	  }
+
+	  result <-
+	    extracted_chr %>%
+	    purrr::map(function(x){ extractHRValues(data = data, hrvar = x)}) %>%
+	    bind_rows()
+
+	  new_chunk <- paste("Unique identifiers include:",
+	                     result %>%
+	                       mutate(identifier = paste(HRAttribute, "is", FirstValue)) %>%
+	                       pull(identifier) %>%
+	                       paste(collapse = "; "))
+
+	  main_chunk <- paste(main_chunk, new_chunk, sep = "\n\n")
+
+	 }
+
+
   ## HR Variables
   hr_chr <- extract_hr(data, max_unique = 200) %>% wrap(wrapper = "`")
   new_chunk <- paste("There are", length(hr_chr), "(estimated) HR attributes in the data:" )

R/collaboration_rank.R

@@ -40,7 +40,7 @@ collaboration_rank <- function(data,
                                mingroup = 5,
                                mode = "simple",
                                plot_mode = 1,
-                               return = "table"){
+                               return = "plot"){
 
 
   create_rank(data,

R/create_bar.R

@@ -29,6 +29,16 @@
 #' RGB values via `rgb2hex()`.
 #' @param na.rm A logical value indicating whether `NA` should be stripped
 #' before the computation proceeds. Defaults to `FALSE`.
+#' @param percent Logical value to determine whether to show labels as
+#'   percentage signs. Defaults to `FALSE`.
+#' @param plot_title An option to override plot title.
+#' @param plot_subtitle An option to override plot subtitle.
+#' @param rank String specifying how to rank the bars. Valid inputs are:
+#'   - `"descending"` - ranked highest to lowest from top to bottom (default).
+#'   - `"ascending"` - ranked lowest to highest from top to bottom.
+#'   - `NULL` - uses the original levels of the HR attribute.
+#' @param xlim An option to set max value in x axis.
+#'
 #'
 #' @return
 #' A different output is returned depending on the value passed to the `return` argument:
@@ -65,7 +75,12 @@ create_bar <- function(data,
                        mingroup = 5,
                        return = "plot",
                        bar_colour = "default",
-                       na.rm = FALSE){
+                       na.rm = FALSE,
+                       percent = FALSE,
+                       plot_title = us_to_space(metric),
+                       plot_subtitle = paste("Average by", tolower(camel_clean(hrvar))),
+                       rank = "descending",
+                       xlim = NULL){
 
   ## Check inputs
   required_variables <- c("Date",
@@ -115,66 +130,18 @@ create_bar <- function(data,
 
   }
 
-  ## Employee count / base size table
-  plot_legend <-
-    plot_data %>%
-    group_by(group) %>%
-    summarize(Employee_Count = first(Employee_Count)) %>%
-    mutate(Employee_Count = paste("n=",Employee_Count))
-
-  ## Data for bar plot
-  plot_table <-
-    plot_data %>%
-    group_by(group) %>%
-    summarise_at(metric, ~mean(., na.rm = na.rm)) %>%
-    arrange(desc(!!sym(metric)))
-
-  ## Table for annotation
-  annot_table <-
-    plot_legend %>%
-    dplyr::left_join(plot_table, by = "group")
-
-  ## Location attribute for x axis
- location <- plot_table %>% select(!!sym(metric)) %>% max()
-
   ## Bar plot
-  plot_object <-
-    plot_table %>%
-    ggplot(aes(x = stats::reorder(group, !!sym(metric)), y = !!sym(metric))) +
-    geom_bar(stat = "identity",
-             fill = bar_colour) +
-    geom_text(aes(label = round(!!sym(metric), 1)),
-              hjust = 1.3,
-              color = "#FFFFFF",
-              fontface = "bold",
-              size = 4) +
-    scale_y_continuous(expand = c(.01, 0), limits = c(0, location * 1.25)) +
-    annotate("text",
-             x = plot_legend$group,
-             y = location * 1.15,
-             label = plot_legend$Employee_Count,
-			 size=3) +
-    annotate("rect",
-             xmin = 0.5,
-             xmax = length(plot_legend$group) + 0.5,
-             ymin = location * 1.05,
-             ymax = location * 1.25,
-             alpha = .2) +
-    coord_flip() +
-    theme_wpa_basic() +
-    theme(
-  		axis.line = element_blank(),
-  		axis.ticks = element_blank(),
-  		axis.text.x = element_blank(),
-  		axis.title = element_blank()
-		) +
-    labs(
-      title = clean_nm,
-      subtitle = paste("Average", tolower(clean_nm), "by", tolower(camel_clean(hrvar))),
-      x = camel_clean(hrvar),
-      y = paste("Average weekly", clean_nm),
-      caption = extract_date_range(data, return = "text")
-         )
+  plot_object <- data %>%
+    create_stacked(metrics=metric,
+                   hrvar = hrvar,
+                   mingroup = mingroup,
+                   stack_colours = bar_colour,
+                   percent = percent,
+                   plot_title = plot_title,
+                   plot_subtitle = plot_subtitle,
+                   return = "plot",
+                   rank = rank,
+				   xlim = xlim)
 
   summary_table <-
     plot_data %>%