Merge pull request #200 from microsoft/fix/general-bug-fixes

martinctc · web-flow · commit fa814c9ce749 · 2022-01-19T16:13:50.000Z
Fix: general bug fixes and prep for v1.6.4
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -28,3 +28,4 @@ man-roxygen
 ^Meta$
 ^cran-comments\.md$
 ^CRAN-RELEASE$
+^CRAN-SUBMISSION$
diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION
@@ -0,0 +1,3 @@
+Version: 1.6.4
+Date: 2022-01-19 15:26:54 UTC
+SHA: 3edf7394a94cd59be8b6d83362ab0cfad81c4afa
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: wpa
 Type: Package
 Title: Tools for Analysing and Visualising Workplace Analytics Data
-Version: 1.6.3
+Version: 1.6.4
 Authors@R: c(
     person(given = "Martin", family = "Chan", role = c("aut", "cre"), email = "martin.chan@microsoft.com"),
     person(given = "Carlos", family = "Morales", role = "aut", email = "carlos.morales@microsoft.com"),
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,11 @@
+# wpa 1.6.4
+
+- Made `meeting_skim()` dynamic - the function will still run even if not all variables are present. (#198)
+- Enable text mining functions to accept `stopwords` argument as a string
+vector, rather than a data frame (#182)
+- Better handling of errors due to variable name inconsistency when loading in a
+Ways of Working Assessment query as opposed to a Standard Person Query (#201)
+
 # wpa 1.6.3
 
 - Added `create_inc()` for creating incidence analysis
diff --git a/R/collaboration_area.R b/R/collaboration_area.R
@@ -59,6 +59,10 @@ collaboration_area <- function(data,
                                mingroup=5,
                                return = "plot"){
 
+  ## Handle variable name consistency
+  data <- qui_stan_c(data)
+  data <- qui_stan_im(data)
+
   ## Handling NULL values passed to hrvar
   if(is.null(hrvar)){
     data <- totals_col(data)
@@ -71,16 +75,6 @@ collaboration_area <- function(data,
   ## Lower case version of column names
   lnames <- tolower(names(data))
 
-  if("instant_message_hours" %in% lnames){
-
-    names(data) <-
-      gsub(pattern = "instant_message_hours",
-           replacement = "Instant_Message_hours",
-           x = names(data),
-           ignore.case = TRUE) # Case-insensitive
-
-  }
-
   if("unscheduled_call_hours" %in% lnames){
 
     names(data) <-
diff --git a/R/collaboration_dist.R b/R/collaboration_dist.R
@@ -32,6 +32,9 @@ collaboration_dist <- function(data,
                                return = "plot",
                                cut = c(15, 20, 25)) {
 
+  ## Handle variable name consistency
+  data <- qui_stan_c(data)
+
   create_dist(data = data,
               metric = "Collaboration_hours",
               hrvar = hrvar,
diff --git a/R/collaboration_fizz.R b/R/collaboration_fizz.R
@@ -32,6 +32,9 @@ collaboration_fizz <- function(data,
                        mingroup = 5,
                        return = "plot"){
 
+  ## Handle variable name consistency
+  data <- qui_stan_c(data)
+
   create_fizz(data = data,
               metric = "Collaboration_hours",
               hrvar = hrvar,
diff --git a/R/collaboration_line.R b/R/collaboration_line.R
@@ -33,6 +33,9 @@ collaboration_line <- function(data,
                                 mingroup = 5,
                                 return = "plot"){
 
+  ## Handle variable name consistency
+  data <- qui_stan_c(data)
+
   ## Inherit arguments
   create_line(data = data,
               metric = "Collaboration_hours",
diff --git a/R/collaboration_rank.R b/R/collaboration_rank.R
@@ -42,9 +42,11 @@ collaboration_rank <- function(data,
                                plot_mode = 1,
                                return = "plot"){
 
+  ## Handle variable name consistency
+  data <- qui_stan_c(data)
 
   create_rank(data,
-              metric="Collaboration_hours",
+              metric = "Collaboration_hours",
               hrvar = hrvar,
               mingroup = mingroup,
               mode = mode,
diff --git a/R/collaboration_trend.R b/R/collaboration_trend.R
@@ -28,6 +28,9 @@ collaboration_trend <- function(data,
                                 mingroup = 5,
                                 return = "plot"){
 
+  ## Handle variable name consistency
+  data <- qui_stan_c(data)
+
   create_trend(data,
                metric = "Collaboration_hours",
                hrvar = hrvar,
diff --git a/R/globals.R b/R/globals.R
@@ -28,6 +28,8 @@ utils::globalVariables(
     "Metric",
     "Hours",
     "Collaboration_hours",
+    "Collaboration_hrs",
+    "Instant_message_hours",
     "bucket_hours",
     "Employees",
     "Total",
diff --git a/R/meeting_skim.R b/R/meeting_skim.R
@@ -34,21 +34,27 @@
 #' @export
 meeting_skim <- function(data, return = "message"){
 
+  required_vars <-
+    c(
+      "PersonId",
+      "Meeting_hours",
+      "Conflicting_meeting_hours",
+      "Multitasking_meeting_hours",
+      "Redundant_meeting_hours__lower_level_",
+      "Redundant_meeting_hours__organizational_",
+      "Low_quality_meeting_hours"
+    )
+
+  used_vars <- dplyr::intersect(names(data), required_vars)
+
   key_output <-
     data %>%
-    select(PersonId,
-           Meeting_hours,
-           Conflicting_meeting_hours,
-           Multitasking_meeting_hours,
-           Redundant_meeting_hours__lower_level_,
-           Redundant_meeting_hours__organizational_,
-           Low_quality_meeting_hours) %>%
+    select(used_vars) %>%
     summarise_at(vars(-PersonId), ~sum(.)) %>% # sum total
     tidyr::gather(HourType, Hours, -Meeting_hours) %>%
     mutate_at(vars(Hours), ~./Meeting_hours) %>%
     mutate(RawHours = Hours * Meeting_hours)
 
-
   mh_total <- round(key_output$Meeting_hours[1])
 
   mh_lowqualityprop <-
@@ -73,38 +79,59 @@ meeting_skim <- function(data, return = "message"){
   }
 
   extract_raw <- function(filt_chr){
+
     key_output %>%
       filter(HourType == filt_chr) %>%
       pull(RawHours) %>%
       round()
   }
 
+  combine_extracts <- function(filt_chr, keyword){
+
+    out <-
+      key_output %>%
+      filter(HourType == filt_chr)
+
+    if(nrow(out) == 0){
+
+      return(NULL)
+
+    } else {
+
+      paste(
+        ">>>",
+        extract_raw(filt_chr),
+        "are",
+        keyword,
+        bracket(extract_prop(filt_chr))
+      )
+
+    }
+  }
+
+  key_text <- c(
+    combine_extracts(filt_chr = "Low_quality_meeting_hours",
+                     keyword = "low quality"),
+    combine_extracts(filt_chr = "Redundant_meeting_hours__organizational_",
+                     keyword = "redundant"),
+    combine_extracts(filt_chr = "Conflicting_meeting_hours",
+                     keyword = "conflicting"),
+    combine_extracts(filt_chr = "Multitasking_meeting_hours",
+                     keyword = "multitasking")
+  ) %>%
+    .[nchar(.) >= 1] %>% # at least character length >= 1
+    paste(collapse = "\n")
 
   print_text <-
-    paste("There are",
-          mh_total,
-          "total meeting hours across the analysis population.\n",
-
-          ">>>",
-          extract_raw("Low_quality_meeting_hours"),
-          "are low quality",
-          bracket(extract_prop("Low_quality_meeting_hours")),
-          "\n",
-
-          ">>>",
-          extract_raw("Redundant_meeting_hours__organizational_"),
-          "are redundant",
-          bracket(extract_prop("Redundant_meeting_hours__organizational_")),
-          "\n",
-          ">>>",
-          extract_raw("Conflicting_meeting_hours"),
-          "are conflicting",
-          bracket(extract_prop("Conflicting_meeting_hours")),
-          "\n",
-          ">>>",
-          extract_raw("Multitasking_meeting_hours"),
-          "are multitasking.",
-          bracket(extract_prop("Multitasking_meeting_hours")))
+    paste(
+      paste(
+        "There are",
+        mh_total,
+        "total meeting hours across the analysis population."
+        ),
+      key_text,
+      sep = "\n"
+          )
 
   if(return == "message"){
 
diff --git a/R/meeting_tm_report.R b/R/meeting_tm_report.R
@@ -6,8 +6,8 @@
 #' @param data A Meeting Query dataset in the form of a data frame.
 #' @param path Pass the file path and the desired file name, _excluding the file
 #'   extension_. For example, `"meeting text mining report"`.
-#' @param stopwords A single-column data frame labelled `'word'` containing
-#'   custom stopwords to remove.
+#' @param stopwords A character vector OR a single-column data frame labelled
+#'   `'word'` containing custom stopwords to remove.
 #' @param timestamp Logical vector specifying whether to include a timestamp in
 #'   the file name. Defaults to TRUE.
 #' @param keep A numeric vector specifying maximum number of words to keep.
diff --git a/R/standardise_pq.R b/R/standardise_pq.R
@@ -78,3 +78,38 @@ standardise_pq <- function(data){
 #' @export
 standardize_pq <- standardise_pq
 
+#' @title Standardise variable names for Standard Person Query Quietly for
+#' `Collaboration_hours`
+#'
+#' @noRd
+#'
+qui_stan_c <- function(data){
+
+  if(!("Collaboration_hours" %in% names(data)) &
+     ("Collaboration_hrs" %in% names(data))){
+
+    data <- data %>% mutate(Collaboration_hours = Collaboration_hrs)
+    # message("Adding `Collaboration_hours` column based on `Collaboration_hrs`")
+
+  }
+
+  return(data)
+}
+
+#' @title Standardise variable names for Standard Person Query Quietly for
+#' `Instant_Message_hours`
+#'
+#' @noRd
+#'
+qui_stan_im <- function(data){
+
+  if(!("Instant_Message_hours" %in% names(data)) &
+     ("Instant_message_hours" %in% names(data))){
+
+    data <- data %>% mutate(Instant_Message_hours = Instant_message_hours)
+    # message("Adding `Instant_Message_hours` column based on `Instant_message_hours`")
+
+  }
+
+  return(data)
+}
diff --git a/R/subject_scan.R b/R/subject_scan.R
@@ -35,8 +35,8 @@
 #' @param weight String specifying the column name of a numeric variable for
 #'   weighting data, such as `"Invitees"`. The column must contain positive
 #'   integers. Defaults to `NULL`, where no weighting is applied.
-#' @param stopwords A single-column data frame labelled `'word'` containing
-#'   custom stopwords to remove.
+#' @param stopwords A character vector OR a single-column data frame labelled
+#'   `'word'` containing custom stopwords to remove.
 #' @param ... Additional parameters to pass to `tm_clean()`.
 #'
 #' @return
diff --git a/R/tm_clean.R b/R/tm_clean.R
@@ -17,8 +17,8 @@
 #' @param data A Meeting Query dataset in the form of a data frame.
 #' @param token A character vector accepting either `"words"` or `"ngrams"`,
 #'   determining type of tokenisation to return.
-#' @param stopwords A single-column data frame labelled `'word'` containing
-#'   custom stopwords to remove.
+#' @param stopwords A character vector OR a single-column data frame labelled
+#'   `'word'` containing custom stopwords to remove.
 #' @param ... Additional parameters to pass to `tidytext::unnest_tokens()`.
 #'
 #' @import dplyr
@@ -53,6 +53,14 @@ tm_clean <- function(data,
            text = as.character(Subject)) %>%
     select(line, text)
 
+  # If `stopwords` is passed as a character vector, convert to data frame
+  if(is.character(stopwords)){
+    stopwords <-
+      data.frame(
+        word = stopwords
+      )
+  }
+
   # Expand dataset to have each word in the subject as a different observation
   text_df <- text_df %>%
     tidytext::unnest_tokens(
diff --git a/R/tm_cooc.R b/R/tm_cooc.R
@@ -18,8 +18,8 @@
 #' `stopwords` argument.
 #'
 #' @param data A Meeting Query dataset in the form of a data frame.
-#' @param stopwords A single-column data frame labelled 'word' containing custom
-#'   stopwords to remove.
+#' @param stopwords A character vector OR a single-column data frame labelled
+#'   `'word'` containing custom stopwords to remove.
 #' @param seed A numeric vector to set seed for random generation.
 #' @param return String specifying what to return. This must be one of the
 #'   following strings:
@@ -63,6 +63,8 @@ tm_cooc <- function(data,
                                        token = "words",
                                        stopwords = stopwords))
 
+
+
   # Calculate frequency of pairs
   title_word_pairs <-
     text_df %>%
diff --git a/R/tm_freq.R b/R/tm_freq.R
@@ -18,8 +18,8 @@
 #' @param data A Meeting Query dataset in the form of a data frame.
 #' @param token A character vector accepting either `"words"` or `"ngram"`,
 #'   determining type of tokenisation to return.
-#' @param stopwords A single-column data frame labelled `'word'` containing
-#'   custom stopwords to remove.
+#' @param stopwords A character vector OR a single-column data frame labelled
+#'   `'word'` containing custom stopwords to remove.
 #' @param keep A numeric vector specifying maximum number of words to keep.
 #' @param return String specifying what to return. This must be one of the
 #'   following strings:
diff --git a/R/tm_wordcloud.R b/R/tm_wordcloud.R
@@ -21,8 +21,8 @@
 #' `stopwords` argument.
 #'
 #' @param data A Meeting Query dataset in the form of a data frame.
-#' @param stopwords A single-column data frame labelled `'word'` containing
-#'   custom stopwords to remove.
+#' @param stopwords A character vector OR a single-column data frame labelled
+#'   `'word'` containing custom stopwords to remove.
 #' @param seed A numeric vector to set seed for random generation.
 #' @param keep A numeric vector specifying maximum number of words to keep.
 #' @param return String specifying what to return. This must be one of the
@@ -44,6 +44,9 @@
 #' @examples
 #' tm_wordcloud(mt_data, keep = 30)
 #'
+#' # Removing stopwords
+#' tm_wordcloud(mt_data, keep = 30, stopwords = c("weekly", "update"))
+#'
 #' @family Text-mining
 #'
 #' @export
@@ -57,7 +60,12 @@ tm_wordcloud <- function(data,
 
   set.seed(seed)
 
-  clean_data <- suppressMessages(tm_clean(data = data, token = "words", stopwords = stopwords))
+  clean_data <-
+    suppressMessages(tm_clean(
+      data = data,
+      token = "words",
+      stopwords = stopwords
+    ))
 
   plot_data <-
     clean_data %>% # Remove additional stop words
diff --git a/R/validation_report.R b/R/validation_report.R
diff --git a/cran-comments.md b/cran-comments.md
diff --git a/man/meeting_tm_report.Rd b/man/meeting_tm_report.Rd
diff --git a/man/subject_scan.Rd b/man/subject_scan.Rd
diff --git a/man/tm_clean.Rd b/man/tm_clean.Rd
diff --git a/man/tm_cooc.Rd b/man/tm_cooc.Rd
diff --git a/man/tm_freq.Rd b/man/tm_freq.Rd
diff --git a/man/tm_wordcloud.Rd b/man/tm_wordcloud.Rd
diff --git a/vignettes/network-analysis.Rmd b/vignettes/network-analysis.Rmd

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,3 @@`
	`1`	`+Version: 1.6.4`
	`2`	`+Date: 2022-01-19 15:26:54 UTC`
	`3`	`+SHA: 3edf7394a94cd59be8b6d83362ab0cfad81c4afa`