Skip to content

Commit

Permalink
fig1 test
Browse files Browse the repository at this point in the history
  • Loading branch information
kygoffe committed Oct 23, 2023
1 parent 74a94a9 commit f4b6927
Show file tree
Hide file tree
Showing 10 changed files with 290 additions and 63 deletions.
3 changes: 2 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,8 @@ Imports:
forcats (>= 1.0.0),
futile.logger (>= 1.4.3),
stringr,
formatR
formatR,
tidyr
Suggests:
pkgload,
testthat (>= 3.0.0),
Expand Down
4 changes: 2 additions & 2 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,12 +1,14 @@
# Generated by roxygen2: do not edit by hand

export("%>%")
export(gender_profile)
export(h1_tabstop)
export(h2_tabstop)
export(h3_tabstop)
export(h4_tabstop)
export(h5_tabstop)
export(h6_tabstop)
export(headcount_data)
export(nhs_card)
export(nhs_card_tabstop)
export(nhs_footer)
Expand All @@ -25,5 +27,3 @@ importFrom(golem,bundle_resources)
importFrom(golem,favicon)
importFrom(golem,with_golem_options)
importFrom(magrittr,"%>%")
importFrom(rlang,":=")
importFrom(rlang,.data)
107 changes: 57 additions & 50 deletions R/headcount_data_class.R
Original file line number Diff line number Diff line change
@@ -1,26 +1,29 @@
#' @title tidy data set for first headcount related two graphs.
#' @title S3 headcount class to create number of headcount by gender and also
#' gender and AFC pay band.#'
#'
#' @description \code{headcount_data} is the class used for the creation of
#' #' first two headcount related figures.
#' first two headcount related figures in the GPG report.
#'
#' @details The \code{headcount_data} class expects a \code{data.frame} with at
#' least five columns: FINANCIAL_YEAR, GENDER, PAY_GRADE_NAME, FTE_GROUP, HEADCOUNT. Each
#' row represents aggregated headcount by four columns.
#'
#' Once initiated, the class has five slots: \code{df}: the basic \code{data.frame},
#' \code{colnames}: a character vector containing the column names from the
#' \code{df}, \code{reporting_headcount}: a numeric vector containing
#' reporting financial year's headcount, \code{diffs}: a numeric vector
#' containing differences from previous financial year headcount
#' to current reporting financial year headcount, \code{ending_fy}: a character
#' vector containing ending reporting period (e.g. 31 March 2022)
#' Once initiated, the class has seven slots:
#' \code{df}: data frame \n
#' \code{overview_gender}: data frame \n
#' \code{overview_afc}: data frame \n
#' \code{overview_fte}: data frame \n
#' \code{reporting_headcount}: a numeric vector containing reporting financial
#' year's headcount \n
#' \code{diffs}: a numeric vector containing differences from previous \n
#' financial year headcount to current reporting financial year headcount \n
#' \code{ending_fy}: a character vector containing ending reporting period
#' (e.g. 31 March 2022). This uses for introduction paragraph
#'
#'
#' @param x Input data frame.
#' @param log_level The severity level at which log messages are written from
#' least to most serious: TRACE, DEBUG, INFO, WARN, ERROR, FATAL. Default is
#' level is INFO. See \code{?flog.threshold()} for additional details.
#' @param eda If TRUE an graphical data analysis is conducted for a human to check.
#' @param log_level keep it WARN
#' @param eda If TRUE base R plot shows in the Viewer
#'
#' @return If the class is not instantiated correctly, nothing is returned.
#'
Expand All @@ -33,29 +36,23 @@
#' @export


