зеркало из https://github.com/microsoft/wpa.git
chore: Streamline standard analysis code
- Fixes particularly to fizz and rank functions and ensure `@inheritParams` is used to use documentation dependency
This commit is contained in:
Родитель
0ffbf5fedc
Коммит
e46dd93e83
|
@ -4,8 +4,8 @@ export("%>%")
|
|||
export(IV_by_period)
|
||||
export(IV_report)
|
||||
export(afterhours_dist)
|
||||
export(afterhours_distribution)
|
||||
export(afterhours_fizz)
|
||||
export(afterhours_line)
|
||||
export(afterhours_rank)
|
||||
export(afterhours_sum)
|
||||
export(afterhours_summary)
|
||||
|
@ -118,9 +118,9 @@ export(track_HR_change)
|
|||
export(tstamp)
|
||||
export(validation_report)
|
||||
export(workloads_dist)
|
||||
export(workloads_distribution)
|
||||
export(workloads_fizz)
|
||||
export(workloads_line)
|
||||
export(workloads_rank)
|
||||
export(workloads_summary)
|
||||
export(workloads_trend)
|
||||
export(workpatterns_area)
|
||||
|
|
|
@ -7,6 +7,7 @@
|
|||
#'
|
||||
#' @details
|
||||
#' Uses the metric \code{After_hours_collaboration_hours}.
|
||||
#' See `create_dist()` for applying the same analysis to a different metric.
|
||||
#'
|
||||
#' @param data A Standard Person Query dataset in the form of a data frame.
|
||||
#' @param hrvar HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"
|
||||
|
@ -58,7 +59,3 @@ afterhours_dist <- function(data,
|
|||
|
||||
|
||||
}
|
||||
|
||||
#' @rdname afterhours_dist
|
||||
#' @export
|
||||
afterhours_distribution <- afterhours_dist
|
||||
|
|
|
@ -7,10 +7,11 @@
|
|||
#'
|
||||
#' @details
|
||||
#' Uses the metric `After_hours_collaboration_hours`.
|
||||
#' See `create_fizz()` for applying the same analysis to a different metric.
|
||||
#'
|
||||
#' @inheritParams create_fizz
|
||||
#'
|
||||
#' @family Collaboration
|
||||
#' @family After-Hours
|
||||
#'
|
||||
#' @examples
|
||||
#' afterhours_fizz(sq_data, hrvar = "Organization", return = "table")
|
||||
|
|
|
@ -0,0 +1,57 @@
|
|||
#' @title After-hours Collaboration Time Trend - Line Chart
|
||||
#'
|
||||
#' @description
|
||||
#' Provides a week by week view of after-hours collaboration time, visualized as line charts.
|
||||
#' By default returns a line chart for after-hours collaboration hours,
|
||||
#' with a separate panel per value in the HR attribute.
|
||||
#' Additional options available to return a summary table.
|
||||
#'
|
||||
#' @details
|
||||
#' Uses the metric `After_hours_collaboration_hours`.
|
||||
#' See `create_line()` for applying the same analysis to a different metric.
|
||||
#'
|
||||
#' @inheritParams create_line
|
||||
#'
|
||||
#' @import dplyr
|
||||
#' @import ggplot2
|
||||
#' @import reshape2
|
||||
#' @import scales
|
||||
#'
|
||||
#' @family After-Hours
|
||||
#'
|
||||
#' @examples
|
||||
#'
|
||||
#' ## Return a line plot
|
||||
#' afterhours_line(sq_data, hrvar = "LevelDesignation")
|
||||
#'
|
||||
#'
|
||||
#' ## Return a table
|
||||
#' afterhours_line(sq_data, hrvar = "LevelDesignation", return = "table")
|
||||
#'
|
||||
#' @return
|
||||
#' Returns a ggplot object by default, where 'plot' is passed in `return`.
|
||||
#' When 'table' is passed, a summary table is returned as a data frame.
|
||||
#'
|
||||
#' @export
|
||||
|
||||
afterhours_line <- function(data,
|
||||
hrvar = "Organization",
|
||||
mingroup=5,
|
||||
return = "plot"){
|
||||
|
||||
## Inherit arguments
|
||||
output <- create_line(data = data,
|
||||
metric = "After_hours_collaboration_hours",
|
||||
hrvar = hrvar,
|
||||
mingroup = mingroup,
|
||||
return = return)
|
||||
|
||||
if(return == "plot"){
|
||||
output +
|
||||
labs(title = "After-hours collaboration Hours")
|
||||
} else if(return == "table"){
|
||||
output
|
||||
} else {
|
||||
stop("Invalid `return` value")
|
||||
}
|
||||
}
|
|
@ -6,15 +6,9 @@
|
|||
#'
|
||||
#' @details
|
||||
#' Uses the metric \code{After_hours_collaboration_hours}.
|
||||
#' See `create_rank()` for applying the same analysis to a different metric.
|
||||
#'
|
||||
#' @param data A Standard Person Query dataset in the form of a data frame.
|
||||
#' @param hrvar A list of HR Variables to consider in the scan.
|
||||
#' Defaults to all HR attributes identified.
|
||||
#' @param mingroup Numeric value setting the privacy threshold / minimum group size.
|
||||
#' Defaults to 5.
|
||||
#' @param return A character vector specifying what to return.
|
||||
#' Valid values include "html" (default, returning an interactive DataTable)
|
||||
#' and "df" (data frame)
|
||||
#' @inheritParams create_rank
|
||||
#'
|
||||
#' @import dplyr
|
||||
#' @import ggplot2
|
||||
|
@ -25,8 +19,7 @@
|
|||
#' @family After-Hours
|
||||
#'
|
||||
#' @return
|
||||
#' Returns a ggplot object by default, where 'plot' is passed in `return`.
|
||||
#' When 'table' is passed, a summary table is returned as a data frame.
|
||||
#' When 'table' is passed in `return`, a summary table is returned as a data frame.
|
||||
#'
|
||||
#' @export
|
||||
|
||||
|
@ -35,18 +28,9 @@ afterhours_rank <- function(data,
|
|||
mingroup = 5,
|
||||
return = "table"){
|
||||
|
||||
output <-
|
||||
data %>%
|
||||
data %>%
|
||||
create_rank(metric = "After_hours_collaboration_hours",
|
||||
hrvar = hrvar,
|
||||
mingroup = mingroup,
|
||||
return = "table")
|
||||
|
||||
if(return == "html"){
|
||||
return(create_dt(output))
|
||||
} else if(return == "table"){
|
||||
return(output)
|
||||
} else {
|
||||
stop("Invalid `return` argument.")
|
||||
}
|
||||
return = return)
|
||||
}
|
||||
|
|
|
@ -6,27 +6,14 @@
|
|||
#'
|
||||
#' @details
|
||||
#' Uses the metric `Collaboration_hours`.
|
||||
#' See `create_rank()` for applying the same analysis to a different metric.
|
||||
#'
|
||||
#' @param data A Standard Query dataset in the form of a data frame.
|
||||
#' @param hrvar A list of HR Variables to consider in the scan.
|
||||
#' Defaults to all HR attributes identified.
|
||||
#' @param mingroup Numeric value setting the privacy threshold / minimum group size.
|
||||
#' Defaults to 5.
|
||||
#' @param return A character vector specifying what to return.
|
||||
#' Valid values include "html" (default, returning an interactive DataTable)
|
||||
#' and "df" (data frame)
|
||||
#'
|
||||
#' @import dplyr
|
||||
#' @import ggplot2
|
||||
#' @import reshape2
|
||||
#' @import scales
|
||||
#' @importFrom stats reorder
|
||||
#' @inheritParams create_rank
|
||||
#'
|
||||
#' @family Collaboration
|
||||
#'
|
||||
#' @return
|
||||
#' Returns a ggplot object by default, where 'plot' is passed in `return`.
|
||||
#' When 'table' is passed, a summary table is returned as a data frame.
|
||||
#' When 'table' is passed in `return`, a summary table is returned as a data frame.
|
||||
#'
|
||||
#' @export
|
||||
|
||||
|
@ -35,16 +22,10 @@ collaboration_rank <- function(data,
|
|||
mingroup = 5,
|
||||
return = "table"){
|
||||
|
||||
output <-
|
||||
data %>% create_rank(metric="Collaboration_hours", hrvar = hrvar,
|
||||
mingroup = mingroup,
|
||||
return = "table")
|
||||
data %>%
|
||||
create_rank(metric="Collaboration_hours",
|
||||
hrvar = hrvar,
|
||||
mingroup = mingroup,
|
||||
return = return)
|
||||
|
||||
if(return == "html"){
|
||||
return(create_dt(output))
|
||||
} else if(return == "table"){
|
||||
return(output)
|
||||
} else {
|
||||
stop("Invalid `return` argument.")
|
||||
}
|
||||
}
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
#' Returns a bar plot showing the average of a selected metric by default.
|
||||
#' Additional options available to return a summary table.
|
||||
#'
|
||||
#' @param data A Standard Query dataset in the form of a data frame.
|
||||
#' @param data A Standard Person Query dataset in the form of a data frame.
|
||||
#' @param metric Character string containing the name of the metric,
|
||||
#' e.g. "Collaboration_hours"
|
||||
#' @param hrvar HR Variable by which to split metrics, defaults to "Organization"
|
||||
|
|
|
@ -8,7 +8,7 @@
|
|||
#' This is a general purpose function that powers all the functions
|
||||
#' in the package that produce box plots.
|
||||
#'
|
||||
#' @param data A Standard Query dataset in the form of a data frame.
|
||||
#' @param data A Standard Person Query dataset in the form of a data frame.
|
||||
#' @param metric Character string containing the name of the metric,
|
||||
#' e.g. "Collaboration_hours"
|
||||
#' @param hrvar HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
#' Returns a stacked bar plot by default.
|
||||
#' Additional options available to return a table with distribution elements.
|
||||
#'
|
||||
#' @param data A Standard Query dataset in the form of a data frame.
|
||||
#' @param data A Standard Person Query dataset in the form of a data frame.
|
||||
#' @param metric Character string containing the name of the metric,
|
||||
#' e.g. "Collaboration_hours"
|
||||
#' @param hrvar HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"
|
||||
|
|
|
@ -8,7 +8,7 @@
|
|||
#' This is a general purpose function that powers all the functions
|
||||
#' in the package that produce 'fizzy drink' / jitter scatter plots.
|
||||
#'
|
||||
#' @param data A Standard Query dataset in the form of a data frame.
|
||||
#' @param data A Standard Person Query dataset in the form of a data frame.
|
||||
#' @param metric Character string containing the name of the metric,
|
||||
#' e.g. "Collaboration_hours"
|
||||
#' @param hrvar HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"
|
||||
|
|
|
@ -10,7 +10,7 @@
|
|||
#' This is a general purpose function that powers all the functions
|
||||
#' in the package that produce faceted line plots.
|
||||
#'
|
||||
#' @param data A Standard Query dataset in the form of a data frame.
|
||||
#' @param data A Standard Person Query dataset in the form of a data frame.
|
||||
#' @param metric Character string containing the name of the metric,
|
||||
#' e.g. "Collaboration_hours"
|
||||
#' @param hrvar HR Variable by which to split metrics, defaults to "Organization"
|
||||
|
|
|
@ -1,10 +1,10 @@
|
|||
#' @title Create Ranking
|
||||
#' @title Rank all groups across HR attributes on a selected Workplace Analytics metric
|
||||
#'
|
||||
#' @description
|
||||
#' This function scans a standard query output for groups with high levels of a given Workplace Analytics Metric.
|
||||
#' Returns a table with a all of groups (across multiple HR attributes) ranked by the specified metric.
|
||||
#' This function scans a standard Person query output for groups with high levels of a given Workplace Analytics Metric.
|
||||
#' Returns a table with all groups (across multiple HR attributes) ranked by the specified metric.
|
||||
#'
|
||||
#' @param data A Standard Query dataset in the form of a data frame.
|
||||
#' @param data A Standard Person Query dataset in the form of a data frame.
|
||||
#' @param metric Character string containing the name of the metric,
|
||||
#' e.g. "Collaboration_hours"
|
||||
#' @param hrvar A list of HR Variables to consider in the scan.
|
||||
|
@ -12,7 +12,8 @@
|
|||
#' @param mingroup Numeric value setting the privacy threshold / minimum group size.
|
||||
#' Defaults to 5.
|
||||
#' @param return A character vector specifying what to return.
|
||||
#' Valid values include "table" (default) and "df" (data frame)
|
||||
#' Valid values include "table" (default). Features are being considered for alternative return options but are currently
|
||||
#' unavailable.
|
||||
#'
|
||||
#' @import dplyr
|
||||
#' @import ggplot2
|
||||
|
@ -35,23 +36,26 @@ create_rank <- function(data,
|
|||
return = "table"){
|
||||
|
||||
results <-
|
||||
data %>% create_bar(
|
||||
metric = metric,
|
||||
hrvar = hrvar[1],
|
||||
mingroup = mingroup,
|
||||
return = return, bar_colour = "default")
|
||||
create_bar(data,
|
||||
metric = metric,
|
||||
hrvar = hrvar[1],
|
||||
mingroup = mingroup,
|
||||
return = "table")
|
||||
|
||||
## Create a blank column
|
||||
results$hrvar <- ""
|
||||
|
||||
## Empty table
|
||||
results <- results[0,]
|
||||
|
||||
for (p in hrvar) {
|
||||
## Loop through each HR attribute supplied in argument
|
||||
for (p in hrvar) {
|
||||
table1 <-
|
||||
data %>%
|
||||
create_bar(metric = metric,
|
||||
hrvar = p,
|
||||
mingroup = mingroup,
|
||||
return = "table", bar_colour = "default")
|
||||
create_bar(metric = metric,
|
||||
hrvar = p,
|
||||
mingroup = mingroup,
|
||||
return = "table")
|
||||
|
||||
table1$hrvar <- p
|
||||
|
||||
|
@ -59,7 +63,8 @@ create_rank <- function(data,
|
|||
}
|
||||
|
||||
output <-
|
||||
results %>% arrange(desc(get(metric))) %>%
|
||||
results %>%
|
||||
arrange(desc(get(metric))) %>%
|
||||
select(hrvar, everything())
|
||||
|
||||
if(return == "table"){
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#' @title Scatter plot (General Purpose)
|
||||
#' @title Create a Scatter plot with two selected Workplace Analytics metrics (General Purpose)
|
||||
#'
|
||||
#' @description
|
||||
#' Returns a scatter plot of two selected metrics, using colour to map
|
||||
|
@ -10,7 +10,7 @@
|
|||
#' This is a general purpose function that powers all the functions
|
||||
#' in the package that produce scatter plots.
|
||||
#'
|
||||
#' @param data A Standard Query dataset in the form of a data frame.
|
||||
#' @param data A Standard Person Query dataset in the form of a data frame.
|
||||
#' @param metric_x Character string containing the name of the metric,
|
||||
#' e.g. "Collaboration_hours"
|
||||
#' @param metric_y Character string containing the name of the metric,
|
||||
|
@ -44,8 +44,8 @@
|
|||
#'
|
||||
#' @export
|
||||
create_scatter <- function(data,
|
||||
metric_x = "Internal_network_size",
|
||||
metric_y = "External_network_size",
|
||||
metric_x,
|
||||
metric_y,
|
||||
hrvar = "Organization",
|
||||
mingroup = 5,
|
||||
return = "plot"){
|
||||
|
|
|
@ -4,44 +4,28 @@
|
|||
#' This function scans a standard query output for groups with high levels of 'Weekly Email Collaboration'.
|
||||
#' Returns a table with a all of groups (across multiple HR attributes) ranked by hours of digital collaboration.
|
||||
#'
|
||||
#' @param data A Standard Query dataset in the form of a data frame.
|
||||
#' @param hrvar A list of HR Variables to consider in the scan.
|
||||
#' Defaults to all HR attributes identified.
|
||||
#' @param mingroup Numeric value setting the privacy threshold / minimum group size.
|
||||
#' Defaults to 5.
|
||||
#' @param return A character vector specifying what to return.
|
||||
#' Valid values include "html" (default, returning an interactive DataTable)
|
||||
#' and "df" (data frame)
|
||||
#' @details
|
||||
#' Uses the metric `Email_hours`.
|
||||
#' See `create_rank()` for applying the same analysis to a different metric.
|
||||
#'
|
||||
#' @import dplyr
|
||||
#' @import ggplot2
|
||||
#' @import reshape2
|
||||
#' @import scales
|
||||
#' @importFrom stats reorder
|
||||
#' @inheritParams create_rank
|
||||
#'
|
||||
#' @family Emails
|
||||
#'
|
||||
#' @return
|
||||
#' Returns a ggplot object by default, where 'plot' is passed in `return`.
|
||||
#' When 'table' is passed, a summary table is returned as a data frame.
|
||||
#' When 'table' is passed in `return`, a summary table is returned as a data frame.
|
||||
#'
|
||||
#' @export
|
||||
|
||||
email_rank <- function(data,
|
||||
hrvar = extract_hr(data),
|
||||
mingroup = 5,
|
||||
return = "table"){
|
||||
hrvar = extract_hr(data),
|
||||
mingroup = 5,
|
||||
return = "table"){
|
||||
|
||||
output <-
|
||||
data %>% create_rank(metric="Email_hours", hrvar = hrvar,
|
||||
mingroup = mingroup,
|
||||
return = "table")
|
||||
data %>%
|
||||
create_rank(metric = "Email_hours",
|
||||
hrvar = hrvar,
|
||||
mingroup = mingroup,
|
||||
return = return)
|
||||
|
||||
if(return == "html"){
|
||||
return(create_dt(output))
|
||||
} else if(return == "table"){
|
||||
return(output)
|
||||
} else {
|
||||
stop("Invalid `return` argument.")
|
||||
}
|
||||
}
|
||||
|
|
|
@ -4,44 +4,27 @@
|
|||
#' This function scans a standard query output for groups with high levels of 'Weekly Email Collaboration'.
|
||||
#' Returns a table with a all of groups (across multiple HR attributes) ranked by hours of digital collaboration.
|
||||
#'
|
||||
#' @param data A Standard Query dataset in the form of a data frame.
|
||||
#' @param hrvar A list of HR Variables to consider in the scan.
|
||||
#' Defaults to all HR attributes identified.
|
||||
#' @param mingroup Numeric value setting the privacy threshold / minimum group size.
|
||||
#' Defaults to 5.
|
||||
#' @param return A character vector specifying what to return.
|
||||
#' Valid values include "html" (default, returning an interactive DataTable)
|
||||
#' and "df" (data frame)
|
||||
#' @details
|
||||
#' Uses the metric `Meeting_hours`.
|
||||
#' See `create_rank()` for applying the same analysis to a different metric.
|
||||
#'
|
||||
#' @import dplyr
|
||||
#' @import ggplot2
|
||||
#' @import reshape2
|
||||
#' @import scales
|
||||
#' @importFrom stats reorder
|
||||
#' @inheritParams create_rank
|
||||
#'
|
||||
#' @family Meetings
|
||||
#'
|
||||
#' @return
|
||||
#' Returns a ggplot object by default, where 'plot' is passed in `return`.
|
||||
#' When 'table' is passed, a summary table is returned as a data frame.
|
||||
#' When 'table' is passed in `return`, a summary table is returned as a data frame.
|
||||
#'
|
||||
#' @export
|
||||
|
||||
meeting_rank <- function(data,
|
||||
hrvar = extract_hr(data),
|
||||
mingroup = 5,
|
||||
return = "table"){
|
||||
hrvar = extract_hr(data),
|
||||
mingroup = 5,
|
||||
return = "table"){
|
||||
data %>%
|
||||
create_rank(metric = "Meeting_hours",
|
||||
hrvar = hrvar,
|
||||
mingroup = mingroup,
|
||||
return = return)
|
||||
|
||||
output <-
|
||||
data %>% create_rank(metric="Meeting_hours", hrvar = hrvar,
|
||||
mingroup = mingroup,
|
||||
return = "table")
|
||||
|
||||
if(return == "html"){
|
||||
return(create_dt(output))
|
||||
} else if(return == "table"){
|
||||
return(output)
|
||||
} else {
|
||||
stop("Invalid `return` argument.")
|
||||
}
|
||||
}
|
||||
|
|
|
@ -10,6 +10,8 @@
|
|||
#' @param hrvar Character string to specify the HR attribute to split the data by.
|
||||
#' Note that this is only applicable if a Collaboration Assessment query is passed to the function. If a Meeting Query
|
||||
#' is passed instead, this argument is ignored.
|
||||
#' @param mingroup Numeric value setting the privacy threshold / minimum group size. Defaults to 5.
|
||||
#' Only applicable when using a Collaboration Assessment query.
|
||||
#' @param return Character vector specifying what to return, defaults to "plot".
|
||||
#' Valid inputs are "plot" and "table".
|
||||
#'
|
||||
|
|
|
@ -5,6 +5,7 @@
|
|||
#' using a Collaboration Assessment Query with core WpA variables as an input.
|
||||
#'
|
||||
#' @param data Meeting Query data frame. Must contain the variables `Attendee` and `DurationHours`
|
||||
#' @param hrvar Character string to specify the HR attribute to split the data by.
|
||||
#' @param mingroup Numeric value setting the privacy threshold / minimum group size. Defaults to 5.
|
||||
#' @param return Character vector specifying what to return, defaults to "plot".
|
||||
#' Valid inputs are "plot" and "table".
|
||||
|
|
|
@ -4,44 +4,28 @@
|
|||
#' This function scans a standard query output for groups with high levels of 'Manager 1:1 Time'.
|
||||
#' Returns a table with a all of groups (across multiple HR attributes) ranked by hours of digital collaboration.
|
||||
#'
|
||||
#' @param data A Standard Query dataset in the form of a data frame.
|
||||
#' @param hrvar A list of HR Variables to consider in the scan.
|
||||
#' Defaults to all HR attributes identified.
|
||||
#' @param mingroup Numeric value setting the privacy threshold / minimum group size.
|
||||
#' Defaults to 5.
|
||||
#' @param return A character vector specifying what to return.
|
||||
#' Valid values include "html" (default, returning an interactive DataTable)
|
||||
#' and "df" (data frame)
|
||||
#' @details
|
||||
#' Uses the metric `Meeting_hours_with_manager_1_on_1`.
|
||||
#' See `create_rank()` for applying the same analysis to a different metric.
|
||||
#'
|
||||
#' @inheritParams create_rank
|
||||
#'
|
||||
#' @import dplyr
|
||||
#' @import ggplot2
|
||||
#' @import reshape2
|
||||
#' @import scales
|
||||
#' @importFrom stats reorder
|
||||
#'
|
||||
#' @family Managerial Relations
|
||||
#'
|
||||
#' @return
|
||||
#' Returns a ggplot object by default, where 'plot' is passed in `return`.
|
||||
#' When 'table' is passed, a summary table is returned as a data frame.
|
||||
#' When 'table' is passed in `return`, a summary table is returned as a data frame.
|
||||
#'
|
||||
#' @export
|
||||
|
||||
one2one_rank <- function(data,
|
||||
hrvar = extract_hr(data),
|
||||
mingroup = 5,
|
||||
return = "table"){
|
||||
hrvar = extract_hr(data),
|
||||
mingroup = 5,
|
||||
return = "table"){
|
||||
|
||||
output <-
|
||||
data %>% create_rank(metric="Meeting_hours_with_manager_1_on_1", hrvar = hrvar,
|
||||
mingroup = mingroup,
|
||||
return = "table")
|
||||
|
||||
if(return == "html"){
|
||||
return(create_dt(output))
|
||||
} else if(return == "table"){
|
||||
return(output)
|
||||
} else {
|
||||
stop("Invalid `return` argument.")
|
||||
}
|
||||
data %>%
|
||||
create_rank(metric = "Meeting_hours_with_manager_1_on_1",
|
||||
hrvar = hrvar,
|
||||
mingroup = mingroup,
|
||||
return = return)
|
||||
}
|
||||
|
|
|
@ -1,11 +1,11 @@
|
|||
#' @title Work Week Span distribution
|
||||
#' @title Distribution of Work Week Span
|
||||
#'
|
||||
#' @description
|
||||
#' Analyze Work Week Span distribution.
|
||||
#' Returns a a 'fizzy' scatter plot by default.
|
||||
#' Returns a stacked bar plot by default.
|
||||
#' Additional options available to return a table with distribution elements.
|
||||
#'
|
||||
#' @inheritParams create_fizz
|
||||
#' @inheritParams create_dist
|
||||
#'
|
||||
#' @family Workloads
|
||||
#'
|
||||
|
@ -13,17 +13,18 @@
|
|||
#' workloads_dist(sq_data, hrvar = "Organization", return = "table")
|
||||
#' @export
|
||||
|
||||
workloads_dist <- function(data, hrvar = "Organization", mingroup = 5, return = "plot") {
|
||||
workloads_dist <- function(data,
|
||||
hrvar = "Organization",
|
||||
mingroup = 5,
|
||||
return = "plot",
|
||||
cut = c(15, 30, 45)) {
|
||||
|
||||
## Inherit arguments
|
||||
create_fizz(data = data,
|
||||
create_dist(data = data,
|
||||
metric = "Workweek_span",
|
||||
hrvar = hrvar,
|
||||
mingroup = mingroup,
|
||||
return = return)
|
||||
return = return,
|
||||
cut = cut)
|
||||
|
||||
}
|
||||
|
||||
#' @rdname workloads_dist
|
||||
#' @export
|
||||
workloads_distribution <- workloads_dist
|
||||
|
|
|
@ -0,0 +1,30 @@
|
|||
#' @title Rank all groups across HR attributes for Work Week Span
|
||||
#'
|
||||
#' @description
|
||||
#' This function scans a standard query output for groups with high levels of Work Week Span.
|
||||
#' Returns a table with a all of groups (across multiple HR attributes) ranked by work week span.
|
||||
#'
|
||||
#' @details
|
||||
#' Uses the metric `Workweek_span`.
|
||||
#' See `create_rank()` for applying the same analysis to a different metric.
|
||||
#'
|
||||
#' @inheritParams create_rank
|
||||
#'
|
||||
#' @family Workloads
|
||||
#'
|
||||
#' @return
|
||||
#' When 'table' is passed in `return`, a summary table is returned as a data frame.
|
||||
#'
|
||||
#' @export
|
||||
|
||||
workloads_rank <- function(data,
|
||||
hrvar = extract_hr(data),
|
||||
mingroup = 5,
|
||||
return = "table"){
|
||||
|
||||
data %>%
|
||||
create_rank(metric = "Workweek_span",
|
||||
hrvar = hrvar,
|
||||
mingroup = mingroup,
|
||||
return = return)
|
||||
}
|
|
@ -2,7 +2,6 @@
|
|||
% Please edit documentation in R/afterhours_dist.R
|
||||
\name{afterhours_dist}
|
||||
\alias{afterhours_dist}
|
||||
\alias{afterhours_distribution}
|
||||
\title{After-Hours distribution}
|
||||
\usage{
|
||||
afterhours_dist(
|
||||
|
@ -12,14 +11,6 @@ afterhours_dist(
|
|||
return = "plot",
|
||||
cut = c(1, 2, 3)
|
||||
)
|
||||
|
||||
afterhours_distribution(
|
||||
data,
|
||||
hrvar = "Organization",
|
||||
mingroup = 5,
|
||||
return = "plot",
|
||||
cut = c(1, 2, 3)
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
@ -42,6 +33,7 @@ Additional options available to return a table with distribution elements.
|
|||
}
|
||||
\details{
|
||||
Uses the metric \code{After_hours_collaboration_hours}.
|
||||
See \code{create_dist()} for applying the same analysis to a different metric.
|
||||
}
|
||||
\examples{
|
||||
\dontrun{
|
||||
|
@ -57,6 +49,8 @@ afterhours_dist(sq_data, hrvar = "LevelDesignation", cut = c(4, 7, 9))
|
|||
}
|
||||
\seealso{
|
||||
Other After-Hours:
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{afterhours_line}()},
|
||||
\code{\link{afterhours_rank}()},
|
||||
\code{\link{afterhours_summary}()},
|
||||
\code{\link{afterhours_trend}()}
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
afterhours_fizz(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
||||
|
@ -23,20 +23,17 @@ Additional options available to return a table with distribution elements.
|
|||
}
|
||||
\details{
|
||||
Uses the metric \code{After_hours_collaboration_hours}.
|
||||
See \code{create_fizz()} for applying the same analysis to a different metric.
|
||||
}
|
||||
\examples{
|
||||
afterhours_fizz(sq_data, hrvar = "Organization", return = "table")
|
||||
}
|
||||
\seealso{
|
||||
Other Collaboration:
|
||||
\code{\link{collaboration_area}()},
|
||||
\code{\link{collaboration_dist}()},
|
||||
\code{\link{collaboration_fizz}()},
|
||||
\code{\link{collaboration_line}()},
|
||||
\code{\link{collaboration_rank}()},
|
||||
\code{\link{collaboration_sum}()},
|
||||
\code{\link{collaboration_trend}()},
|
||||
\code{\link{create_dist}()},
|
||||
\code{\link{meeting_trend}()}
|
||||
Other After-Hours:
|
||||
\code{\link{afterhours_dist}()},
|
||||
\code{\link{afterhours_line}()},
|
||||
\code{\link{afterhours_rank}()},
|
||||
\code{\link{afterhours_summary}()},
|
||||
\code{\link{afterhours_trend}()}
|
||||
}
|
||||
\concept{Collaboration}
|
||||
\concept{After-Hours}
|
||||
|
|
|
@ -0,0 +1,52 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/afterhours_line.R
|
||||
\name{afterhours_line}
|
||||
\alias{afterhours_line}
|
||||
\title{After-hours Collaboration Time Trend - Line Chart}
|
||||
\usage{
|
||||
afterhours_line(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics, defaults to "Organization"
|
||||
but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
||||
\item{mingroup}{Numeric value setting the privacy threshold / minimum group size. Defaults to 5.}
|
||||
|
||||
\item{return}{Character vector specifying what to return, defaults to "plot".
|
||||
Valid inputs are "plot" and "table".}
|
||||
}
|
||||
\value{
|
||||
Returns a ggplot object by default, where 'plot' is passed in \code{return}.
|
||||
When 'table' is passed, a summary table is returned as a data frame.
|
||||
}
|
||||
\description{
|
||||
Provides a week by week view of after-hours collaboration time, visualized as line charts.
|
||||
By default returns a line chart for after-hours collaboration hours,
|
||||
with a separate panel per value in the HR attribute.
|
||||
Additional options available to return a summary table.
|
||||
}
|
||||
\details{
|
||||
Uses the metric \code{After_hours_collaboration_hours}.
|
||||
See \code{create_line()} for applying the same analysis to a different metric.
|
||||
}
|
||||
\examples{
|
||||
|
||||
## Return a line plot
|
||||
afterhours_line(sq_data, hrvar = "LevelDesignation")
|
||||
|
||||
|
||||
## Return a table
|
||||
afterhours_line(sq_data, hrvar = "LevelDesignation", return = "table")
|
||||
|
||||
}
|
||||
\seealso{
|
||||
Other After-Hours:
|
||||
\code{\link{afterhours_dist}()},
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{afterhours_rank}()},
|
||||
\code{\link{afterhours_summary}()},
|
||||
\code{\link{afterhours_trend}()}
|
||||
}
|
||||
\concept{After-Hours}
|
|
@ -16,12 +16,11 @@ Defaults to all HR attributes identified.}
|
|||
Defaults to 5.}
|
||||
|
||||
\item{return}{A character vector specifying what to return.
|
||||
Valid values include "html" (default, returning an interactive DataTable)
|
||||
and "df" (data frame)}
|
||||
Valid values include "table" (default). Features are being considered for alternative return options but are currently
|
||||
unavailable.}
|
||||
}
|
||||
\value{
|
||||
Returns a ggplot object by default, where 'plot' is passed in \code{return}.
|
||||
When 'table' is passed, a summary table is returned as a data frame.
|
||||
When 'table' is passed in \code{return}, a summary table is returned as a data frame.
|
||||
}
|
||||
\description{
|
||||
This function scans a Standard Person Query for groups with high levels of After-Hours Collaboration.
|
||||
|
@ -29,10 +28,13 @@ Returns a table with a all of groups (across multiple HR attributes) ranked by h
|
|||
}
|
||||
\details{
|
||||
Uses the metric \code{After_hours_collaboration_hours}.
|
||||
See \code{create_rank()} for applying the same analysis to a different metric.
|
||||
}
|
||||
\seealso{
|
||||
Other After-Hours:
|
||||
\code{\link{afterhours_dist}()},
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{afterhours_line}()},
|
||||
\code{\link{afterhours_summary}()},
|
||||
\code{\link{afterhours_trend}()}
|
||||
}
|
||||
|
|
|
@ -10,7 +10,7 @@ afterhours_summary(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
|||
afterhours_sum(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics, defaults to "Organization"
|
||||
but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
@ -42,6 +42,8 @@ afterhours_summary(sq_data, hrvar = "LevelDesignation", return = "table")
|
|||
\seealso{
|
||||
Other After-Hours:
|
||||
\code{\link{afterhours_dist}()},
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{afterhours_line}()},
|
||||
\code{\link{afterhours_rank}()},
|
||||
\code{\link{afterhours_trend}()}
|
||||
}
|
||||
|
|
|
@ -39,6 +39,8 @@ afterhours_trend(sq_data, hrvar = "LevelDesignation", return = "table")
|
|||
\seealso{
|
||||
Other After-Hours:
|
||||
\code{\link{afterhours_dist}()},
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{afterhours_line}()},
|
||||
\code{\link{afterhours_rank}()},
|
||||
\code{\link{afterhours_summary}()}
|
||||
}
|
||||
|
|
|
@ -33,7 +33,6 @@ and \code{Instant_Message_hours}.
|
|||
}
|
||||
\seealso{
|
||||
Other Collaboration:
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{collaboration_dist}()},
|
||||
\code{\link{collaboration_fizz}()},
|
||||
\code{\link{collaboration_line}()},
|
||||
|
|
|
@ -30,7 +30,7 @@ collaboration_distribution(
|
|||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
||||
|
@ -59,7 +59,6 @@ collaboration_dist(sq_data, hrvar = "Organization", return = "table")
|
|||
}
|
||||
\seealso{
|
||||
Other Collaboration:
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{collaboration_area}()},
|
||||
\code{\link{collaboration_fizz}()},
|
||||
\code{\link{collaboration_line}()},
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
collaboration_fizz(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
||||
|
@ -29,7 +29,6 @@ collaboration_fizz(sq_data, hrvar = "Organization", return = "table")
|
|||
}
|
||||
\seealso{
|
||||
Other Collaboration:
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{collaboration_area}()},
|
||||
\code{\link{collaboration_dist}()},
|
||||
\code{\link{collaboration_line}()},
|
||||
|
|
|
@ -42,7 +42,6 @@ collaboration_line(sq_data, hrvar = "LevelDesignation", return = "table")
|
|||
}
|
||||
\seealso{
|
||||
Other Collaboration:
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{collaboration_area}()},
|
||||
\code{\link{collaboration_dist}()},
|
||||
\code{\link{collaboration_fizz}()},
|
||||
|
|
|
@ -12,7 +12,7 @@ collaboration_rank(
|
|||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{A list of HR Variables to consider in the scan.
|
||||
Defaults to all HR attributes identified.}
|
||||
|
@ -21,12 +21,11 @@ Defaults to all HR attributes identified.}
|
|||
Defaults to 5.}
|
||||
|
||||
\item{return}{A character vector specifying what to return.
|
||||
Valid values include "html" (default, returning an interactive DataTable)
|
||||
and "df" (data frame)}
|
||||
Valid values include "table" (default). Features are being considered for alternative return options but are currently
|
||||
unavailable.}
|
||||
}
|
||||
\value{
|
||||
Returns a ggplot object by default, where 'plot' is passed in \code{return}.
|
||||
When 'table' is passed, a summary table is returned as a data frame.
|
||||
When 'table' is passed in \code{return}, a summary table is returned as a data frame.
|
||||
}
|
||||
\description{
|
||||
This function scans a standard query output for groups with high levels of 'Weekly Digital Collaboration'.
|
||||
|
@ -34,10 +33,10 @@ Returns a table with a all of groups (across multiple HR attributes) ranked by h
|
|||
}
|
||||
\details{
|
||||
Uses the metric \code{Collaboration_hours}.
|
||||
See \code{create_rank()} for applying the same analysis to a different metric.
|
||||
}
|
||||
\seealso{
|
||||
Other Collaboration:
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{collaboration_area}()},
|
||||
\code{\link{collaboration_dist}()},
|
||||
\code{\link{collaboration_fizz}()},
|
||||
|
|
|
@ -45,7 +45,6 @@ and \code{Instant_Message_hours}.
|
|||
}
|
||||
\seealso{
|
||||
Other Collaboration:
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{collaboration_area}()},
|
||||
\code{\link{collaboration_dist}()},
|
||||
\code{\link{collaboration_fizz}()},
|
||||
|
|
|
@ -36,7 +36,6 @@ Uses the metric \code{Collaboration_hours}.
|
|||
}
|
||||
\seealso{
|
||||
Other Collaboration:
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{collaboration_area}()},
|
||||
\code{\link{collaboration_dist}()},
|
||||
\code{\link{collaboration_fizz}()},
|
||||
|
|
|
@ -15,7 +15,7 @@ create_bar(
|
|||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{metric}{Character string containing the name of the metric,
|
||||
e.g. "Collaboration_hours"}
|
||||
|
|
|
@ -13,7 +13,7 @@ create_boxplot(
|
|||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{metric}{Character string containing the name of the metric,
|
||||
e.g. "Collaboration_hours"}
|
||||
|
|
|
@ -15,7 +15,7 @@ create_dist(
|
|||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{metric}{Character string containing the name of the metric,
|
||||
e.g. "Collaboration_hours"}
|
||||
|
@ -47,7 +47,6 @@ create_dist(sq_data, metric = "Collaboration_hours", hrvar = "Organization", ret
|
|||
}
|
||||
\seealso{
|
||||
Other Collaboration:
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{collaboration_area}()},
|
||||
\code{\link{collaboration_dist}()},
|
||||
\code{\link{collaboration_fizz}()},
|
||||
|
|
|
@ -13,7 +13,7 @@ create_fizz(
|
|||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{metric}{Character string containing the name of the metric,
|
||||
e.g. "Collaboration_hours"}
|
||||
|
|
|
@ -13,7 +13,7 @@ create_line(
|
|||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{metric}{Character string containing the name of the metric,
|
||||
e.g. "Collaboration_hours"}
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
% Please edit documentation in R/create_rank.R
|
||||
\name{create_rank}
|
||||
\alias{create_rank}
|
||||
\title{Create Ranking}
|
||||
\title{Rank all groups across HR attributes on a selected Workplace Analytics metric}
|
||||
\usage{
|
||||
create_rank(
|
||||
data,
|
||||
|
@ -13,7 +13,7 @@ create_rank(
|
|||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{metric}{Character string containing the name of the metric,
|
||||
e.g. "Collaboration_hours"}
|
||||
|
@ -25,15 +25,16 @@ Defaults to all HR attributes identified.}
|
|||
Defaults to 5.}
|
||||
|
||||
\item{return}{A character vector specifying what to return.
|
||||
Valid values include "table" (default) and "df" (data frame)}
|
||||
Valid values include "table" (default). Features are being considered for alternative return options but are currently
|
||||
unavailable.}
|
||||
}
|
||||
\value{
|
||||
Returns a ggplot object by default, where 'plot' is passed in \code{return}.
|
||||
When 'table' is passed, a summary table is returned as a data frame.
|
||||
}
|
||||
\description{
|
||||
This function scans a standard query output for groups with high levels of a given Workplace Analytics Metric.
|
||||
Returns a table with a all of groups (across multiple HR attributes) ranked by the specified metric.
|
||||
This function scans a standard Person query output for groups with high levels of a given Workplace Analytics Metric.
|
||||
Returns a table with all groups (across multiple HR attributes) ranked by the specified metric.
|
||||
}
|
||||
\seealso{
|
||||
Other General:
|
||||
|
|
|
@ -2,19 +2,19 @@
|
|||
% Please edit documentation in R/create_scatter.R
|
||||
\name{create_scatter}
|
||||
\alias{create_scatter}
|
||||
\title{Scatter plot (General Purpose)}
|
||||
\title{Create a Scatter plot with two selected Workplace Analytics metrics (General Purpose)}
|
||||
\usage{
|
||||
create_scatter(
|
||||
data,
|
||||
metric_x = "Internal_network_size",
|
||||
metric_y = "External_network_size",
|
||||
metric_x,
|
||||
metric_y,
|
||||
hrvar = "Organization",
|
||||
mingroup = 5,
|
||||
return = "plot"
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{metric_x}{Character string containing the name of the metric,
|
||||
e.g. "Collaboration_hours"}
|
||||
|
|
|
@ -13,7 +13,7 @@ email_dist(
|
|||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
email_fizz(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
email_line(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics, defaults to "Organization"
|
||||
but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
email_rank(data, hrvar = extract_hr(data), mingroup = 5, return = "table")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{A list of HR Variables to consider in the scan.
|
||||
Defaults to all HR attributes identified.}
|
||||
|
@ -16,17 +16,20 @@ Defaults to all HR attributes identified.}
|
|||
Defaults to 5.}
|
||||
|
||||
\item{return}{A character vector specifying what to return.
|
||||
Valid values include "html" (default, returning an interactive DataTable)
|
||||
and "df" (data frame)}
|
||||
Valid values include "table" (default). Features are being considered for alternative return options but are currently
|
||||
unavailable.}
|
||||
}
|
||||
\value{
|
||||
Returns a ggplot object by default, where 'plot' is passed in \code{return}.
|
||||
When 'table' is passed, a summary table is returned as a data frame.
|
||||
When 'table' is passed in \code{return}, a summary table is returned as a data frame.
|
||||
}
|
||||
\description{
|
||||
This function scans a standard query output for groups with high levels of 'Weekly Email Collaboration'.
|
||||
Returns a table with a all of groups (across multiple HR attributes) ranked by hours of digital collaboration.
|
||||
}
|
||||
\details{
|
||||
Uses the metric \code{Email_hours}.
|
||||
See \code{create_rank()} for applying the same analysis to a different metric.
|
||||
}
|
||||
\seealso{
|
||||
Other Emails:
|
||||
\code{\link{email_dist}()},
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
email_summary(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics, defaults to "Organization"
|
||||
but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
|
|
@ -22,7 +22,7 @@ meeting_distribution(
|
|||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
meeting_fizz(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
meeting_line(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics, defaults to "Organization"
|
||||
but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
meeting_rank(data, hrvar = extract_hr(data), mingroup = 5, return = "table")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{A list of HR Variables to consider in the scan.
|
||||
Defaults to all HR attributes identified.}
|
||||
|
@ -16,17 +16,20 @@ Defaults to all HR attributes identified.}
|
|||
Defaults to 5.}
|
||||
|
||||
\item{return}{A character vector specifying what to return.
|
||||
Valid values include "html" (default, returning an interactive DataTable)
|
||||
and "df" (data frame)}
|
||||
Valid values include "table" (default). Features are being considered for alternative return options but are currently
|
||||
unavailable.}
|
||||
}
|
||||
\value{
|
||||
Returns a ggplot object by default, where 'plot' is passed in \code{return}.
|
||||
When 'table' is passed, a summary table is returned as a data frame.
|
||||
When 'table' is passed in \code{return}, a summary table is returned as a data frame.
|
||||
}
|
||||
\description{
|
||||
This function scans a standard query output for groups with high levels of 'Weekly Email Collaboration'.
|
||||
Returns a table with a all of groups (across multiple HR attributes) ranked by hours of digital collaboration.
|
||||
}
|
||||
\details{
|
||||
Uses the metric \code{Meeting_hours}.
|
||||
See \code{create_rank()} for applying the same analysis to a different metric.
|
||||
}
|
||||
\seealso{
|
||||
Other Meetings:
|
||||
\code{\link{meeting_fizz}()},
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
meeting_summary(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics, defaults to "Organization"
|
||||
but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
|
|
@ -28,7 +28,6 @@ Additional options available to return a summary table.
|
|||
}
|
||||
\seealso{
|
||||
Other Collaboration:
|
||||
\code{\link{afterhours_fizz}()},
|
||||
\code{\link{collaboration_area}()},
|
||||
\code{\link{collaboration_dist}()},
|
||||
\code{\link{collaboration_fizz}()},
|
||||
|
|
|
@ -13,6 +13,9 @@ meetingtype_dist(data, hrvar = NULL, mingroup = 5, return = "plot")
|
|||
Note that this is only applicable if a Collaboration Assessment query is passed to the function. If a Meeting Query
|
||||
is passed instead, this argument is ignored.}
|
||||
|
||||
\item{mingroup}{Numeric value setting the privacy threshold / minimum group size. Defaults to 5.
|
||||
Only applicable when using a Collaboration Assessment query.}
|
||||
|
||||
\item{return}{Character vector specifying what to return, defaults to "plot".
|
||||
Valid inputs are "plot" and "table".}
|
||||
}
|
||||
|
|
|
@ -9,6 +9,8 @@ meetingtype_dist_ca(data, hrvar = NULL, mingroup = 5, return = "plot")
|
|||
\arguments{
|
||||
\item{data}{Meeting Query data frame. Must contain the variables \code{Attendee} and \code{DurationHours}}
|
||||
|
||||
\item{hrvar}{Character string to specify the HR attribute to split the data by.}
|
||||
|
||||
\item{mingroup}{Numeric value setting the privacy threshold / minimum group size. Defaults to 5.}
|
||||
|
||||
\item{return}{Character vector specifying what to return, defaults to "plot".
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
one2one_fizz(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
one2one_rank(data, hrvar = extract_hr(data), mingroup = 5, return = "table")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{A list of HR Variables to consider in the scan.
|
||||
Defaults to all HR attributes identified.}
|
||||
|
@ -16,17 +16,20 @@ Defaults to all HR attributes identified.}
|
|||
Defaults to 5.}
|
||||
|
||||
\item{return}{A character vector specifying what to return.
|
||||
Valid values include "html" (default, returning an interactive DataTable)
|
||||
and "df" (data frame)}
|
||||
Valid values include "table" (default). Features are being considered for alternative return options but are currently
|
||||
unavailable.}
|
||||
}
|
||||
\value{
|
||||
Returns a ggplot object by default, where 'plot' is passed in \code{return}.
|
||||
When 'table' is passed, a summary table is returned as a data frame.
|
||||
When 'table' is passed in \code{return}, a summary table is returned as a data frame.
|
||||
}
|
||||
\description{
|
||||
This function scans a standard query output for groups with high levels of 'Manager 1:1 Time'.
|
||||
Returns a table with a all of groups (across multiple HR attributes) ranked by hours of digital collaboration.
|
||||
}
|
||||
\details{
|
||||
Uses the metric \code{Meeting_hours_with_manager_1_on_1}.
|
||||
See \code{create_rank()} for applying the same analysis to a different metric.
|
||||
}
|
||||
\seealso{
|
||||
Other Managerial Relations:
|
||||
\code{\link{mgrcoatt_dist}()},
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
one2one_sum(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics, defaults to "Organization"
|
||||
but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
|
|
@ -2,20 +2,18 @@
|
|||
% Please edit documentation in R/workloads_dist.R
|
||||
\name{workloads_dist}
|
||||
\alias{workloads_dist}
|
||||
\alias{workloads_distribution}
|
||||
\title{Work Week Span distribution}
|
||||
\title{Distribution of Work Week Span}
|
||||
\usage{
|
||||
workloads_dist(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
|
||||
workloads_distribution(
|
||||
workloads_dist(
|
||||
data,
|
||||
hrvar = "Organization",
|
||||
mingroup = 5,
|
||||
return = "plot"
|
||||
return = "plot",
|
||||
cut = c(15, 30, 45)
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
||||
|
@ -23,10 +21,13 @@ workloads_distribution(
|
|||
|
||||
\item{return}{Character vector specifying what to return, defaults to "plot".
|
||||
Valid inputs are "plot" and "table".}
|
||||
|
||||
\item{cut}{A numeric vector of length three to specify the breaks for the distribution,
|
||||
e.g. c(10, 15, 20)}
|
||||
}
|
||||
\description{
|
||||
Analyze Work Week Span distribution.
|
||||
Returns a a 'fizzy' scatter plot by default.
|
||||
Returns a stacked bar plot by default.
|
||||
Additional options available to return a table with distribution elements.
|
||||
}
|
||||
\examples{
|
||||
|
@ -36,6 +37,7 @@ workloads_dist(sq_data, hrvar = "Organization", return = "table")
|
|||
Other Workloads:
|
||||
\code{\link{workloads_fizz}()},
|
||||
\code{\link{workloads_line}()},
|
||||
\code{\link{workloads_rank}()},
|
||||
\code{\link{workloads_summary}()},
|
||||
\code{\link{workloads_trend}()}
|
||||
}
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
workloads_fizz(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics. Accepts a character vector, defaults to "Organization" but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
||||
|
@ -28,6 +28,7 @@ meeting_fizz(sq_data, hrvar = "Organization", return = "table")
|
|||
Other Workloads:
|
||||
\code{\link{workloads_dist}()},
|
||||
\code{\link{workloads_line}()},
|
||||
\code{\link{workloads_rank}()},
|
||||
\code{\link{workloads_summary}()},
|
||||
\code{\link{workloads_trend}()}
|
||||
}
|
||||
|
|
|
@ -41,6 +41,7 @@ workloads_line(sq_data, hrvar = "LevelDesignation", return = "table")
|
|||
Other Workloads:
|
||||
\code{\link{workloads_dist}()},
|
||||
\code{\link{workloads_fizz}()},
|
||||
\code{\link{workloads_rank}()},
|
||||
\code{\link{workloads_summary}()},
|
||||
\code{\link{workloads_trend}()}
|
||||
}
|
||||
|
|
|
@ -0,0 +1,41 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/workloads_rank.R
|
||||
\name{workloads_rank}
|
||||
\alias{workloads_rank}
|
||||
\title{Rank all groups across HR attributes for Work Week Span}
|
||||
\usage{
|
||||
workloads_rank(data, hrvar = extract_hr(data), mingroup = 5, return = "table")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{A list of HR Variables to consider in the scan.
|
||||
Defaults to all HR attributes identified.}
|
||||
|
||||
\item{mingroup}{Numeric value setting the privacy threshold / minimum group size.
|
||||
Defaults to 5.}
|
||||
|
||||
\item{return}{A character vector specifying what to return.
|
||||
Valid values include "table" (default). Features are being considered for alternative return options but are currently
|
||||
unavailable.}
|
||||
}
|
||||
\value{
|
||||
When 'table' is passed in \code{return}, a summary table is returned as a data frame.
|
||||
}
|
||||
\description{
|
||||
This function scans a standard query output for groups with high levels of Work Week Span.
|
||||
Returns a table with a all of groups (across multiple HR attributes) ranked by work week span.
|
||||
}
|
||||
\details{
|
||||
Uses the metric \code{Workweek_span}.
|
||||
See \code{create_rank()} for applying the same analysis to a different metric.
|
||||
}
|
||||
\seealso{
|
||||
Other Workloads:
|
||||
\code{\link{workloads_dist}()},
|
||||
\code{\link{workloads_fizz}()},
|
||||
\code{\link{workloads_line}()},
|
||||
\code{\link{workloads_summary}()},
|
||||
\code{\link{workloads_trend}()}
|
||||
}
|
||||
\concept{Workloads}
|
|
@ -7,7 +7,7 @@
|
|||
workloads_summary(data, hrvar = "Organization", mingroup = 5, return = "plot")
|
||||
}
|
||||
\arguments{
|
||||
\item{data}{A Standard Query dataset in the form of a data frame.}
|
||||
\item{data}{A Standard Person Query dataset in the form of a data frame.}
|
||||
|
||||
\item{hrvar}{HR Variable by which to split metrics, defaults to "Organization"
|
||||
but accepts any character vector, e.g. "LevelDesignation"}
|
||||
|
@ -38,6 +38,7 @@ Other Workloads:
|
|||
\code{\link{workloads_dist}()},
|
||||
\code{\link{workloads_fizz}()},
|
||||
\code{\link{workloads_line}()},
|
||||
\code{\link{workloads_rank}()},
|
||||
\code{\link{workloads_trend}()}
|
||||
}
|
||||
\concept{Workloads}
|
||||
|
|
|
@ -38,6 +38,7 @@ Other Workloads:
|
|||
\code{\link{workloads_dist}()},
|
||||
\code{\link{workloads_fizz}()},
|
||||
\code{\link{workloads_line}()},
|
||||
\code{\link{workloads_rank}()},
|
||||
\code{\link{workloads_summary}()}
|
||||
}
|
||||
\concept{Workloads}
|
||||
|
|
Загрузка…
Ссылка в новой задаче