knitr::opts_chunk$set(warning = FALSE, message = FALSE)
library(tidyverse)
library(vivainsights)
library(lubridate)

Collaboration by Time of Day

Introduction

A common question is: “what time does the typical person start and end their working day, and how does that differ by team, region, or role?” Viva Insights exposes hourly collaboration by time of day metrics, which count the emails and chats sent and the fractions of the hour spent in meetings and unscheduled calls for each hour of the day, and these let us answer it.

This document shows how to turn those hourly buckets into a typical start and end of day, using the same definition of an “active hour” as the Microsoft product: an hour is active if any of chats sent, emails sent, meetings, or unscheduled calls is greater than zero.

The package’s sample datasets do not include the hourly “by time of day” columns, so we simulate a person-by-day dataset with those columns, named as an import_query() of a Person or Daily query would name them. To run on your own data, select the Emails sent, Chats sent, Meetings, and Unscheduled calls time-of-day metrics in a Person or Daily query, import it, and replace the simulate_time_of_day() call below, and the downstream code is unchanged.

Simulate a person-by-day dataset

Each person has a latent start and end of day (managers end later); activity is generated per hour, denser inside working hours and sparse outside them.

simulate_time_of_day <- function(n_person = 200, n_days = 20, seed = 7) {
  set.seed(seed)
  persons    <- sprintf("P%03d", seq_len(n_person) - 1)
  is_manager <- runif(n_person) < 0.25
  start_true <- pmin(pmax(rnorm(n_person, 8.5, 0.7), 6), 10)
  end_true   <- pmin(pmax(rnorm(n_person, 18.0, 1.0) + is_manager * 1.0, 15), 22)

  # One row per person-day (weekdays only)
  all_dates <- seq(as.Date("2024-01-01"), by = "day", length.out = 40)
  dates     <- all_dates[!(lubridate::wday(all_dates) %in% c(1, 7))][seq_len(n_days)]

  grid <- expand.grid(PersonId = persons, MetricDate = dates,
                      stringsAsFactors = FALSE)
  m   <- nrow(grid)
  pos <- match(grid$PersonId, persons)

  # m x 24 hour grid; comparison recycles the length-m person vectors down columns
  hours   <- matrix(0:23, nrow = m, ncol = 24, byrow = TRUE)
  in_work <- (hours >= start_true[pos]) & (hours < end_true[pos])
  active  <- matrix(runif(m * 24), nrow = m) < ifelse(in_work, 0.85, 0.02)

  out <- grid
  for (h in 0:23) {
    a   <- active[, h + 1]
    col <- sprintf("%02d_%02d", h, h + 1)
    out[[paste0("Chats_sent_", col)]]        <- a * rpois(m, 1.0)
    out[[paste0("Emails_sent_", col)]]       <- a * rpois(m, 0.6)
    out[[paste0("Meetings_", col)]]          <- a * runif(m) * 0.5   # fraction of hour
    out[[paste0("Unscheduled_calls_", col)]] <- a * (runif(m) < 0.1) * runif(m)
  }
  out$IsManager <- is_manager[pos]
  tibble::as_tibble(out)
}

# On your own data, replace this with vivainsights::import_query("your_query.csv").
df <- simulate_time_of_day()
dim(df)
## [1] 4000   99

Build the activity matrix and find first / last active hour

An hour is active if any of the four metrics is greater than zero in that bucket. We use a fast vectorised approach: build a logical matrix of active hours, then use max.col() to locate the first and last active hour in each row.

METRICS <- c("Chats_sent", "Emails_sent", "Meetings", "Unscheduled_calls")
hour_columns <- function(prefix) sprintf("%s_%02d_%02d", prefix, 0:23, 1:24)

active_matrix <- matrix(FALSE, nrow = nrow(df), ncol = 24)
for (metric in METRICS) {
  active_matrix <- active_matrix | (as.matrix(df[hour_columns(metric)]) > 0)
}

