This commit is contained in:
Martin Chan 2021-09-01 13:20:02 +01:00
Родитель 29c485167c
Коммит 6ca6d866cd
7 изменённых файлов: 1275 добавлений и 0 удалений

Просмотреть файл

@ -0,0 +1,45 @@
# Employee Experience RMarkdown Report Template
## Parameters
The following parameters describe the arguments that will be passed to within the report function.
- `data`: the input must be a data frame with the columns as a Standard Person Query, which is built using the `sq_data` inbuilt into the 'wpa' package.
- `report_title`: string containing the title of the report, which will be passed to `set_title` within the RMarkdown template.
- `hrvar`: string specifying the HR attribute that will be passed into the single plot.
- `mingroup`: numeric value specifying the minimum group size to filter the data by.
## Report Type
This is a **flexdashboard** RMarkdown report.
The standard YAML header would be as follows:
```
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: fill
```
## Report output
This report contains one single plot and a print out of the data diagnostics.
## Data preparation
No data preparation is required as long as it is a Standard Person Query.
## Examples
For an example of the report output, see `minimal report.html`.
To run this report, you may run:
```R
generate_report2(
output_format = rmarkdown::html_document(toc = TRUE, toc_depth = 6, theme = "cosmo"),
output_file = "minimal report.html",
output_dir = here("minimal-example"), # path for output
report_title = "Minimal Report",
rmd_dir = here("minimal-example", "minimal.Rmd"), # path to RMarkdown file,
# Custom arguments to pass to `minimal-example/minimal.Rmd`
data = sq_data,
hrvar = "Organization",
mingroup = 5
)
```

Просмотреть файл

@ -0,0 +1,30 @@
#### Wellbeing
- **Actively Manage Workloads**: % of employees with weekly collaboration under 20 hours and work week span under 45 hours
- **Promote Switching Off**: % of employees with 2+ quiet days a week (maximum 2 of emails and IMs sent)
#### Empowerment
- **Support and Coach**: % of employees with > 15 minute a week of 1:1 meetings with manager (on average)
- **Empower Employees**: % of employees with < 50% manager co-attendance
#### Connection
- **Enable broad connections**: % of employees with an internal network size of over 20
- **Encourage small-group meetings**: % of employees with at least >2 hour of meetings with 3-8 attendees per week
- **Encourage small-group meetings without manager**: % of employees with at least >2 hour of meetings with 3-8 attendees per week without manager co-attendance
#### Growth
- **Promote skip-level exposure**: % of employees with >30 mins of skip-level meeting hours with maximum 8 attendees
- **Facilitate external connections**: % of employees with at least 15 minutes of external collaboration per week
#### Focus
- **Make time available to focus**: % of employees with at least 4 focus 2-hour blocks per week
- **Enable 'Deep Work' Days**: % of employees with at least 1 day of <2 hour of meetings excluding weekends
#### Purpose
- **Help employees own their time**: % of employees with 25%+ of collaboration time in self-organized meetings
- **Foster meaningful interactions**: % of employees with at least 30 minutes of 1:1 meetings with peers a week ona verage (excluding line manager 1:1 time and 1:1 coaching time)

Просмотреть файл

@ -0,0 +1,301 @@
#' @title Create Employee Experience Index from Person Query grouped by Day
#'
#' @param data Data frame containing a Standard Person Query grouped by Day.
#'
#' @details
#' Function still under development.
#' Some `data.table` syntax is used to speed up performance when running daily
#' data.
#'
create_expi <- function(data, hrvar, return = "standard"){
# HR lookup ---------------------------------------------------------------
# For joining later
hr_df <- data %>% select(PersonId, !!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"
) %>%
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"
) %>%
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
)
}
}

Просмотреть файл

