VivaRMDReportMarketplace/templates/exp-report/create_expi.R

#' @title Create Employee Experience Index from Person Query grouped by Day
#'
#' @param data Data frame containing a Standard Person Query grouped by Day.
#' @param hrvar String containing the grouping HR variable.
#' @param mingroup Numeric variable specifying the minimum group size.
#'
#' @details
#' Function still under development.
#' Some `data.table` syntax is used to speed up performance when running daily
#' data.
#'
create_expi <- function(data, hrvar, mingroup, return = "standard"){

  # HR lookup ---------------------------------------------------------------

  # For joining later

  hr_df <- data %>% select(PersonId, !!sym(hrvar))

  # Pass string ------------------------------------------------------------
  # Find groups which exceed the minimum group size

  pass_str <-
    data %>%
    group_by(!!sym(hrvar)) %>%
    summarise(n = n_distinct(PersonId)) %>%
    filter(n >= mingroup) %>%
    pull(!!sym(hrvar))

  # Daily metrics -----------------------------------------------------------

  # Get `QuietDays` and `DeepWorkDay` based on Daily Data
  # Convert back to the Weekly level

  daily_metrics <-
    data %>%
    mutate(DayOfWeek = lubridate::wday(Date, label = TRUE)) %>%
    mutate(DateWeek = lubridate::floor_date(Date, unit = "weeks",
                                            week_start = 7) %>%
             as.Date()) %>%

    # QuietDay = at most 2 email or IM sent on the day
    # criterion should change depending whether `IsActive` is on
    mutate(QuietDay = ifelse(Emails_sent <= 2 & Instant_messages_sent <= 2, 1, 0)) %>%

    # DeepWorkDay = Fewer than two meeting hours on the day
    mutate(DeepWorkDay = ifelse(Meeting_hours < 2, 1, 0)) %>%
    group_by(DateWeek, PersonId) %>%
    summarise(
      QuietDays = sum(QuietDay, na.rm = TRUE),
      DeepWorkDay = sum(DeepWorkDay, na.rm = TRUE),
      .groups = "drop"
    )

  # Metrics to sum up by week -----------------------------------------------
  # Sum up each day of a week to the weekly level
  metrics_to_sum <-
    c(
      "Collaboration_hours",
      "Workweek_span",
      "Meeting_hours_with_manager_1_on_1",
      "Meeting_hours_with_manager",
      "Meeting_hours",
      "Meeting_hours_for_3_to_8_attendees",
      "Meeting_hours_for_2_attendees",
      "Meeting_hours_1_on_1_with_same_level",
      "Manager_coaching_hours_1_on_1", # Optional
      "Meeting_hours_with_skip_level",
      "Collaboration_hours_external",
      "Open_2_hour_blocks",
      "Time_in_self_organized_meetings",
      "Meeting_hours_with_manager_with_3_to_8", # New
      "Meeting_hours_with_skip_level_max_8"
    )

  # Metrics summed up by week -----------------------------------------------
  # Grouped by `PersonId` and `DateWeek`

  weekly_metrics <-
    data %>%
    mutate(DateWeek = lubridate::floor_date(Date, unit = "weeks",
                                            week_start = 7) %>%
             as.Date()) %>%
    as.data.table() %>%
    .[, lapply(.SD, sum, na.rm = TRUE),
      by = c("PersonId", "DateWeek"),
      .SDcols = metrics_to_sum]

  # Metrics averaged up by week ---------------------------------------------
  # Only contains `Internal_network_size` - only one that is not sum-mable

  weekly_metrics_mean <-
    data %>%
    mutate(DateWeek = lubridate::floor_date(Date, unit = "weeks",
                                            week_start = 7) %>%
             as.Date()) %>%
    as.data.table() %>%
    .[, lapply(.SD, mean, na.rm = TRUE),
      by = c("PersonId", "DateWeek"),
      .SDcols = c("Internal_network_size")]

  # Metrics to convert to Person level --------------------------------------
  # A character vector of metrics with everything calculated so far

  metrics_to_person <-
    c(metrics_to_sum,
      "Internal_network_size",
      "QuietDays",
      "DeepWorkDay")

  # Convert Person-week level to Person level -------------------------------
  # Join the following data frames:
  #   - daily_metrics
  #   - weekly_metrics
  #   - weekly_metrics_mean


  expi_plevel <-
    daily_metrics %>%
    # Join calculations
    left_join(weekly_metrics, by = c("PersonId", "DateWeek")) %>%
    left_join(weekly_metrics_mean, by = c("PersonId", "DateWeek")) %>%
    as.data.table() %>%

    # Average by `PersonId`
    .[, lapply(.SD, mean, na.rm = TRUE),
      by = "PersonId",
      .SDcols = metrics_to_person]

    #TODO: need to replace this once custom metric is available
    # .[, Meeting_hours_cross_level :=
    #     Meeting_hours_for_2_attendees -
    #     Meeting_hours_with_manager_1_on_1 -
    #     Manager_coaching_hours_1_on_1] %>%
    # .[]


  # Calculate EXPI ----------------------------------------------------------

  expi_interim <-
    expi_plevel %>%
    as_tibble() %>%

    mutate(

      # Wellbeing: Actively Manage Workloads --------------------------------

      EXPI_ActiveManageWorkloads = ifelse(
        Collaboration_hours < 20 & Workweek_span < 45, TRUE, FALSE),


      # Wellbeing: Promote Switching Off ------------------------------------

      EXPI_PromoteSwitchingOff = ifelse(QuietDays > 2, TRUE, FALSE),

      # Empowerment: Support and Coach --------------------------------------

      EXPI_SupportAndCoach = ifelse(
        Meeting_hours_with_manager_1_on_1 * 60 >= 15, TRUE, FALSE),

      # Empowerment: Empower Employees --------------------------------------
      EXPI_EmpowerEmployees = ifelse(
        (Meeting_hours_with_manager / Meeting_hours) < 0.5, TRUE, FALSE
      ),

      # Connection: Enable broad connections --------------------------------
      EXPI_EnableBroadConnections = ifelse(
        Internal_network_size > 20, TRUE, FALSE
      ),

      # Connection: Encourage small group meetings --------------------------
      EXPI_EncourageSmallGroupMeetings = ifelse(
        Meeting_hours_for_3_to_8_attendees > 2, TRUE, FALSE),

      # Connection: Encourage small group meetings w/o manager --------------
      # At least two hours of 3-8 meetings without manager presence
      Temp_EncourageMeetingsWithoutManager = Meeting_hours_for_3_to_8_attendees - Meeting_hours_with_manager_with_3_to_8,

      EXPI_EncourageMeetingsWithoutManager = ifelse(
        Temp_EncourageMeetingsWithoutManager > 2, TRUE, FALSE
      ),

      # Growth: Promote skip-level exposure ---------------------------------
      EXPI_SkipLevelExposure = ifelse(
        Meeting_hours_with_skip_level_max_8 * 60 >= 30,
        TRUE, FALSE
      ),

      # Growth: Facilitate External Connections -----------------------------
      EXPI_ExternalCollaboration = ifelse(
        Collaboration_hours_external *60 >=15,
        TRUE, FALSE
      ),

      # Focus: Make Time Available to Focus ---------------------------------
      EXPI_FocusTime = ifelse(
        Open_2_hour_blocks >= 4, TRUE, FALSE
      ),

      # Focus: Enable Deep Work Days ----------------------------------------
      # At least one day excluding weekends with <2 of meetings
      EXPI_DeepWork = ifelse(
        DeepWorkDay >= 3, TRUE, FALSE
      ),

      # Purpose: Help employees own their time ------------------------------
      EXPI_OwnTime = ifelse(
        (Time_in_self_organized_meetings / Meeting_hours) > .25,
        TRUE, FALSE
      ),

      # Purpose: foster meaningful interactions -----------------------------
      EXPI_MeaningfulInteractions = ifelse(
        Meeting_hours_1_on_1_with_same_level * 60 >= 30,
        TRUE, FALSE
      )
    )

  # Key components ----------------------------------------------------------

  exp_kc <-
    expi_interim %>%
    mutate(EX_KPI_Wellbeing =
             select(.,
                    EXPI_ActiveManageWorkloads,
                    EXPI_PromoteSwitchingOff) %>%
             apply(1, mean, na.rm = TRUE)) %>%
    mutate(EX_KPI_Empowerment =
             select(.,
                    EXPI_SupportAndCoach,
                    EXPI_EmpowerEmployees) %>%
             apply(1, mean, na.rm = TRUE)) %>%
    mutate(EX_KPI_Connection =
             select(.,
                    EXPI_EnableBroadConnections,
                    EXPI_EncourageSmallGroupMeetings,
                    EXPI_EncourageMeetingsWithoutManager) %>%
             apply(1, mean, na.rm = TRUE)) %>%
    mutate(EX_KPI_Growth =
             select(.,
                    EXPI_SkipLevelExposure,
                    EXPI_ExternalCollaboration) %>%
             apply(1, mean, na.rm = TRUE)) %>%
    mutate(EX_KPI_Focus =
             select(.,
                    EXPI_FocusTime,
                    EXPI_DeepWork) %>%
             apply(1, mean, na.rm = TRUE)) %>%
    mutate(EX_KPI_Purpose =
             select(.,
                    EXPI_OwnTime,
                    EXPI_MeaningfulInteractions) %>%
             apply(1, mean, na.rm = TRUE)) %>%

    ## Calculate EXPI
    mutate(EXPI = select(., starts_with("EX_KPI_")) %>%
             apply(1, mean, na.rm = TRUE))

  # Component summary -------------------------------------------------------

  exp_cs <-
    exp_kc %>%
    left_join(
      hr_df,
      by = "PersonId"
    ) %>%
    filter(!!sym(hrvar) %in% pass_str) %>%
    group_by(!!sym(hrvar)) %>%
    summarise(
      across(
        .cols = c(starts_with("EXPI_"), EXPI),
        .fns = ~mean(., na.rm = TRUE)
      )
    )

  # Key component summary ---------------------------------------------------

  exp_kcs <-
    exp_kc %>%
    left_join(
      hr_df,
      by = "PersonId"
    ) %>%
    filter(!!sym(hrvar) %in% pass_str) %>%
    group_by(!!sym(hrvar)) %>%
    summarise(
      across(
        .cols = c(starts_with("EX_KPI_"), EXPI),
        .fns = ~mean(., na.rm = TRUE)
      )
    )

  # Date extract ------------------------------------------------------------

  dat_chr <- extract_date_range(data, return = "text")

  # Return output -----------------------------------------------------------

  if(return == "standard"){

    expi_interim

  } else if(return == "list"){

    list(
      "standard" = expi_interim,
      "kc" = exp_kc, # key component
      "cs" = exp_cs, # component summary
      "kcs" = exp_kcs, # key component summary
      "date" = dat_chr # date string
    )
  }


}