has_any  <- rowSums(active_matrix) > 0
first_hr <- max.col(active_matrix, ties.method = "first") - 1L
last_hr  <- 24L - max.col(active_matrix[, 24:1, drop = FALSE], ties.method = "first")

# Start = bucket start hour; End = bucket end hour (+1). Drop days with no activity.
day_level <- df %>%
  transmute(PersonId, MetricDate, IsManager,
            start = ifelse(has_any, first_hr, NA_real_),
            end   = ifelse(has_any, last_hr + 1, NA_real_)) %>%
  drop_na(start, end)

head(day_level)
## # A tibble: 6 × 5
##   PersonId MetricDate IsManager start   end
##   <chr>    <date>     <lgl>     <int> <dbl>
## 1 P000     2024-01-01 FALSE         9    19
## 2 P001     2024-01-01 FALSE         9    18
## 3 P002     2024-01-01 TRUE          9    20
## 4 P003     2024-01-01 TRUE          6    23
## 5 P004     2024-01-01 TRUE          9    19
## 6 P005     2024-01-01 FALSE         9    16

A typical start and end of day

We aggregate in two stages: each person’s median across their days, then the mean across people. This picks up sub-hour shifts a single pooled median would miss, while staying robust to a few unusual days per person. We format decimal hours as HH:MM.

hhmm <- function(x) {
  ifelse(is.na(x), NA_character_,
         sprintf("%02d:%02d", floor(x), round((x - floor(x)) * 60)))
}

person_med <- day_level %>%
  group_by(PersonId) %>%
  summarise(start = median(start), end = median(end), .groups = "drop")

typical <- person_med %>% summarise(start = mean(start), end = mean(end))
pooled  <- day_level  %>% summarise(start = median(start), end = median(end))

tibble(
  measure = c("Typical (two-stage)", "Pooled median (check)"),
  start   = c(hhmm(typical$start), hhmm(pooled$start)),
  end     = c(hhmm(typical$end),   hhmm(pooled$end))
)
## # A tibble: 2 × 3
##   measure               start end
##   <chr>                 <chr> <chr>
## 1 Typical (two-stage)   09:02 18:41
## 2 Pooled median (check) 09:00 19:00

Cuts by day of week and by role

# Derive weekday numerically then map to labels (label = TRUE is unreliable on
# some platforms).
day_level <- day_level %>%
  mutate(weekday = factor(lubridate::wday(MetricDate, week_start = 1),
                          levels = 1:7,
                          labels = c("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun")))

two_stage_by <- function(data, group_cols) {
  data %>%
    group_by(across(all_of(c("PersonId", group_cols)))) %>%
    summarise(start = median(start), end = median(end), .groups = "drop") %>%
    group_by(across(all_of(group_cols))) %>%
    summarise(start = mean(start), end = mean(end), .groups = "drop") %>%
    mutate(start = hhmm(start), end = hhmm(end))
}

two_stage_by(day_level, "weekday")
## # A tibble: 5 × 3
##   weekday start end
##   <fct>   <chr> <chr>
## 1 Mon     08:49 18:41
## 2 Tue     08:50 18:45
## 3 Wed     08:49 18:42
## 4 Thu     08:39 18:41
## 5 Fri     08:50 18:43
two_stage_by(day_level, "IsManager") %>%
  mutate(role = ifelse(IsManager, "Manager", "Non-manager")) %>%
  select(role, start, end)
## # A tibble: 2 × 3
##   role        start end
##   <chr>       <chr> <chr>
## 1 Non-manager 09:03 18:29
## 2 Manager     08:57 19:29

Notes

  • The two-stage (person-median then mean-across-people) metric picks up sub-hour shifts that a single pooled median would miss, while staying robust to a few unusual days per person.
  • Days with no recorded activity are excluded rather than counted as a 00:00 start, which would badly bias the result.
  • On real data, be careful about the timezone basis of the hourly buckets for a globally distributed population, and compare within a region where possible.