@ -0,0 +1,24 @@
**Why is Employee Experience important?**
A positive employee experience is strongly related to company outcomes, predictive of lower turnover and foundational to a strong company culture. Research has shown that companies in the top 25% on employee experience report 3x the return on assets and there was lower turnover within teams that were scoring in the top 25% on employee experience within the company. A positive employee experience can be broken down into 6 core pillars:
1. **Wellbeing**: You feel uniquely valued, your personal time is respected and are treated with dignity.
2. **Empowerment**:You are empowered to make decisions about how to best direct your talent and effort with the support of your manager.
3. **Connection**: You belong as a trusted, integral member of a diverse community. You have high-quality relationships with your colleagues.
4. **Growth**: You get what you need to maximize your strengths, learn new skills and broaden your exposure.
5. **Focus**:You know what success looks like, what to prioritize and the time to work towards those goals.
6. And finally **purpose**: Your work serves a bigger role and you are able to have meaningful impact. You can control your diaries and foster close relationships.
Use Workplace Analytics metrics to quantify behaviours for each of the 6 employee experience pillars. Find areas of opportunities and growth across the organisation to implement targeted interventions.
**Read More**
Read more about how employee experience impacts businesses.
[How Employee Engagement Drives Growth (gallup.com)](https://www.gallup.com/workplace/236927/employee-engagement-drives-growth.aspx)
[The financial impact of a positive employee experience](https://www.ibm.com/downloads/cas/XEY1K26O#:~:text=The Financial Impact of a Positive Employee Experience,to recharge and work more flexibly%2C they can)
[Why the millions we spend on employee engagement buy us so little](https://hbr.org/2017/03/why-the-millions-we-spend-on-employee-engagement-buy-us-so-little)

Просмотреть файл

@ -0,0 +1,523 @@
---
params:
data: data
set_title: report_title
hrvar: hrvar
mingroup: mingroup
title: "Org Insights | Employee Experience Report"
# output:
# flexdashboard::flex_dashboard:
# orientation: rows
# vertical_layout: fill
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(
echo = FALSE,
fig.height = 9,
fig.width = 16,
message = FALSE,
warning = FALSE
)
```
<style>
.navbar {
background-color: rgb(47,85,151);
}
h1, h2, h3, h4, h5, h6, .h1, .h2, .h3, .h4, .h5, .h6 {
font-family: Arial;
font-weight: 300;
line-height: 1.1;
color: inherit;
}
body {
font-family: Arial;
font-size: 12px;
line-height: 1.42857143;
color: #333333;
background-color: #FFFFFF;
}
</style>
```{js, echo=FALSE}
var scale = 'scale(1)';
document.body.style.webkitTransform = scale; // Chrome, Opera, Safari
document.body.style.msTransform = scale; // IE 9
document.body.style.transform = scale; // General
```
Introduction
=====================================
```{r message=FALSE, warning=FALSE, include=FALSE}
start_time <- Sys.time() # timestamp
library(tidyverse)
library(wpa)
library(data.table)
library(flexdashboard)
expi_df <- params$data # Employee Experience Custom Query
source("create_expi.R")
source("vis_exp.R")
expi_list <-
expi_df %>%
rename(Meeting_hours_for_3_to_8_attendees = "Meeting_hours_3_to_8",
Meeting_hours_for_2_attendees = "Meeting_hours_1_on_1"
) %>%
totals_bind(target_col = "full_name_4") %>% # Add Total
create_expi(hrvar = "full_name_4", return = "list")
expi_out <- expi_list[["standard"]] # component
expi_out_2 <- expi_list[["kc"]] # key component
# component summary
short_tb <- expi_list[["cs"]] %>% totals_reorder(target_col = "full_name_4")
# key component summary
long_tb <- expi_list[["kcs"]] %>% totals_reorder(target_col = "full_name_4")
# summary table
sum_tb <-
long_tb %>%
filter(full_name_4 == "Total") %>%
select(-EXPI) %>%
pivot_longer(cols = starts_with("EX_KPI_"),
names_to = "EXP",
values_to = "values") %>%
mutate(EXP = gsub(pattern = "EX_KPI_", replacement = "", x = EXP)) %>%
mutate(EXP = factor(EXP,
levels = c("Wellbeing",
"Empowerment",
"Connection",
"Growth",
"Focus",
"Purpose")
))
create_gauge <- function(filt){
gauge(
value = round(sum_tb$values[sum_tb$EXP == filt] * 100),
min = 0,
max = 100,
symbol = '%',
label = filt,
gaugeSectors(
success = c(80, 100),
warning = c(40, 79),
danger = c(0, 39)
))
}
```
### jumbotron {.no-title}
```{r results='asis'}
xfun::file_string("jumbotron.html")
```
Overview {data-orientation=rows}
=====================================
Row
-------------------------------------
### Total
```{r}
gauge(
value =
long_tb %>%
filter(full_name_4 == "Total") %>%
mutate(EXPI = round(EXPI * 100)) %>%
pull(EXPI),
min = 0,
max = 100,
symbol = '%',
label = "EXP Baseline",
gaugeSectors(
success = c(80, 100),
warning = c(40, 79),
danger = c(0, 39)
))
```
Row
-------------------------------------
### Wellbeing
```{r}
create_gauge(filt = "Wellbeing")
```
### Empowerment
```{r}
create_gauge(filt = "Empowerment")
```
### Connection
```{r}
create_gauge(filt = "Connection")
```
Row
-------------------------------------
### Growth
```{r}
create_gauge(filt = "Growth")
```
### Focus
```{r}
create_gauge(filt = "Focus")
```
### Purpose
```{r}
create_gauge(filt = "Purpose")
```
Column {.sidebar data-width=300}
-------------------------------------
### Definitions
```{r}
preamble_md <- readLines("exp_preamble.md",
encoding = "UTF-8")
wpa:::md2html(preamble_md)
```
Baseline
=====================================
Row {data-height=5%}
-------------------------------------
### Title-Placeholder {.no-title}
```{r results = 'asis'}
wpa:::md2html("## Which teams could use further support to improve overall employee experience?")
```
Row {data-height=95%}
-------------------------------------
### Baseline
```{r echo=FALSE}
long_tb %>%
select(-EXPI) %>%
pivot_longer(cols = starts_with("EX_KPI_"),
names_to = "EXP",
values_to = "values") %>%
mutate(EXP = gsub(pattern = "EX_KPI_", replacement = "", x = EXP)) %>%
mutate(EXP = factor(EXP,
levels = c("Wellbeing",
"Empowerment",
"Connection",
"Growth",
"Focus",
"Purpose")
)) %>%
ggplot(aes(x = EXP,
y = full_name_4,
fill = values)) +
geom_tile(colour = "#FFFFFF",
size = 2) +
geom_text(aes(label = scales::percent(values, accuracy = 1)),
size = 3) +
# Fill is contingent on max-min scaling
scale_fill_gradient2(low = rgb2hex(204, 50, 50),
mid = rgb2hex(231, 180, 22),
high = rgb2hex(45, 201, 55),
midpoint = 0.5,
breaks = c(0, 0.5, 1),
labels = c("Low", "", "High"),
limits = c(0, 1)) +
scale_x_discrete(position = "top") +
scale_y_discrete(labels = us_to_space) +
facet_grid(. ~ EXP,
scales = "free") +
theme_wpa_basic() +
theme(axis.line = element_line(color = "#FFFFFF")) +
labs(title = "Employee Experience",
subtitle = "Baseline by `full_name_4`",
y =" ",
x =" ",
fill = " ",
caption = extract_date_range(expi_df, return = "text")) +
theme(axis.text.x = element_blank(), # already covered by facet
plot.title = element_text(color="grey40", face="bold", size=20))
# long_tb %>%
# create_bar_asis(
# group_var = "full_name_4",
# bar_var = "EXPI",
# title = "Employee Experience Baseline",
# subtitle = "Aggregated",
# caption = extract_date_range(expi_df, return = "text"),
# bar_colour = "darkblue",
# percent = TRUE)
```
Column {.sidebar data-width=300}
-------------------------------------
### Definitions
```{r}
intro_md <- readLines("components.md")
wpa:::md2html(intro_md)
```
KPIs
=====================================
Row {data-height=5%}
-------------------------------------
### Title-Placeholder {.no-title}
```{r results = 'asis'}
wpa:::md2html("## Which underlying behaviours are impacting the employee experience pillar scores?")
```
Row {data-height=95%}
-------------------------------------
### KPIs
```{r echo=FALSE, message=FALSE, warning=FALSE}
## reg matching nth occurrence
# a <- "1, 2, 3, 4, 5, 6, 7, 8, 9, 10"
# fn <- ","
# rp <- "\n"
# n <- 4
replN <- function(x, fn, rp, n) {
regmatches(x, gregexpr(fn, x)) <- list(c(rep(fn,n-1),rp))
x
}
# replN(a, ",", "\n", 4)
#[1] "1, 2, 3, 4\n 5, 6, 7, 8\n 9, 10
short_tb %>%
select(-EXPI) %>%
pivot_longer(cols = starts_with("EXPI_"),
names_to = "EXP",
values_to = "values") %>%
order_exp() %>%
add_component() %>%
mutate(EXP = gsub(pattern = "EXPI_", replacement = "", x = EXP)) %>%
mutate(EXP = camel_clean(EXP)) %>%
mutate(EXP = replN(x = EXP, fn = " ", rp = "\n", n = 2)) %>%
# mutate(EXP = gsub(pattern = " ", replacement = "\n", x = EXP)) %>%
ggplot(aes(x = EXP,
y = full_name_4,
fill = values)) +
geom_tile(colour = "#FFFFFF",
size = 2) +
geom_text(aes(label = scales::percent(values, accuracy = 1)),
size = 3) +
# Fill is contingent on max-min scaling
scale_fill_gradient2(low = rgb2hex(204, 50, 50),
mid = rgb2hex(231, 180, 22),
high = rgb2hex(45, 201, 55),
midpoint = 0.5,
breaks = c(0, 0.5, 1),
labels = c("Low", "", "High"),
limits = c(0, 1)) +
scale_x_discrete(position = "top") +
scale_y_discrete(labels = us_to_space) +
facet_grid(. ~ Component,
scales = "free") +
theme_wpa_basic() +
theme(axis.line = element_line(color = "#FFFFFF")) +
labs(
title = "Employee Experience",
subtitle = "KPIs by `full_name_4`",
y = " ",
x = " ",
fill = " ",
caption = extract_date_range(expi_df, return = "text")
) +
theme(
axis.text = element_text(size = 8),
axis.text.x = element_text(angle = 60, hjust = 0),
plot.title = element_text(color="grey40", face="bold", size=20)
)
```
Column {.sidebar data-width=300}
-------------------------------------
### Definitions
```{r}
wpa:::md2html(intro_md)
```
Opportunities
=====================================
Row {data-height=5%}
-------------------------------------
### Title-Placeholder {.no-title}
```{r results = 'asis'}
wpa:::md2html("## What are the behavioural opportunities for growth within each team?")
```
Row {data-height=95%}
-------------------------------------
### Opportunities
```{r echo=FALSE, message=FALSE, warning=FALSE}
vis_list <- vis_exp(x = expi_list, hrvar = "full_name_4")
vis_list[["plot_1"]]
```
Column {.sidebar data-width=300}
-------------------------------------
### Definitions
```{r}
wpa:::md2html(intro_md)
```
Distribution
=====================================
Row {data-height=5%}
-------------------------------------
### Title-Placeholder {.no-title}
```{r results = 'asis'}
wpa:::md2html("## Are employees within individual teams sharing a broadly uniform experience?")
```
Row {data-height=95%}
-------------------------------------
### Distribution
```{r echo=FALSE, message=FALSE, warning=FALSE}
vis_list[["plot_2"]]
```
Column {.sidebar data-width=300}
-------------------------------------
### Definitions
```{r}
wpa:::md2html(intro_md)
```
Notes
=====================================
Column {data-height=650} {.tabset}
-------------------------------------
### Query Spec
#### Specifications
Run a single daily person query:
- Group by `Day`
- At least 3 months
- Ensure that `IsActive` flag is not applied
#### All metrics
**Note**: _Custom metrics shown in **bolded italics**_
1. **_Meeting hours 1 on 1_** [SEE SPEC BELOW]
1. **_Meeting hours 1 on 1 with same level_** [SEE SPEC BELOW]
1. Time in self organized meetings
1. Open 2 hour blocks
1. Collaboration hours external
1. Meetings with skip level
1. Meeting hours with skip level
1. ***Meeting hours 3 to 8*** [SEE SPEC BELOW]
1. Internal network size
1. Meeting hours with manager
1. Meeting hours
1. Meetings
1. Meetings with manager
1. Meeting hours with manager 1 on 1
1. Instant messages sent
1. Emails sent
1. Workweek span
1. Collaboration hours
1. ***Meeting hours with skip level max 8*** [SEE SPEC BELOW]
1. ***Meeting hours with manager with 3 to 8*** [SEE SPEC BELOW]
#### Custom metrics
1. Meeting Hours 1 on 1: where `Total attendees == 2`
1. Meeting Hours 1 on 1 with same level: `All attendee's and/or recipient's` where `LevelDesignation == @RelativeToPerson` AND `Total attendees == 2`
1. Meeting hours 3 to 8: `Total attendees >= 3` AND `Total attendees <= 8`
1. Meeting hours with skip level max 8: `Total attendees <= 8`, using `Meeting hours with skip level`.
1. Meeting hours with manager 3 to 8: `Total attendees >= 3` AND `Total attendees <= 8`, using `Meeting hours with manager`. This is used to calculate **small group meetings without manager** by deducting this from `Meeting hours for 3 to 8 attendees`.
### Table - 1
```{r echo=FALSE}
long_tb %>%
set_names(nm = gsub(pattern = "EX_KPI_", replacement = "", x = names(.))) %>%
create_dt(rounding = 2)
```
### Table - 2
```{r echo=FALSE}
short_tb %>%
set_names(nm = gsub(pattern = "EXPI_", replacement = "", x = names(.))) %>%
create_dt(rounding = 2)
```
### Notes
```{r}
end_time <- Sys.time()
text1 <- paste("This report was generated on ", format(Sys.time(), "%b %d %Y"), ".")
text2 <- expi_df %>% check_query(return = "text", validation = TRUE)
text3 <- paste("Total Runtime was: ", difftime(end_time, start_time, units = "mins") %>%
round(2), "minutes.")
paste(text1, text2, text3, sep = "\n\n" )%>% wpa:::md2html()
```

Просмотреть файл

@ -0,0 +1,31 @@
<div class="jumbotron" style="background-color:#FFFFFF;">
<!--<img src="Microsoft-Viva-Insights-logo.png" style="float:right;width:180px;height:180px;">-->
<h1 class="display-4">Employee Experience Report</h1>
<p class="lead" style="color:gray;"> <B> Microsoft Viva | Organisational Insights </B></p>
<hr class="my-4">
<p> <font size="+1"> <em> Based on decades of quantitative and qualitative research, and our own experience working with global customers and here within Microsoft, we have identified six key elements to a great employee experience. These elements are Strongly related to company outcomes, are predictive of lower turnover and are the foundations to a strong corporate culture. </em> </font></p>
<br>
<p><font size="+0">This is a framework for evaluating Employee Experience. The main components of the baseline are as follows:</font></p>
<div class="row">
<div class="col-md-6"><!-- first column -->
<div class="list-group">
<a href="#overview" class="list-group-item"><font size="+1">1. Overview</font></a>
<a href="#baseline" class="list-group-item"><font size="+1">2. Baseline</font></a>
<a href="#kpis" class="list-group-item"><font size="+1">3. KPIs</font></a>
</div><!-- list-group -->
</div><!-- end col-md-6 -->
<div class="col-md-6"><!-- second column -->
<div class="list-group">
<a href="#opportunities" class="list-group-item"><font size="+1">4. Opportunities</font></a>
<a href="#distribution" class="list-group-item"><font size="+1">5. Distribution</font></a>
<a href="#notes" class="list-group-item"><font size="+1">6. Notes</font></a>
</div><!-- list-group -->
</div><!-- end col-md-6 -->
</div><!-- row -->
<p class="lead">
<a class="btn btn-primary btn-lg" href="#overview" role="button">Start exploring</a>
</p>
</div>
<br>

Просмотреть файл

@ -0,0 +1,321 @@
#' @param x List of outputs from `create_expi()`.
vis_exp <- function(x,
hrvar){
# Long format data frame -----------------------------------------------
long_data <-
x[["cs"]] %>% # component summary
select(-EXPI) %>% # Drop
pivot_longer(cols = starts_with("EXPI_"),
names_to = "EXP",
values_to = "values")
# Data frame with only EXPI and HR attributes ---------------------------
expi_results <-
x[["kcs"]] %>%
select(!!sym(hrvar), EXPI)
# Data frame with rect specifications -----------------------------------
bar_data_1 <-
long_data %>%
group_by(!!sym(hrvar)) %>%
summarise(
x_max = max(values, na.rm = TRUE),
x_min = min(values, na.rm = TRUE),
med = median(values, na.rm = TRUE)
) %>%
mutate(
id = 1:nrow(.),
y_min = id - 0.4,
y_max = id + 0.4
) %>%
left_join(expi_results, by = hrvar)
## grouped by EXP
## no EXPI joined up
bar_data_2 <-
long_data %>%
group_by(EXP) %>%
summarise(
x_max = max(values, na.rm = TRUE),
x_min = min(values, na.rm = TRUE),
med = median(values, na.rm = TRUE)
) %>%
order_exp() %>%
mutate(
id = 1:nrow(.),
y_min = id - 0.4,
y_max = id + 0.4
)
## Clean names
bar_data_2b <-
bar_data_2 %>%
add_component() %>%
clean_exp() # %>%
# mutate(EXP = paste(Component, "-", EXP))
# Long table joined up with rect specifications ------------------------
pre_plot_df_1 <-
long_data %>%
left_join(bar_data_1, by = "full_name_4") %>%
add_component() %>%
mutate(EXP = gsub(pattern = "EXPI_", replacement = "", x = EXP),
EXP = camel_clean(EXP)
) %>%
group_by(full_name_4) %>%
mutate(text = case_when(
values == max(values) ~ "top",
values == min(values) ~ "bottom",
TRUE ~ ""))
pre_plot_df_2 <-
long_data %>%
left_join(bar_data_2, by = "EXP") %>%
add_component()
# Segments ------------------------------------------------------------
segment_df_1 <-
pre_plot_df_1 %>%
group_by(id) %>%
summarise(
x_med = first(EXPI),
y_min = first(y_min),
y_max = first(y_max)
)
segment_df_2 <-
pre_plot_df_2 %>%
group_by(id) %>%
summarise(
seg_x_med = first(med),
seg_y_min = first(y_min),
seg_y_max = first(y_max)
)
pre_plot_df_2 <-
pre_plot_df_2 %>%
left_join(
segment_df_2,
by = "id"
)
# Generate plot -------------------------------------------------------
plot_1 <-
pre_plot_df_1 %>%
ggplot(aes(x = values, y = id)) +
geom_rect(
aes(
xmin = x_min,
xmax = x_max,
ymin = y_min,
ymax = y_max
),
fill = "#D9E7F7"
) +
geom_segment(
data = segment_df_1,
aes(x = x_med,
xend = x_med,
y = y_min,
yend = y_max
),
colour = "red",
size = 0.5) +
scale_y_continuous(
breaks = unique(bar_data_1$id),
labels = unique(bar_data_1[["full_name_4"]])
) +
geom_jitter(
aes(colour = Component),
alpha = 0.5,
width = 0,
height = 0.2,
size = 1) +
ggrepel::geom_text_repel(
aes(
label = ifelse(text %in% c("bottom"), EXP, "")), # only label bottom
size = 3) +
scale_x_continuous(
limits = c(0, 1),
breaks = c(0, 0.25, 0.5, 0.75, 1),
labels = scales::percent,
position = "top"
) +
theme_wpa_basic() +
theme(
axis.line = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_line(color = "gray"),
strip.placement = "outside",
strip.background = element_blank(),
strip.text = element_blank()
) +
# geom_vline(xintercept = mean(plot_data_new$values), colour = "red") +
labs(
title = "Employee Experience",
subtitle = paste("Opportunities by", hrvar),
caption = paste("Red line indicates EXP Index.",
x[["date"]]),
y = "",
x = ""
)
# Plot 2 ---------------------------------------------------------------
plot_2 <-
pre_plot_df_2 %>%
mutate(Component = factor(Component,
levels = c("Wellbeing",
"Empowerment",
"Connection",
"Growth",
"Focus",
"Purpose")
)) %>%
ggplot(aes(x = values, y = id)) +
geom_rect(
aes(
xmin = x_min,
xmax = x_max,
ymin = y_min,
ymax = y_max
),
fill = "#D9E7F7"
) +
geom_segment(
aes(
x = seg_x_med,
xend = seg_x_med,
y = seg_y_min,
yend = seg_y_max
),
colour = "red",
size = 0.5) +
geom_jitter(
aes(colour = !!sym(hrvar)),
alpha = 0.5,
width = 0,
height = 0.2,
size = 2) +
scale_y_continuous(
breaks = unique(bar_data_2b$id),
labels = unique(bar_data_2b[["EXP"]])
) +
theme_wpa_basic() +
theme(
axis.line = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_line(color = "gray"),
strip.background = element_rect(
fill = "grey60",
colour = "grey60"
),
strip.placement = "outside",
strip.text = element_text(
size = 8,
colour = "#FFFFFF",
face = "plain")
) +
scale_x_continuous(
limits = c(0, 1),
breaks = c(0, 0.25, 0.5, 0.75, 1),
labels = scales::percent,
position = "top"
) +
facet_grid(
Component ~ .,
scales = "free",
switch = "y"
) +
labs(
title = "Employee Experience",
subtitle = paste("Distribution by", hrvar),
caption = x[["date"]],
y = "",
x = ""
)
# Return results --------------------------------------------------------
list(
"long_data" = long_data,
"plot_1" = plot_1,
"plot_2" = plot_2,
"pre_plot" = pre_plot_df_2,
"bar_data" = bar_data_2b,
"segment" = segment_df_2
)
}
#' Order components
order_exp <- function(x){
x %>%
mutate(EXP = factor(
EXP,
levels = c(
"EXPI_ActiveManageWorkloads",
"EXPI_PromoteSwitchingOff",
"EXPI_SupportAndCoach",
"EXPI_EmpowerEmployees",
"EXPI_EnableBroadConnections",
"EXPI_EncourageSmallGroupMeetings",
"EXPI_EncourageMeetingsWithoutManager",
"EXPI_SkipLevelExposure",
"EXPI_ExternalCollaboration",
"EXPI_FocusTime",
"EXPI_DeepWork",
"EXPI_OwnTime",
"EXPI_MeaningfulInteractions"
)
)) %>%
arrange(desc(EXP)) %>%
mutate(EXP = as.character(EXP))
}
#' Clean EXP
clean_exp <- function(x){
x %>%
mutate(EXP = gsub(pattern = "EXPI_", replacement = "", x = EXP),
EXP = camel_clean(EXP)
)
}
#' Add Key Component
add_component <- function(x){
x %>%
mutate(Component = case_when(
EXP == "EXPI_ActiveManageWorkloads" ~ "Wellbeing",
EXP == "EXPI_DeepWork" ~ "Focus",
EXP == "EXPI_EmpowerEmployees" ~ "Empowerment",
EXP == "EXPI_EnableBroadConnections" ~ "Connection",
EXP == "EXPI_EncourageSmallGroupMeetings" ~ "Connection",
EXP == "EXPI_ExternalCollaboration" ~ "Growth",
EXP == "EXPI_FocusTime" ~ "Focus",
EXP == "EXPI_MeaningfulInteractions" ~ "Purpose",
EXP == "EXPI_OwnTime" ~ "Purpose",
EXP == "EXPI_PromoteSwitchingOff" ~ "Wellbeing",
EXP == "EXPI_SkipLevelExposure" ~ "Growth",
EXP == "EXPI_EncourageMeetingsWithoutManager" ~ "Connection",
EXP == "EXPI_SupportAndCoach" ~ "Empowerment",
)) %>%
mutate(Component = factor(Component,
levels = c("Wellbeing",
"Empowerment",
"Connection",
"Growth",
"Focus",
"Purpose")
))
}