headcount_data <- function(x, log_level = futile.logger::WARN,
headcount_data <- function(x,
log_level = futile.logger::WARN,
eda = FALSE) {

# Set logger severity threshold, defaults to WARN
futile.logger::flog.threshold(log_level)


# Checks
futile.logger::flog.info("Initiating HEADCOUNT_data class.
\n\nExpects a data.frame with at
futile.logger::flog.info("Initiating headcount_data class.
\n\nIt expects a data.frame with at
least five columns: FINANCIAL_YEAR, gender,
PAY_GRADE_NAME, FTE_GROUP and HEADCOUNT.
Each row represents an aggregated headcount
from four columns.
This class is given by ?headcount_data().")
based on four columns.")

# Integrity checks on incoming data ----

# Check the structure of the data is as expected: data.frame containing no
# missing values and at least five columns, containing FINANCIAL_YEAR,
# gender, PAY_GRADE_NAME, FTE_GROUP and HEADCOUNT.

futile.logger::flog.info("\n*** Running integrity checks on input dataframe (x):")
futile.logger::flog.debug("\nChecking input is properly formatted...")

futile.logger::flog.debug("Checking x is a data.frame...")
if (!is.data.frame(x)) {
Expand Down Expand Up @@ -102,42 +99,30 @@ headcount_data <- function(x, log_level = futile.logger::WARN,
futile.logger::flog.debug("Checking for the correct number of rows...")
if (nrow(x) < 260) {
futile.logger::flog.warn("x does not appear to be well formed. nrow(x) should be
greater than 260 as of 2022/23 report.")
greater than 180 (5 year * gender * fte * afc)
as of 2021/22 report.")
}



futile.logger::flog.info("...passed")


# Check sensible range for year

futile.logger::flog.debug("Checking beginning financial years in a sensible
range e.g.(2017:2022)...")



if (any(as.numeric(stringr::str_sub(x$FINANCIAL_YEAR, 1, 4)) < 2017)) {
futile.logger::flog.warn("The dates should start from
2017/18 financial year. Please check data-raw script.")
}



futile.logger::flog.info("...passed")

# Reset threshold to package default
futile.logger::flog.threshold(futile.logger::INFO)
# Reset so that log is appended to console (the package default)
futile.logger::flog.appender(futile.logger::appender.console())
futile.logger::flog.info("...check done..")

# Message required to pass a test
message("Checks completed successfully:
object of 'headcount_data' class produced!")
message("Checks completed: 'headcount_data' S3 class created.")

# EDA
# some people like to eyeball stuff
# number of HEADCOUNT per financial year
# number of HEADCOUNT per financial year - expect to increase?
if (eda == TRUE) {
agg_data <- aggregate(HEADCOUNT ~ FINANCIAL_YEAR, x, sum)
barplot(agg_data$HEADCOUNT,
Expand All @@ -149,8 +134,6 @@ headcount_data <- function(x, log_level = futile.logger::WARN,
}


# Calculate the latest and previous years

# Calculate the latest and previous years
# This values are required to add to the interactive document
start_latest_year <- max(as.numeric(stringr::str_sub(x$FINANCIAL_YEAR, 1, 4)))
Expand All @@ -167,10 +150,10 @@ headcount_data <- function(x, log_level = futile.logger::WARN,

# First aggregate by financial year
agg_data <- x |>
filter(FINANCIAL_YEAR %in% c(latest_fy, previous_fy)) |>
group_by(FINANCIAL_YEAR) |>
summarise(TOTAL_HEADCOUNT = sum(HEADCOUNT, na.rm = TRUE)) |>
arrange(FINANCIAL_YEAR)
dplyr::filter(FINANCIAL_YEAR %in% c(latest_fy, previous_fy)) |>
dplyr::group_by(FINANCIAL_YEAR) |>
dplyr::summarise(TOTAL_HEADCOUNT = sum(HEADCOUNT, na.rm = TRUE)) |>
dplyr::arrange(FINANCIAL_YEAR)

# Extract the values
reporting_headcount <-
Expand All @@ -182,14 +165,38 @@ headcount_data <- function(x, log_level = futile.logger::WARN,

ending_fy <- as.character(start_latest_year + 1)


# Attach data frame: headcount by GENDER
overview_gender <- x |>
dplyr::group_by(FINANCIAL_YEAR, GENDER) |>
dplyr::summarise(HEADCOUNT = sum(HEADCOUNT, na.rm = TRUE),
.groups = "drop") |>
tidyr::pivot_wider(names_from = GENDER,
values_from = HEADCOUNT)

# Attach data frame: headcount by GENDER & PAY_GRADE_NAME
overview_afc <- x |>
dplyr::group_by(FINANCIAL_YEAR, GENDER, PAY_GRADE_NAME) |>
dplyr::summarise(HEADCOUNT = sum(HEADCOUNT, na.rm = TRUE),
.groups = "drop")

# Attach data frame: headcount by GENDER & FTE
overview_fte <- x |>
dplyr::group_by(FINANCIAL_YEAR, GENDER, FTE_GROUP) |>
dplyr::summarise(HEADCOUNT = sum(HEADCOUNT, na.rm = TRUE),
.groups = "drop") |>
tidyr::pivot_wider(names_from = c(GENDER, FTE_GROUP),
values_from = HEADCOUNT)


# Define the class here ----
# It will use to create highchart line graph

structure(
list(
df = x,
colnames = colnames(x),
overview_gender = overview_gender,
overview_afc = overview_afc,
overview_fte = overview_fte,
reporting_headcount = reporting_headcount,
diffs = diffs,
ending_fy = ending_fy
Expand Down
104 changes: 104 additions & 0 deletions R/utils_charts.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,104 @@
#' @title Highcharter line chart to show the number of headcount by financial
#' year by gender.
#'
#' @description \code{headcount_data} is the S3 class used for gender related
#' summary of workforce
#'
#'
#' @return Returns a highchart or htmlwidget object.
#'
#' @examples
#'
#' workforce <- nhsbsaGPG::headcount_data(nhsbsaGPG::headcount)
#' nhsbsaGPG::gender_profile(workforce)
#'
#' @export
#' @param x Input data frame from \code{headcount_data} S3 class object.
#' @param xvar "Financial Year", default
#' @param yvars data frame converts to list and each list element to create line
#' @param series_names If user wants to give different series name for
#' highchart legend
#' @param yaxis_title Title of y axis
#' @param yaxis_label Indication of percentage or number
#' @param show_legend TRUE default
#' @param line_style Control line style either Solid or DashDot
#' @param series_alpha Control opacity
#'
#' @import nhsbsa-data-analytics/nhsbsaR
#'
gender_profile <- function(x,
xvar = "FINANCIAL_YEAR",
yvars,
series_names,
yaxis_title,
yaxis_label
){
out <- tryCatch(
expr = {
# Input data frame convert to list
data_list <- list(x)

# create plot object (empty one..)
plt <- highcharter::highchart() |>
highcharter::hc_chart(type = "line") |>
nhsbsaR::theme_nhsbsa_highchart(stack = NA,
palette = c("Blue", "AquaGreen"))


# It requires minimum two series (male, female) but it could split further
for (i in seq_along(series_names)) {
yvar <- yvars[[i]] # take column name (e.g. Female/Male)
# e.g. Label which will show in legend
series_name <- series_names[[i]]
data <- data_list[[1]] # list converted data frame

plt <- plt |>
highcharter::hc_add_series(
data = data,
type = "line",
highcharter::hcaes(
x = .data[[xvar]], # default financial year
y = .data[[yvar]] # Female for example
),
name = series_name # these labels will show in legend
)
}

plt <- if (yaxis_label == "percentage") {
plt |>
highcharter::hc_yAxis(
title = list(text = yaxis_title),
labels <- list(format = "{value}"),
min = 0,
max = 100
)
} else {
plt |>
highcharter::hc_yAxis(
title = list(text = yaxis_title),
labels <- list(format = "{value:,f}"),
min = 0
)

plt <- plt |>
highcharter::hc_xAxis(type = "category") |>
highcharter::hc_legend(
itemWidth = 600,
itemMarginTop = 5,
y = 0
)
}
return(plt)
},
warning = function() {
w <- warnings()
warning("Warning produced running gender_profile():", w)
},
error = function(e) {
stop("Error produced running gender_profile():", e)
},
finally = {}
)
}


24 changes: 24 additions & 0 deletions man/gender_profile.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

18 changes: 18 additions & 0 deletions man/headcount.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit f4b6927

Please sign in to comment.