R/fun.R
In pkopps/biview: Functions to Achieve Classic GBI Report Format (Four Weeks, All Months, Run Rate, YTD, Previous Year Variance, etc.)
#' Core function of wmy_1e, wmy_3e, & my_2e
#'
#' @param df data frame containing metric
#' @param metric column name from df
#' @param grouping time diminesion column name (wk_num_in_yr, mth_num_in_yr, yr_num)
#' @param df_rr data frame containing run rate
#' @param metric_rr column name from df_rr
#' @param df_goal data frame containing metric goal
#' @param metric_goal column name from df_goal
#' @param df_3p9 data frame containing metric prediction
#' @param metric_3p9 column name from df_3p9
#' @param df_6p6 data frame containing metric prediction
#' @param metric_6p6 column name from df_6p6
#' @param df_9p3 data frame containing metric prediction
#' @param metric_9p3 column name from df_9p3
#' @param full_yr logical. Inlcude full year summation column for month view
#' @param cbr_ytd logical. Inlcude YTD definition for CBR : Actual values from last completed month
#' @param rate logical. Adjust logic to handle full year for rates
#' @param new_name name for metric output. Also creates new labels for previous year, previous year variance, etc.
#' @param commas format values with commas. ie: 1234000 -> 1,234,000
#' @param neg_var_paren format variance values with parenthesis. ie: -40.4 -> (40.4)
#' @param div_by_1000 also an accounting practice; divide all value by 1000. ie: 1234000 -> 1234.00
#' @param prefix add prefix to values. ie: 2000 -> $2000
#' @param suffix add suffix to values. ie: 20.54 -> 20.54\%
#' @param spark logical should a spark chart be added as a column in the output
#' @param pop logical stands for Period over Period. Include percent change from previous period (ie: week 4 to week 5) next to value
#'
#' @examples
#'## week view
#'fun(
#' performance,
#' revenue,
#' wk_num_in_yr,
#' new_name = "Revenue",
#' commas = TRUE,
#' div_by_1000 = FALSE,
#' full_yr = FALSE,
#' prefix = "$"
#')
#'
#'## month view
#'fun(
#' performance,
#' revenue,
#' mth_num_in_yr,
#' new_name = "Revenue",
#' commas = TRUE,
#' div_by_1000 = FALSE,
#' full_yr = FALSE,
#' prefix = "$"
#' )
fun <- function(
df,
metric,
grouping,
df_rr,
metric_rr,
df_goal,
metric_goal,
df_3p9,
metric_3p9,
df_6p6,
metric_6p6,
df_9p3,
metric_9p3,
weeks_back = 4,
week_end_dates = FALSE,
week_start_dates = TRUE,
cbr_ytd = FALSE,
full_yr = FALSE,
rate = FALSE,
new_name = NULL,
commas = FALSE,
neg_var_paren = FALSE,
div_by_1000 = FALSE,
prefix = "",
suffix = "",
spark = FALSE,
pop = FALSE,
pop_threshold = 100,
scalar = 1,
digitsAfterDecimal = 2,
op2_and_var_ph = TRUE,
month_names = TRUE,
# rr_mth_for_header =
in_mth_header_op2 = TRUE,
in_mth_header_3p9 = FALSE,
in_mth_header_6p6 = FALSE,
in_mth_header_9p3 = FALSE
){
#round sum helper fun
round_sum <- function(x){
round(sum(x, na.rm=TRUE), digitsAfterDecimal)
}
# 'enquo' args for !!/!!!
metric <- enquo(metric)
grouping <- enquo(grouping)
metric_rr <- enquo(metric_rr)
if(!missing(metric_goal)) metric_goal <- enquo(metric_goal)
# for cbr ytd
cur_yr <- max(df$yr_num)
cur_yr_mth <- month(Sys.Date())
# errors/messaging
## if missing args
if(missing(df)) stop("'df' is missing")
if(missing(grouping)) stop("'grouping' is missing")
## if illegal value TODEBUG
# if(grouping != "~wk_num_in_yr" | grouping != "~mth_num_in_yr" | grouping != "~yr_num") stop("grouping value must be: 'wk_num_in_yr', 'mth_num_in_yr' or, 'yr_num'")
## 0 record data frame
if(nrow(df) == 0) stop("empty data frame supplied")
## conflicting argument values errors/warnings
if(suffix == "%" & div_by_1000 == TRUE) warning("Divide percentage by 1000? Are you sure?")
if(grouping == "~wk_num_in_yr" & full_yr == TRUE) stop("`full_yr` = TRUE not applicable for weekly grouping")
if(grouping == "~wk_num_in_yr" & cbr_ytd == TRUE) stop("`cbr_ytd` = TRUE not applicable for weekly grouping")
if(grouping == "~wk_num_in_yr" & !missing(df_goal)) stop("goal not applicable for weekly grouping")
if(grouping == "~yr_num" & full_yr == TRUE) stop("`full_yr` = TRUE not applicable for year grouping")
if(grouping != "~mth_num_in_yr" & !missing(df_rr)) stop("run rate not applicable for groupings other than mth_num_in_yr")
# indicator variable for op2, 3+3, etc.
# if(!missing(metric_goal)){
# indicator <- "OP2"
# if(any(df_goal %>% select(!!metric_goal) %>% pull() %in% 0)) warning("Warning: '0' values in metric_goal argument\n")
# }else if(!missing(metric_3p9)){
# indicator <- "3+9"
# }else if(!missing(metric_6p6)){
# indicator <- "6+6"
# }else if(!missing(metric_9p3)){
# indicator <- "9+3"
# }else{
# indicator <- NULL
# }
# get relevant wk numbers
if(grouping == "~wk_num_in_yr"){
wk_nums <- df %>%
arrange(wk_start_date) %>%
filter(wk_start_date >= ceiling_date( ( max(wk_start_date) - (7 * weeks_back) ) ) ) %>% # controls weeks back to calculate metric
select(wk_num_in_yr) %>%
pull() %>% unique()
wk_start_dates <- df %>%
arrange(wk_start_date) %>%
filter(wk_start_date >= ceiling_date( ( max(wk_start_date) - (7 * weeks_back) ) ) ) %>%
select(wk_start_date) %>%
mutate(wk_start_date = format(wk_start_date, format = "%d-%b")) %>%
pull() %>% unique()
}
# get number of months for current year ONLY (previous year will always be 12) for rate = TRUE
# if((grouping == "~mth_num_in_yr" | grouping == "~yr_num") & rate == TRUE){
# cur_yr_mths_w_data <-
# df %>%
# filter(yr_num == max(yr_num)) %>%
# group_by(mth_num_in_yr) %>%
# summarise_at(vars(!!metric), funs(sum)) %>%
# mutate(
# cur_yr_mths_w_data = case_when(
# !!metric != 0 | !is.na(!!metric) ~ 1,
# TRUE ~ 0
# )
# ) %>%
# pull() %>% sum()
# }
# group and summarize, if week grouping, bring wk_end_date to order by (ie: w51, w52, w1, w2)
# *** if df is already grouped and summarised, this function will simply spit the same data frame back out,
# making this function able to consume both daily gain data as well as already grouped and summarised data
if(grouping == "~wk_num_in_yr"){
df <- df %>% group_by(yr_num, !!grouping) %>%
summarise_at(vars(!!metric), funs(sum)) %>%
filter(wk_num_in_yr %in% wk_nums)
}else{
df <- df %>% group_by(yr_num, !!grouping) %>%
summarise_at(vars(!!metric), funs(sum))
}
# this template is used for new marketplaces (like CA) that do not have at least 12 months of a year's worth of data to create a table
# with 1:12 (otherwise you might get 1,2,6,7,...12)
if(grouping == "~mth_num_in_yr"){
df <- mth_num_in_yr_template %>% left_join(., df)
}
# split data into current year and previous year
if(grouping != "~yr_num"){
cur_yr_df <- df %>%
filter(yr_num == max(df$yr_num)) %>%
ungroup() %>%
select(-yr_num) %>%
rename(metric_cur_yr = !!metric)
prev_yr_df <- df %>%
filter(yr_num == max(df$yr_num) - 1) %>%
ungroup() %>%
select(-yr_num) %>%
rename(metric_prev_yr = !!metric)
}else{ # do not remove yr_num for join
cur_yr_df <- df %>%
filter(yr_num == max(df$yr_num)) %>%
ungroup() %>%
rename(metric_cur_yr = !!metric)
prev_yr_df <- df %>%
filter(yr_num == max(df$yr_num) - 1) %>%
ungroup() %>%
rename(metric_prev_yr = !!metric) %>%
mutate(yr_num = yr_num + 1)
}
# join run rate to cur_yr_df if grouping is mth_num_in_yr
if(grouping == "~mth_num_in_yr" & !missing(df_rr)){
# Preventative error handling for num vs int
# metric_class <- df %>% select(!!metric) %>% pull() %>% class()
# metric_rr_class <- df %>% select(!!metric_rr) %>% pull() %>% class()
# if(metric_class != metric_rr_class) stop(glue("Metric class {metric_class} and Run Rate class {metric_rr_class}"))
rr_mth <- df_rr$mth_num_in_yr # store month num of run rate for message
df_rr <- df_rr %>% select(yr_num, mth_num_in_yr, !!metric_rr) %>%
rename(metric_rr = !!metric_rr) %>%
mutate(cur_yr_type = "Run Rate")
cur_yr_df <- left_join(cur_yr_df, df_rr) %>%
mutate(metric_cur_yr = if_else(is.na(metric_rr), metric_cur_yr, metric_rr)) %>%
select(-metric_rr)
message(glue("Current Year Month {rr_mth} is RUN RATE")) # for visibility, echo run rate message
}
# join current year and previous year together
if(grouping == "~wk_num_in_yr"){ # ***function will join wk_num_in_yr with wk_end_date strangely if you leave `by` argument empty
df <-
full_join(
cur_yr_df,
prev_yr_df,
suffix = c("_cur_yr", "_prev_yr"),
by = c("wk_num_in_yr" = "wk_num_in_yr")
)
}else{
df <-
full_join(
cur_yr_df,
prev_yr_df,
suffix = c("_cur_yr", "_prev_yr")
)
# if(in_mth_header_op2 & grouping == "~mth_num_in_yr"){
# df <- df %>%
# mutate(
# mth_name = case_when(
# mth_num_in_yr > month(Sys.Date()) ~ paste0(mth_name, " (OP2)"),
# TRUE ~ as.character(mth_name)
# ),
# mth_num_in_yr = case_when(
# mth_num_in_yr > month(Sys.Date()) ~ paste0(mth_num_in_yr, " (OP2)"),
# TRUE ~ as.character(mth_num_in_yr)
# )
# ) %>%
# mutate_at(vars(mth_num_in_yr, mth_name), funs(as.factor(.)))
# }
}
# if goal(op2) is provided, join it
if(!missing(df_goal)){
if(grouping == "~mth_num_in_yr"){
df_goal <- df_goal %>%
select(!!grouping, !!metric_goal, -yr_num) %>%
rename(metric_goal = !!metric_goal)
}else if(grouping == "~yr_num"){ # if grouping is yr, group and summate the goal for the year
df_goal <- df_goal %>%
select(!!grouping, !!metric_goal, yr_num) %>%
group_by(yr_num) %>%
summarise_at(vars(!!metric_goal), funs(sum)) %>%
rename(metric_goal = !!metric_goal)
if(rate){
df_goal <- df_goal %>%
mutate(metric_goal = metric_goal/12)
}
}
df <-
left_join(
df,
df_goal,
by = c("mth_num_in_yr" = "mth_num_in_yr")
) %>%
mutate(goal_var = round ( ( ( ( metric_cur_yr - metric_goal ) / metric_goal ) * 100 ), 2 ) )
} # END if goal(op2) is provided, join it
# if 3+9 is provided, join it
if(!missing(df_3p9)){
df_3p9 <- df_3p9 %>% select(!!grouping, !!metric_3p9, -yr_num) %>% rename(metric_3p9 = !!metric_3p9)
df <-
left_join(
df,
df_3p9
)
}
# if 6+6 is provided, join it
if(!missing(df_6p6)){
df_6p6 <- df_6p6 %>% select(!!grouping, !!metric_6p6, -yr_num) %>% rename(metric_6p6 = !!metric_6p6)
df <-
left_join(
df,
df_6p6
)
}
# if 9+3 is provided, join it
if(!missing(df_9p3)){
df_9p3 <- df_9p3 %>% select(!!grouping, !!metric_9p3, -yr_num) %>% rename(metric_9p3 = !!metric_9p3)
df <-
left_join(
df,
df_9p3
)
}
# put predictions or goal in current year row (9+3 over 6+6, 6+6 over 3+9, etc.)
if(grouping == "~mth_num_in_yr"){ # only execute for month grouping
if(!missing(df_9p3)){ # 9 + 3
df <- df %>%
mutate(metric_cur_yr = if_else(is.na(metric_cur_yr), metric_9p3, metric_cur_yr)) %>%
select(-metric_9p3)
}else if(!missing(df_6p6)){ # 6 + 6
df <- df %>%
mutate(metric_cur_yr = if_else(is.na(metric_cur_yr), metric_6p6, metric_cur_yr)) %>%
select(-metric_6p6)
}else if(!missing(df_3p9)){ # 3 + 9
df <- df %>%
mutate(metric_cur_yr = if_else(is.na(metric_cur_yr), metric_3p9, metric_cur_yr)) %>%
select(-metric_3p9)
}else if(!missing(df_goal)){ # OP2
df <- df %>%
mutate(
cur_yr_type = if_else(!is.na(metric_cur_yr), "Actual", "OP2"),
# mth_num_in_yr = paste0(mth_num_in_yr,"|",type_cur_yr),
metric_cur_yr = if_else(is.na(metric_cur_yr), metric_goal, metric_cur_yr)
) %>%
mutate(goal_var = round ( ( ( ( metric_cur_yr - metric_goal ) / metric_goal ) * 100 ), 2 ) ) %>% # op2 var
mutate(goal_var = ifelse(goal_var == 0, NA, goal_var))
}else{ # else do nothing
NULL
}
}
# use this to determine if goal or forecasts have been provided. If one has been, do current year full year calc, else do not
goal_or_forecasts_provided = !missing(df_goal) | !missing(df_3p9) | !missing(df_6p6) | !missing(df_9p3)
# FULL YR
# calculate full yr values for mth view, store in variable as dataframe to join later: included by default
if(grouping == "~mth_num_in_yr" & full_yr){
if(!missing(df_goal)){
df_full_yr <-
df %>% select(metric_cur_yr, metric_prev_yr, metric_goal) %>%
summarise_all(funs(sum(., na.rm = TRUE))) %>%
mutate(prev_yr_var = round ( ( ( ( metric_cur_yr - metric_prev_yr ) / metric_prev_yr ) * 100 ), 2 ) ) %>% # previous yr variance
mutate(goal_var = round ( ( ( ( metric_cur_yr - metric_goal ) / metric_goal ) * 100 ), 2 ) ) %>% # goal variance
select(metric_cur_yr, metric_prev_yr, prev_yr_var, metric_goal, goal_var) # do select to enforce order
if(rate){
df_full_yr <- df_full_yr %>% mutate(metric_goal = round((metric_goal/12), digitsAfterDecimal))
}
}else{
df_full_yr <-
df %>% select(metric_cur_yr, metric_prev_yr) %>%
summarise_all(funs(sum(., na.rm = TRUE))) %>%
mutate(metric_cur_yr = NA) %>%
# %>%
# mutate(prev_yr_var = round ( ( ( ( metric_cur_yr - metric_prev_yr ) / metric_prev_yr ) * 100 ), 2 ) ) %>% # previous yr variance
select(metric_cur_yr, metric_prev_yr) # do select to enforce order
}
}
# CBR YTD
# calculate cbr_ytd values for mth view, store in variable as dataframe to join later: included by default
if(grouping == "~mth_num_in_yr" & cbr_ytd){
if(!missing(df_goal)){
df_cbr_ytd <-
df %>%
select(mth_num_in_yr, metric_cur_yr, metric_prev_yr, metric_goal) %>%
filter(mth_num_in_yr < cur_yr_mth) %>%
summarise_all(funs(sum(., na.rm = TRUE))) %>%
mutate(prev_yr_var = round ( ( ( ( metric_cur_yr - metric_prev_yr ) / metric_prev_yr ) * 100 ), 2 ) ) %>% # previous yr variance
mutate(goal_var = round ( ( ( ( metric_cur_yr - metric_goal ) / metric_goal ) * 100 ), 2 ) ) %>% # goal variance
select(metric_cur_yr, metric_prev_yr, prev_yr_var, metric_goal, goal_var) # do select to enforce order
}else{
df_cbr_ytd <-
df %>%
select(mth_num_in_yr, metric_cur_yr, metric_prev_yr) %>%
filter(mth_num_in_yr < cur_yr_mth) %>%
summarise_all(funs(sum(., na.rm = TRUE))) %>%
select(metric_cur_yr, metric_prev_yr) # do select to enforce order
}
}
# FULL YR
# divide rate full yr values (sum of monthly rates) by 12 (number of month periods)
if(grouping == "~mth_num_in_yr" & full_yr & rate){
df_full_yr <- df_full_yr %>%
mutate(
metric_cur_yr = round((metric_cur_yr / 12), digitsAfterDecimal),
metric_prev_yr = round((metric_prev_yr / 12), digitsAfterDecimal)
)
}
if(grouping == "~mth_num_in_yr" & cbr_ytd & rate){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
metric_cur_yr = round((metric_cur_yr / ( cur_yr_mth - 1) ), digitsAfterDecimal), # number of months with actual values
metric_prev_yr = round((metric_prev_yr / ( cur_yr_mth - 1) ), digitsAfterDecimal)
)
}
if(grouping == "~mth_num_in_yr" & cbr_ytd & rate & !missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
metric_goal = round((metric_goal / ( cur_yr_mth - 1) ), 2)
)
}
# FULL YR
# calculate previous year variance (could be with actuals, op2, or predictions)
if(suffix == "%"){
df <- df %>%
mutate(prev_yr_var = round ( ( metric_cur_yr - metric_prev_yr ), 2 ) ) %>% # previous year variance
arrange(!!grouping)
if(full_yr){
df_full_yr <- df_full_yr %>% mutate(prev_yr_var = round ( ( metric_cur_yr - metric_prev_yr ), 2 ))
}
if(cbr_ytd){
df_cbr_ytd <- df_cbr_ytd %>% mutate(prev_yr_var = round ( ( metric_cur_yr - metric_prev_yr ), 2 ))
}
}else{
df <- df %>%
mutate(
prev_yr_var = round ( ( ( ( metric_cur_yr - metric_prev_yr ) / metric_prev_yr ) * 100 ), 2 ) # previous year variance
) %>%
arrange(!!grouping)
if(full_yr){
df_full_yr <- df_full_yr %>%
mutate(prev_yr_var = round ( ( ( ( metric_cur_yr - metric_prev_yr ) / metric_prev_yr ) * 100 ), 2 ))
}
if(cbr_ytd){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(prev_yr_var = round ( ( ( ( metric_cur_yr - metric_prev_yr ) / metric_prev_yr ) * 100 ), 2 ))
}
}
# divide values by 1000
## df
if(div_by_1000){
if(!missing(df_goal)){
df <- df %>% mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(div_by_1000))
}else{
df <- df %>% mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(div_by_1000))
}
}
## df_full_yr
if(div_by_1000){
if(grouping == "~mth_num_in_yr" & full_yr & missing(df_goal)){
df_full_yr <- df_full_yr %>% mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(div_by_1000))
}
if(grouping == "~mth_num_in_yr" & full_yr & !missing(df_goal)){
df_full_yr <- df_full_yr %>% mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(div_by_1000))
}
}
## df_cbr_ytd
if(div_by_1000){
if(grouping == "~mth_num_in_yr" & cbr_ytd & missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>% mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(div_by_1000))
}
if(grouping == "~mth_num_in_yr" & cbr_ytd & !missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>% mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(div_by_1000))
}
}
###### round everything by digitsAfterDecimal
if(!missing(df_goal)){
df <-
df %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(round(., digitsAfterDecimal)))
}else{
df <-
df %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(round(., digitsAfterDecimal)))
}
##df_full_yr
if(grouping == "~mth_num_in_yr" & full_yr & missing(df_goal)){
df_full_yr <- df_full_yr %>% mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(round(., digitsAfterDecimal)))
}
if(grouping == "~mth_num_in_yr" & full_yr & !missing(df_goal)){
df_full_yr <- df_full_yr %>% mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(round(., digitsAfterDecimal)))
}
## df_cbr_ytd
if(grouping == "~mth_num_in_yr" & cbr_ytd & missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>% mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(round(., digitsAfterDecimal)))
}
if(grouping == "~mth_num_in_yr" & cbr_ytd & !missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>% mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(round(., digitsAfterDecimal)))
}
#sparkline # TODO, enforce order of wks <- NOTDONE and mnths <- DONE and DEBUG yr
if(spark){
spark_df <- tibble(
metric = c('metric_cur_yr', 'metric_prev_yr', 'prev_yr_var'),
chart = c(
df %>% pull(metric_cur_yr) %>% spk_chr(type='line'),
df %>% pull(metric_prev_yr) %>% spk_chr(type='line'),
df %>% pull(prev_yr_var) %>% spk_chr(type='line')
)
)
}
#pop (Period over Period change)
if(pop){
df <- df %>%
mutate(
metric_cur_yr_pop = round ( ( ( ( metric_cur_yr - lag(metric_cur_yr) ) / lag(metric_cur_yr) ) * 100 ), 2 ),
metric_prev_yr_pop = round ( ( ( ( metric_prev_yr - lag(metric_prev_yr) ) / lag(metric_prev_yr) ) * 100 ), 2 )
)
if(grouping == "~wk_num_in_yr"){
pop_df <- df %>% select(wk_num_in_yr, metric_cur_yr_pop, metric_prev_yr_pop) %>%
filter(!is.na(metric_cur_yr_pop)) %>%
filter(wk_num_in_yr == max(wk_num_in_yr))
if(abs(pop_df$metric_cur_yr_pop) > pop_threshold) message(glue("Week: pop_df$metric_cur_yr_pop (absolute value) {abs(pop_df$metric_cur_yr_pop)} > pop_threshold {pop_threshold}"))
}
if(grouping == "~mth_num_in_yr"){
pop_df <- df %>% select(mth_num_in_yr, metric_cur_yr_pop) %>%
filter(!is.na(metric_cur_yr_pop)) %>%
filter(mth_num_in_yr == max(mth_num_in_yr))
if(abs(pop_df$metric_cur_yr_pop) > pop_threshold) message(glue("Month: pop_df$metric_cur_yr_pop (absolute value) {abs(pop_df$metric_cur_yr_pop)} > pop_threshold {pop_threshold}"))
}
df <- df %>%
mutate(
metric_cur_yr_pop = paste0(metric_cur_yr_pop,"%"),
metric_prev_yr_pop = paste0(metric_prev_yr_pop,"%")
) %>%
# mutate(
# metric_cur_yr = paste(
# metric_cur_yr,
# metric_cur_yr_pop, sep = " | "),
# metric_prev_yr = paste(
# metric_prev_yr,
# metric_prev_yr_pop, sep = " | ")
# ) %>%
mutate(
metric_cur_yr = metric_cur_yr_pop,
metric_prev_yr = metric_prev_yr_pop
) %>%
select(-metric_cur_yr_pop, -metric_prev_yr_pop)
}# end pop
# apply comma formatting 17000 -> 17,000
if(commas){
# df
## add commas (17000 -> 17,000)
if(grouping == "~wk_num_in_yr"){ # no goal for wk view
df <- df %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(pretty_num))
}else{
if(!missing(df_goal)){
df <- df %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(pretty_num))
}else{
df <- df %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(pretty_num))
}
}
# full_yr
if(full_yr){
if(!missing(df_goal)){
df_full_yr <- df_full_yr %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(pretty_num))
}else{
df_full_yr <- df_full_yr %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(pretty_num))
}
}
if(cbr_ytd){
if(!missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(pretty_num))
}else{
df_cbr_ytd <- df_cbr_ytd %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(pretty_num))
}
}
}# commas
# add prefix and suffix
# for df
if(!missing(df_goal)){
df <- df %>%
mutate(
metric_cur_yr = ifelse(!is.na(metric_cur_yr), paste0(prefix, metric_cur_yr, suffix), NA),
metric_prev_yr = ifelse(!is.na(metric_prev_yr), paste0(prefix, metric_prev_yr, suffix), NA),
metric_goal = ifelse(!is.na(metric_goal), paste0(prefix, metric_goal, suffix), NA)
)
}else{
df <- df %>%
mutate(
metric_cur_yr = ifelse(!is.na(metric_cur_yr), paste0(prefix, metric_cur_yr, suffix), NA),
metric_prev_yr = ifelse(!is.na(metric_prev_yr), paste0(prefix, metric_prev_yr, suffix), NA)
)
}
# FULL YR
# for df_full_yr
if(grouping == "~mth_num_in_yr"){
if(full_yr){
if(!missing(df_goal)){
df_full_yr <- df_full_yr %>%
mutate(
metric_cur_yr = ifelse(!is.na(metric_cur_yr), paste0(prefix, metric_cur_yr, suffix), NA),
metric_prev_yr = ifelse(!is.na(metric_prev_yr), paste0(prefix, metric_prev_yr, suffix), NA),
metric_goal = ifelse(!is.na(metric_goal), paste0(prefix, metric_goal, suffix), NA)
)
}else{
df_full_yr <- df_full_yr %>%
mutate(
metric_cur_yr = ifelse(!is.na(metric_cur_yr), paste0(prefix, metric_cur_yr, suffix), NA),
metric_prev_yr = ifelse(!is.na(metric_prev_yr), paste0(prefix, metric_prev_yr, suffix), NA)
)
}
}
if(cbr_ytd){
if(!missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
metric_cur_yr = paste0(prefix, metric_cur_yr, suffix),
metric_prev_yr = paste0(prefix, metric_prev_yr, suffix),
metric_goal = paste0(prefix, metric_goal, suffix)
)
}else{
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
metric_cur_yr = paste0(prefix, metric_cur_yr, suffix),
metric_prev_yr = paste0(prefix, metric_prev_yr, suffix)
)
}
}
}
# END add prefix and suffix
# FULL YR
# handle % vs ppts for values and rates respectively for prev yr var and op2 var
if(suffix == "%"){
df <- df %>% mutate(
prev_yr_var = ifelse(!is.na(prev_yr_var), paste0(prev_yr_var, " ppts"), NA)
)
if(!missing(df_goal)){
df <- df %>% mutate(
goal_var = ifelse(!is.na(goal_var), paste0(goal_var, " ppts"), NA)
)
}
if(full_yr){
df_full_yr <- df_full_yr %>%
mutate(
prev_yr_var = ifelse(!is.na(prev_yr_var), paste0(prev_yr_var, " ppts"), NA)
)
if(!missing(df_goal)){
df_full_yr <- df_full_yr %>%
mutate(
goal_var = ifelse(!is.na(goal_var), paste0(goal_var, " ppts"), NA)
)
}
}
if(cbr_ytd){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
prev_yr_var = ifelse(!is.na(prev_yr_var), paste0(prev_yr_var, " ppts"), NA)
)
if(!missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
goal_var = ifelse(!is.na(goal_var), paste0(goal_var, " ppts"), NA)
)
}
}
}else{
df <- df %>% mutate(
prev_yr_var = ifelse(!is.na(prev_yr_var), paste0(prev_yr_var, "%"), NA)
)
if(!missing(df_goal)){
df <- df %>% mutate(
goal_var = ifelse(!is.na(goal_var), paste0(goal_var, "%"), NA)
)
}
if(full_yr){
df_full_yr <- df_full_yr %>%
mutate(
prev_yr_var = ifelse(!is.na(prev_yr_var), paste0(prev_yr_var, "%"), NA)
)
if(!missing(df_goal)){
df_full_yr <- df_full_yr %>%
mutate(
goal_var = ifelse(!is.na(goal_var), paste0(goal_var, "%"), NA)
)
}
}
if(cbr_ytd){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
prev_yr_var = ifelse(!is.na(prev_yr_var), paste0(prev_yr_var, "%"), NA)
)
if(!missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
goal_var = ifelse(!is.na(goal_var), paste0(goal_var, "%"), NA)
)
}
}
}
## wrap negative var numbers in parenthesis (ie: -7 -> (7))
if(neg_var_paren){
if(grouping == "~wk_num_in_yr"){ # no goal var for wk view
df <- df %>%
mutate_at(
vars(prev_yr_var), funs(neg_paren)
) #neg_paren() in R/helpers.R
}else{
if(!missing(df_goal)){
df <- df %>%
mutate_at(
vars(prev_yr_var, goal_var), funs(neg_paren))
}else{
df <- df %>%
mutate_at(
vars(prev_yr_var), funs(neg_paren))
}
}
#df_full_yr
if(full_yr){
if(!missing(df_goal)){
df_full_yr <- df_full_yr %>%
mutate_at(
vars(prev_yr_var, goal_var), funs(neg_paren))
}else{
df_full_yr <- df_full_yr %>%
mutate_at(
vars(prev_yr_var), funs(neg_paren))
}
}
#df_cbr_ytd
if(cbr_ytd){
if(!missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>%
mutate_at(
vars(prev_yr_var, goal_var), funs(neg_paren)
)
}else{
df_cbr_ytd <- df_cbr_ytd %>%
mutate_at(
vars(prev_yr_var), funs(neg_paren)
)
}
}
}# neg_val_paren
# define order for metrics to display in output
ordering_array <- c('metric_cur_yr', 'metric_prev_yr', 'prev_yr_var', 'metric_goal', 'goal_var')
#### transform from long to wide/horizontal view ####
if(grouping == '~wk_num_in_yr'){ # wk
df <- df %>%
gather(metric, value, -!!grouping) %>%
spread(!!grouping, value) %>%
arrange(
metric = ordered(metric, levels = ordering_array)
) %>%
select(c("metric", wk_nums)) # orders the columns so the wks are chronological (ie: 51 52 1 2), else they will display (1 2 51 52)
# add 'w' to week column names
names(df) <- c('metric', paste0("w",wk_nums))
}else{ # mth & yr
df <- df %>%
# select(-cur_yr_type) %>%
select(-mth_name) %>% ######### throws warning because of the factor order of mth_names if not removed
gather(metric, value, -!!grouping) %>%
spread(!!grouping, value) %>%
arrange(
metric = ordered(metric, levels = ordering_array)
)
# if(grouping == "~mth_num_in_yr"){ ## forces order of months
# df <- df %>% select(
# metric, starts_with("1|"), starts_with("2|"), starts_with("3|"), starts_with("4|"),
# starts_with("5|"), starts_with("6|"), starts_with("7|"), starts_with("8|"),
# starts_with("9|"), starts_with("10|"), starts_with("11|"), starts_with("12|")
# )
# }
}
# add week start dates to week column (to be header)
if(week_start_dates & grouping == "~wk_num_in_yr"){
names(df)[2:5] <- paste(paste0("w",wk_nums), wk_start_dates %>% as.character(), sep = "|")
}
# join df_cbr_ytd to mth data
if(cbr_ytd){
df <- left_join(df, df_cbr_ytd %>% gather(metric, `YTD`), by = c('metric' = 'metric'))
}
# FULL YR
# join df_full_yr to mth data
if(full_yr){
df <- left_join(df, df_full_yr %>% gather(metric, `Full Year`), by = c('metric' = 'metric'))
}
# join spark chart
if(spark){
df <- left_join(df, spark_df, by = c('metric' = 'metric'))
}
#if op2_and_var_ph (op2 and variance place holder) == TRUE add placeholder lines
if(op2_and_var_ph == TRUE){
ph <- tibble(metric = c('metric_cur_yr', 'metric_prev_yr', 'prev_yr_var', 'metric_goal', 'goal_var'))
df <- left_join(ph, df, by = c('metric' = 'metric'))
}
# if new name is provided, rename metric labels with respect to if goal (op2) is provided
# if(!is.null(new_name)){
# if(!missing(df_goal)){
# df <- df %>% mutate(
# metric = c(new_name, "Prior Year", "Variance vs. Prior Year", "OP2 Plan", "Variance vs. Plan")
# )
# }else(
# df <- df %>% mutate(
# metric = c(new_name, "Prior Year", "Variance vs. Prior Year")
# )
# )
# }
if(!is.null(new_name)){
df <- df %>% mutate(
metric = c(new_name, "Prior Year", "Variance vs. Prior Year", "OP2 Plan", "Variance vs. Plan")
)
}
# if yr grouping, rename column name from current year number to 'YTD' (ie: `2018` -> `YTD`)
if(grouping == "~yr_num"){
names(df) = c("metric", "YTD")
}
if(grouping == "~mth_num_in_yr" & month_names){
names(df)[2:13] <- month.abb
if(in_mth_header_op2){
month(Sys.Date()) + 2 -> start_pos
names(df)[(start_pos-1):13] <- paste0(names(df)[(start_pos-1):13], " (OP2)")
}
}
# if(grouping == "~mth_num_in_yr" & in_mth_header_op2){
# month(Sys.Date()) + 2
# names(df)[(month(Sys.Date()) + 1):13] <- paste0(names(df), " (OP2)")
# }
# return data frame
df
}
pkopps/biview documentation built on May 22, 2019, 2:48 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' Core function of wmy_1e, wmy_3e, & my_2e
#'
#' @param df data frame containing metric
#' @param metric column name from df
#' @param grouping time diminesion column name (wk_num_in_yr, mth_num_in_yr, yr_num)
#' @param df_rr data frame containing run rate
#' @param metric_rr column name from df_rr
#' @param df_goal data frame containing metric goal
#' @param metric_goal column name from df_goal
#' @param df_3p9 data frame containing metric prediction
#' @param metric_3p9 column name from df_3p9
#' @param df_6p6 data frame containing metric prediction
#' @param metric_6p6 column name from df_6p6
#' @param df_9p3 data frame containing metric prediction
#' @param metric_9p3 column name from df_9p3
#' @param full_yr logical. Inlcude full year summation column for month view
#' @param cbr_ytd logical. Inlcude YTD definition for CBR : Actual values from last completed month
#' @param rate logical. Adjust logic to handle full year for rates
#' @param new_name name for metric output. Also creates new labels for previous year, previous year variance, etc.
#' @param commas format values with commas. ie: 1234000 -> 1,234,000
#' @param neg_var_paren format variance values with parenthesis. ie: -40.4 -> (40.4)
#' @param div_by_1000 also an accounting practice; divide all value by 1000. ie: 1234000 -> 1234.00
#' @param prefix add prefix to values. ie: 2000 -> $2000
#' @param suffix add suffix to values. ie: 20.54 -> 20.54\%
#' @param spark logical should a spark chart be added as a column in the output
#' @param pop logical stands for Period over Period. Include percent change from previous period (ie: week 4 to week 5) next to value
#'
#' @examples
#'## week view
#'fun(
#' performance,
#' revenue,
#' wk_num_in_yr,
#' new_name = "Revenue",
#' commas = TRUE,
#' div_by_1000 = FALSE,
#' full_yr = FALSE,
#' prefix = "$"
#')
#'
#'## month view
#'fun(
#' performance,
#' revenue,
#' mth_num_in_yr,
#' new_name = "Revenue",
#' commas = TRUE,
#' div_by_1000 = FALSE,
#' full_yr = FALSE,
#' prefix = "$"
#' )
fun <- function(
df,
metric,
grouping,
df_rr,
metric_rr,
df_goal,
metric_goal,
df_3p9,
metric_3p9,
df_6p6,
metric_6p6,
df_9p3,
metric_9p3,
weeks_back = 4,
week_end_dates = FALSE,
week_start_dates = TRUE,
cbr_ytd = FALSE,
full_yr = FALSE,
rate = FALSE,
new_name = NULL,
commas = FALSE,
neg_var_paren = FALSE,
div_by_1000 = FALSE,
prefix = "",
suffix = "",
spark = FALSE,
pop = FALSE,
pop_threshold = 100,
scalar = 1,
digitsAfterDecimal = 2,
op2_and_var_ph = TRUE,
month_names = TRUE,
# rr_mth_for_header =
in_mth_header_op2 = TRUE,
in_mth_header_3p9 = FALSE,
in_mth_header_6p6 = FALSE,
in_mth_header_9p3 = FALSE
){
#round sum helper fun
round_sum <- function(x){
round(sum(x, na.rm=TRUE), digitsAfterDecimal)
}
# 'enquo' args for !!/!!!
metric <- enquo(metric)
grouping <- enquo(grouping)
metric_rr <- enquo(metric_rr)
if(!missing(metric_goal)) metric_goal <- enquo(metric_goal)
# for cbr ytd
cur_yr <- max(df$yr_num)
cur_yr_mth <- month(Sys.Date())
# errors/messaging
## if missing args
if(missing(df)) stop("'df' is missing")
if(missing(grouping)) stop("'grouping' is missing")
## if illegal value TODEBUG
# if(grouping != "~wk_num_in_yr" | grouping != "~mth_num_in_yr" | grouping != "~yr_num") stop("grouping value must be: 'wk_num_in_yr', 'mth_num_in_yr' or, 'yr_num'")
## 0 record data frame
if(nrow(df) == 0) stop("empty data frame supplied")
## conflicting argument values errors/warnings
if(suffix == "%" & div_by_1000 == TRUE) warning("Divide percentage by 1000? Are you sure?")
if(grouping == "~wk_num_in_yr" & full_yr == TRUE) stop("`full_yr` = TRUE not applicable for weekly grouping")
if(grouping == "~wk_num_in_yr" & cbr_ytd == TRUE) stop("`cbr_ytd` = TRUE not applicable for weekly grouping")
if(grouping == "~wk_num_in_yr" & !missing(df_goal)) stop("goal not applicable for weekly grouping")
if(grouping == "~yr_num" & full_yr == TRUE) stop("`full_yr` = TRUE not applicable for year grouping")
if(grouping != "~mth_num_in_yr" & !missing(df_rr)) stop("run rate not applicable for groupings other than mth_num_in_yr")
# indicator variable for op2, 3+3, etc.
# if(!missing(metric_goal)){
# indicator <- "OP2"
# if(any(df_goal %>% select(!!metric_goal) %>% pull() %in% 0)) warning("Warning: '0' values in metric_goal argument\n")
# }else if(!missing(metric_3p9)){
# indicator <- "3+9"
# }else if(!missing(metric_6p6)){
# indicator <- "6+6"
# }else if(!missing(metric_9p3)){
# indicator <- "9+3"
# }else{
# indicator <- NULL
# }
# get relevant wk numbers
if(grouping == "~wk_num_in_yr"){
wk_nums <- df %>%
arrange(wk_start_date) %>%
filter(wk_start_date >= ceiling_date( ( max(wk_start_date) - (7 * weeks_back) ) ) ) %>% # controls weeks back to calculate metric
select(wk_num_in_yr) %>%
pull() %>% unique()
wk_start_dates <- df %>%
arrange(wk_start_date) %>%
filter(wk_start_date >= ceiling_date( ( max(wk_start_date) - (7 * weeks_back) ) ) ) %>%
select(wk_start_date) %>%
mutate(wk_start_date = format(wk_start_date, format = "%d-%b")) %>%
pull() %>% unique()
}
# get number of months for current year ONLY (previous year will always be 12) for rate = TRUE
# if((grouping == "~mth_num_in_yr" | grouping == "~yr_num") & rate == TRUE){
# cur_yr_mths_w_data <-
# df %>%
# filter(yr_num == max(yr_num)) %>%
# group_by(mth_num_in_yr) %>%
# summarise_at(vars(!!metric), funs(sum)) %>%
# mutate(
# cur_yr_mths_w_data = case_when(
# !!metric != 0 | !is.na(!!metric) ~ 1,
# TRUE ~ 0
# )
# ) %>%
# pull() %>% sum()
# }
# group and summarize, if week grouping, bring wk_end_date to order by (ie: w51, w52, w1, w2)
# *** if df is already grouped and summarised, this function will simply spit the same data frame back out,
# making this function able to consume both daily gain data as well as already grouped and summarised data
if(grouping == "~wk_num_in_yr"){
df <- df %>% group_by(yr_num, !!grouping) %>%
summarise_at(vars(!!metric), funs(sum)) %>%
filter(wk_num_in_yr %in% wk_nums)
}else{
df <- df %>% group_by(yr_num, !!grouping) %>%
summarise_at(vars(!!metric), funs(sum))
}
# this template is used for new marketplaces (like CA) that do not have at least 12 months of a year's worth of data to create a table
# with 1:12 (otherwise you might get 1,2,6,7,...12)
if(grouping == "~mth_num_in_yr"){
df <- mth_num_in_yr_template %>% left_join(., df)
}
# split data into current year and previous year
if(grouping != "~yr_num"){
cur_yr_df <- df %>%
filter(yr_num == max(df$yr_num)) %>%
ungroup() %>%
select(-yr_num) %>%
rename(metric_cur_yr = !!metric)
prev_yr_df <- df %>%
filter(yr_num == max(df$yr_num) - 1) %>%
ungroup() %>%
select(-yr_num) %>%
rename(metric_prev_yr = !!metric)
}else{ # do not remove yr_num for join
cur_yr_df <- df %>%
filter(yr_num == max(df$yr_num)) %>%
ungroup() %>%
rename(metric_cur_yr = !!metric)
prev_yr_df <- df %>%
filter(yr_num == max(df$yr_num) - 1) %>%
ungroup() %>%
rename(metric_prev_yr = !!metric) %>%
mutate(yr_num = yr_num + 1)
}
# join run rate to cur_yr_df if grouping is mth_num_in_yr
if(grouping == "~mth_num_in_yr" & !missing(df_rr)){
# Preventative error handling for num vs int
# metric_class <- df %>% select(!!metric) %>% pull() %>% class()
# metric_rr_class <- df %>% select(!!metric_rr) %>% pull() %>% class()
# if(metric_class != metric_rr_class) stop(glue("Metric class {metric_class} and Run Rate class {metric_rr_class}"))
rr_mth <- df_rr$mth_num_in_yr # store month num of run rate for message
df_rr <- df_rr %>% select(yr_num, mth_num_in_yr, !!metric_rr) %>%
rename(metric_rr = !!metric_rr) %>%
mutate(cur_yr_type = "Run Rate")
cur_yr_df <- left_join(cur_yr_df, df_rr) %>%
mutate(metric_cur_yr = if_else(is.na(metric_rr), metric_cur_yr, metric_rr)) %>%
select(-metric_rr)
message(glue("Current Year Month {rr_mth} is RUN RATE")) # for visibility, echo run rate message
}
# join current year and previous year together
if(grouping == "~wk_num_in_yr"){ # ***function will join wk_num_in_yr with wk_end_date strangely if you leave `by` argument empty
df <-
full_join(
cur_yr_df,
prev_yr_df,
suffix = c("_cur_yr", "_prev_yr"),
by = c("wk_num_in_yr" = "wk_num_in_yr")
)
}else{
df <-
full_join(
cur_yr_df,
prev_yr_df,
suffix = c("_cur_yr", "_prev_yr")
)
# if(in_mth_header_op2 & grouping == "~mth_num_in_yr"){
# df <- df %>%
# mutate(
# mth_name = case_when(
# mth_num_in_yr > month(Sys.Date()) ~ paste0(mth_name, " (OP2)"),
# TRUE ~ as.character(mth_name)
# ),
# mth_num_in_yr = case_when(
# mth_num_in_yr > month(Sys.Date()) ~ paste0(mth_num_in_yr, " (OP2)"),
# TRUE ~ as.character(mth_num_in_yr)
# )
# ) %>%
# mutate_at(vars(mth_num_in_yr, mth_name), funs(as.factor(.)))
# }
}
# if goal(op2) is provided, join it
if(!missing(df_goal)){
if(grouping == "~mth_num_in_yr"){
df_goal <- df_goal %>%
select(!!grouping, !!metric_goal, -yr_num) %>%
rename(metric_goal = !!metric_goal)
}else if(grouping == "~yr_num"){ # if grouping is yr, group and summate the goal for the year
df_goal <- df_goal %>%
select(!!grouping, !!metric_goal, yr_num) %>%
group_by(yr_num) %>%
summarise_at(vars(!!metric_goal), funs(sum)) %>%
rename(metric_goal = !!metric_goal)
if(rate){
df_goal <- df_goal %>%
mutate(metric_goal = metric_goal/12)
}
}
df <-
left_join(
df,
df_goal,
by = c("mth_num_in_yr" = "mth_num_in_yr")
) %>%
mutate(goal_var = round ( ( ( ( metric_cur_yr - metric_goal ) / metric_goal ) * 100 ), 2 ) )
} # END if goal(op2) is provided, join it
# if 3+9 is provided, join it
if(!missing(df_3p9)){
df_3p9 <- df_3p9 %>% select(!!grouping, !!metric_3p9, -yr_num) %>% rename(metric_3p9 = !!metric_3p9)
df <-
left_join(
df,
df_3p9
)
}
# if 6+6 is provided, join it
if(!missing(df_6p6)){
df_6p6 <- df_6p6 %>% select(!!grouping, !!metric_6p6, -yr_num) %>% rename(metric_6p6 = !!metric_6p6)
df <-
left_join(
df,
df_6p6
)
}
# if 9+3 is provided, join it
if(!missing(df_9p3)){
df_9p3 <- df_9p3 %>% select(!!grouping, !!metric_9p3, -yr_num) %>% rename(metric_9p3 = !!metric_9p3)
df <-
left_join(
df,
df_9p3
)
}
# put predictions or goal in current year row (9+3 over 6+6, 6+6 over 3+9, etc.)
if(grouping == "~mth_num_in_yr"){ # only execute for month grouping
if(!missing(df_9p3)){ # 9 + 3
df <- df %>%
mutate(metric_cur_yr = if_else(is.na(metric_cur_yr), metric_9p3, metric_cur_yr)) %>%
select(-metric_9p3)
}else if(!missing(df_6p6)){ # 6 + 6
df <- df %>%
mutate(metric_cur_yr = if_else(is.na(metric_cur_yr), metric_6p6, metric_cur_yr)) %>%
select(-metric_6p6)
}else if(!missing(df_3p9)){ # 3 + 9
df <- df %>%
mutate(metric_cur_yr = if_else(is.na(metric_cur_yr), metric_3p9, metric_cur_yr)) %>%
select(-metric_3p9)
}else if(!missing(df_goal)){ # OP2
df <- df %>%
mutate(
cur_yr_type = if_else(!is.na(metric_cur_yr), "Actual", "OP2"),
# mth_num_in_yr = paste0(mth_num_in_yr,"|",type_cur_yr),
metric_cur_yr = if_else(is.na(metric_cur_yr), metric_goal, metric_cur_yr)
) %>%
mutate(goal_var = round ( ( ( ( metric_cur_yr - metric_goal ) / metric_goal ) * 100 ), 2 ) ) %>% # op2 var
mutate(goal_var = ifelse(goal_var == 0, NA, goal_var))
}else{ # else do nothing
NULL
}
}
# use this to determine if goal or forecasts have been provided. If one has been, do current year full year calc, else do not
goal_or_forecasts_provided = !missing(df_goal) | !missing(df_3p9) | !missing(df_6p6) | !missing(df_9p3)
# FULL YR
# calculate full yr values for mth view, store in variable as dataframe to join later: included by default
if(grouping == "~mth_num_in_yr" & full_yr){
if(!missing(df_goal)){
df_full_yr <-
df %>% select(metric_cur_yr, metric_prev_yr, metric_goal) %>%
summarise_all(funs(sum(., na.rm = TRUE))) %>%
mutate(prev_yr_var = round ( ( ( ( metric_cur_yr - metric_prev_yr ) / metric_prev_yr ) * 100 ), 2 ) ) %>% # previous yr variance
mutate(goal_var = round ( ( ( ( metric_cur_yr - metric_goal ) / metric_goal ) * 100 ), 2 ) ) %>% # goal variance
select(metric_cur_yr, metric_prev_yr, prev_yr_var, metric_goal, goal_var) # do select to enforce order
if(rate){
df_full_yr <- df_full_yr %>% mutate(metric_goal = round((metric_goal/12), digitsAfterDecimal))
}
}else{
df_full_yr <-
df %>% select(metric_cur_yr, metric_prev_yr) %>%
summarise_all(funs(sum(., na.rm = TRUE))) %>%
mutate(metric_cur_yr = NA) %>%
# %>%
# mutate(prev_yr_var = round ( ( ( ( metric_cur_yr - metric_prev_yr ) / metric_prev_yr ) * 100 ), 2 ) ) %>% # previous yr variance
select(metric_cur_yr, metric_prev_yr) # do select to enforce order
}
}
# CBR YTD
# calculate cbr_ytd values for mth view, store in variable as dataframe to join later: included by default
if(grouping == "~mth_num_in_yr" & cbr_ytd){
if(!missing(df_goal)){
df_cbr_ytd <-
df %>%
select(mth_num_in_yr, metric_cur_yr, metric_prev_yr, metric_goal) %>%
filter(mth_num_in_yr < cur_yr_mth) %>%
summarise_all(funs(sum(., na.rm = TRUE))) %>%
mutate(prev_yr_var = round ( ( ( ( metric_cur_yr - metric_prev_yr ) / metric_prev_yr ) * 100 ), 2 ) ) %>% # previous yr variance
mutate(goal_var = round ( ( ( ( metric_cur_yr - metric_goal ) / metric_goal ) * 100 ), 2 ) ) %>% # goal variance
select(metric_cur_yr, metric_prev_yr, prev_yr_var, metric_goal, goal_var) # do select to enforce order
}else{
df_cbr_ytd <-
df %>%
select(mth_num_in_yr, metric_cur_yr, metric_prev_yr) %>%
filter(mth_num_in_yr < cur_yr_mth) %>%
summarise_all(funs(sum(., na.rm = TRUE))) %>%
select(metric_cur_yr, metric_prev_yr) # do select to enforce order
}
}
# FULL YR
# divide rate full yr values (sum of monthly rates) by 12 (number of month periods)
if(grouping == "~mth_num_in_yr" & full_yr & rate){
df_full_yr <- df_full_yr %>%
mutate(
metric_cur_yr = round((metric_cur_yr / 12), digitsAfterDecimal),
metric_prev_yr = round((metric_prev_yr / 12), digitsAfterDecimal)
)
}
if(grouping == "~mth_num_in_yr" & cbr_ytd & rate){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
metric_cur_yr = round((metric_cur_yr / ( cur_yr_mth - 1) ), digitsAfterDecimal), # number of months with actual values
metric_prev_yr = round((metric_prev_yr / ( cur_yr_mth - 1) ), digitsAfterDecimal)
)
}
if(grouping == "~mth_num_in_yr" & cbr_ytd & rate & !missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
metric_goal = round((metric_goal / ( cur_yr_mth - 1) ), 2)
)
}
# FULL YR
# calculate previous year variance (could be with actuals, op2, or predictions)
if(suffix == "%"){
df <- df %>%
mutate(prev_yr_var = round ( ( metric_cur_yr - metric_prev_yr ), 2 ) ) %>% # previous year variance
arrange(!!grouping)
if(full_yr){
df_full_yr <- df_full_yr %>% mutate(prev_yr_var = round ( ( metric_cur_yr - metric_prev_yr ), 2 ))
}
if(cbr_ytd){
df_cbr_ytd <- df_cbr_ytd %>% mutate(prev_yr_var = round ( ( metric_cur_yr - metric_prev_yr ), 2 ))
}
}else{
df <- df %>%
mutate(
prev_yr_var = round ( ( ( ( metric_cur_yr - metric_prev_yr ) / metric_prev_yr ) * 100 ), 2 ) # previous year variance
) %>%
arrange(!!grouping)
if(full_yr){
df_full_yr <- df_full_yr %>%
mutate(prev_yr_var = round ( ( ( ( metric_cur_yr - metric_prev_yr ) / metric_prev_yr ) * 100 ), 2 ))
}
if(cbr_ytd){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(prev_yr_var = round ( ( ( ( metric_cur_yr - metric_prev_yr ) / metric_prev_yr ) * 100 ), 2 ))
}
}
# divide values by 1000
## df
if(div_by_1000){
if(!missing(df_goal)){
df <- df %>% mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(div_by_1000))
}else{
df <- df %>% mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(div_by_1000))
}
}
## df_full_yr
if(div_by_1000){
if(grouping == "~mth_num_in_yr" & full_yr & missing(df_goal)){
df_full_yr <- df_full_yr %>% mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(div_by_1000))
}
if(grouping == "~mth_num_in_yr" & full_yr & !missing(df_goal)){
df_full_yr <- df_full_yr %>% mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(div_by_1000))
}
}
## df_cbr_ytd
if(div_by_1000){
if(grouping == "~mth_num_in_yr" & cbr_ytd & missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>% mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(div_by_1000))
}
if(grouping == "~mth_num_in_yr" & cbr_ytd & !missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>% mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(div_by_1000))
}
}
###### round everything by digitsAfterDecimal
if(!missing(df_goal)){
df <-
df %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(round(., digitsAfterDecimal)))
}else{
df <-
df %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(round(., digitsAfterDecimal)))
}
##df_full_yr
if(grouping == "~mth_num_in_yr" & full_yr & missing(df_goal)){
df_full_yr <- df_full_yr %>% mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(round(., digitsAfterDecimal)))
}
if(grouping == "~mth_num_in_yr" & full_yr & !missing(df_goal)){
df_full_yr <- df_full_yr %>% mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(round(., digitsAfterDecimal)))
}
## df_cbr_ytd
if(grouping == "~mth_num_in_yr" & cbr_ytd & missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>% mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(round(., digitsAfterDecimal)))
}
if(grouping == "~mth_num_in_yr" & cbr_ytd & !missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>% mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(round(., digitsAfterDecimal)))
}
#sparkline # TODO, enforce order of wks <- NOTDONE and mnths <- DONE and DEBUG yr
if(spark){
spark_df <- tibble(
metric = c('metric_cur_yr', 'metric_prev_yr', 'prev_yr_var'),
chart = c(
df %>% pull(metric_cur_yr) %>% spk_chr(type='line'),
df %>% pull(metric_prev_yr) %>% spk_chr(type='line'),
df %>% pull(prev_yr_var) %>% spk_chr(type='line')
)
)
}
#pop (Period over Period change)
if(pop){
df <- df %>%
mutate(
metric_cur_yr_pop = round ( ( ( ( metric_cur_yr - lag(metric_cur_yr) ) / lag(metric_cur_yr) ) * 100 ), 2 ),
metric_prev_yr_pop = round ( ( ( ( metric_prev_yr - lag(metric_prev_yr) ) / lag(metric_prev_yr) ) * 100 ), 2 )
)
if(grouping == "~wk_num_in_yr"){
pop_df <- df %>% select(wk_num_in_yr, metric_cur_yr_pop, metric_prev_yr_pop) %>%
filter(!is.na(metric_cur_yr_pop)) %>%
filter(wk_num_in_yr == max(wk_num_in_yr))
if(abs(pop_df$metric_cur_yr_pop) > pop_threshold) message(glue("Week: pop_df$metric_cur_yr_pop (absolute value) {abs(pop_df$metric_cur_yr_pop)} > pop_threshold {pop_threshold}"))
}
if(grouping == "~mth_num_in_yr"){
pop_df <- df %>% select(mth_num_in_yr, metric_cur_yr_pop) %>%
filter(!is.na(metric_cur_yr_pop)) %>%
filter(mth_num_in_yr == max(mth_num_in_yr))
if(abs(pop_df$metric_cur_yr_pop) > pop_threshold) message(glue("Month: pop_df$metric_cur_yr_pop (absolute value) {abs(pop_df$metric_cur_yr_pop)} > pop_threshold {pop_threshold}"))
}
df <- df %>%
mutate(
metric_cur_yr_pop = paste0(metric_cur_yr_pop,"%"),
metric_prev_yr_pop = paste0(metric_prev_yr_pop,"%")
) %>%
# mutate(
# metric_cur_yr = paste(
# metric_cur_yr,
# metric_cur_yr_pop, sep = " | "),
# metric_prev_yr = paste(
# metric_prev_yr,
# metric_prev_yr_pop, sep = " | ")
# ) %>%
mutate(
metric_cur_yr = metric_cur_yr_pop,
metric_prev_yr = metric_prev_yr_pop
) %>%
select(-metric_cur_yr_pop, -metric_prev_yr_pop)
}# end pop
# apply comma formatting 17000 -> 17,000
if(commas){
# df
## add commas (17000 -> 17,000)
if(grouping == "~wk_num_in_yr"){ # no goal for wk view
df <- df %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(pretty_num))
}else{
if(!missing(df_goal)){
df <- df %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(pretty_num))
}else{
df <- df %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(pretty_num))
}
}
# full_yr
if(full_yr){
if(!missing(df_goal)){
df_full_yr <- df_full_yr %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(pretty_num))
}else{
df_full_yr <- df_full_yr %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(pretty_num))
}
}
if(cbr_ytd){
if(!missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr, metric_goal), funs(pretty_num))
}else{
df_cbr_ytd <- df_cbr_ytd %>%
mutate_at(vars(metric_cur_yr, metric_prev_yr), funs(pretty_num))
}
}
}# commas
# add prefix and suffix
# for df
if(!missing(df_goal)){
df <- df %>%
mutate(
metric_cur_yr = ifelse(!is.na(metric_cur_yr), paste0(prefix, metric_cur_yr, suffix), NA),
metric_prev_yr = ifelse(!is.na(metric_prev_yr), paste0(prefix, metric_prev_yr, suffix), NA),
metric_goal = ifelse(!is.na(metric_goal), paste0(prefix, metric_goal, suffix), NA)
)
}else{
df <- df %>%
mutate(
metric_cur_yr = ifelse(!is.na(metric_cur_yr), paste0(prefix, metric_cur_yr, suffix), NA),
metric_prev_yr = ifelse(!is.na(metric_prev_yr), paste0(prefix, metric_prev_yr, suffix), NA)
)
}
# FULL YR
# for df_full_yr
if(grouping == "~mth_num_in_yr"){
if(full_yr){
if(!missing(df_goal)){
df_full_yr <- df_full_yr %>%
mutate(
metric_cur_yr = ifelse(!is.na(metric_cur_yr), paste0(prefix, metric_cur_yr, suffix), NA),
metric_prev_yr = ifelse(!is.na(metric_prev_yr), paste0(prefix, metric_prev_yr, suffix), NA),
metric_goal = ifelse(!is.na(metric_goal), paste0(prefix, metric_goal, suffix), NA)
)
}else{
df_full_yr <- df_full_yr %>%
mutate(
metric_cur_yr = ifelse(!is.na(metric_cur_yr), paste0(prefix, metric_cur_yr, suffix), NA),
metric_prev_yr = ifelse(!is.na(metric_prev_yr), paste0(prefix, metric_prev_yr, suffix), NA)
)
}
}
if(cbr_ytd){
if(!missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
metric_cur_yr = paste0(prefix, metric_cur_yr, suffix),
metric_prev_yr = paste0(prefix, metric_prev_yr, suffix),
metric_goal = paste0(prefix, metric_goal, suffix)
)
}else{
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
metric_cur_yr = paste0(prefix, metric_cur_yr, suffix),
metric_prev_yr = paste0(prefix, metric_prev_yr, suffix)
)
}
}
}
# END add prefix and suffix
# FULL YR
# handle % vs ppts for values and rates respectively for prev yr var and op2 var
if(suffix == "%"){
df <- df %>% mutate(
prev_yr_var = ifelse(!is.na(prev_yr_var), paste0(prev_yr_var, " ppts"), NA)
)
if(!missing(df_goal)){
df <- df %>% mutate(
goal_var = ifelse(!is.na(goal_var), paste0(goal_var, " ppts"), NA)
)
}
if(full_yr){
df_full_yr <- df_full_yr %>%
mutate(
prev_yr_var = ifelse(!is.na(prev_yr_var), paste0(prev_yr_var, " ppts"), NA)
)
if(!missing(df_goal)){
df_full_yr <- df_full_yr %>%
mutate(
goal_var = ifelse(!is.na(goal_var), paste0(goal_var, " ppts"), NA)
)
}
}
if(cbr_ytd){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
prev_yr_var = ifelse(!is.na(prev_yr_var), paste0(prev_yr_var, " ppts"), NA)
)
if(!missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
goal_var = ifelse(!is.na(goal_var), paste0(goal_var, " ppts"), NA)
)
}
}
}else{
df <- df %>% mutate(
prev_yr_var = ifelse(!is.na(prev_yr_var), paste0(prev_yr_var, "%"), NA)
)
if(!missing(df_goal)){
df <- df %>% mutate(
goal_var = ifelse(!is.na(goal_var), paste0(goal_var, "%"), NA)
)
}
if(full_yr){
df_full_yr <- df_full_yr %>%
mutate(
prev_yr_var = ifelse(!is.na(prev_yr_var), paste0(prev_yr_var, "%"), NA)
)
if(!missing(df_goal)){
df_full_yr <- df_full_yr %>%
mutate(
goal_var = ifelse(!is.na(goal_var), paste0(goal_var, "%"), NA)
)
}
}
if(cbr_ytd){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
prev_yr_var = ifelse(!is.na(prev_yr_var), paste0(prev_yr_var, "%"), NA)
)
if(!missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>%
mutate(
goal_var = ifelse(!is.na(goal_var), paste0(goal_var, "%"), NA)
)
}
}
}
## wrap negative var numbers in parenthesis (ie: -7 -> (7))
if(neg_var_paren){
if(grouping == "~wk_num_in_yr"){ # no goal var for wk view
df <- df %>%
mutate_at(
vars(prev_yr_var), funs(neg_paren)
) #neg_paren() in R/helpers.R
}else{
if(!missing(df_goal)){
df <- df %>%
mutate_at(
vars(prev_yr_var, goal_var), funs(neg_paren))
}else{
df <- df %>%
mutate_at(
vars(prev_yr_var), funs(neg_paren))
}
}
#df_full_yr
if(full_yr){
if(!missing(df_goal)){
df_full_yr <- df_full_yr %>%
mutate_at(
vars(prev_yr_var, goal_var), funs(neg_paren))
}else{
df_full_yr <- df_full_yr %>%
mutate_at(
vars(prev_yr_var), funs(neg_paren))
}
}
#df_cbr_ytd
if(cbr_ytd){
if(!missing(df_goal)){
df_cbr_ytd <- df_cbr_ytd %>%
mutate_at(
vars(prev_yr_var, goal_var), funs(neg_paren)
)
}else{
df_cbr_ytd <- df_cbr_ytd %>%
mutate_at(
vars(prev_yr_var), funs(neg_paren)
)
}
}
}# neg_val_paren
# define order for metrics to display in output
ordering_array <- c('metric_cur_yr', 'metric_prev_yr', 'prev_yr_var', 'metric_goal', 'goal_var')
#### transform from long to wide/horizontal view ####
if(grouping == '~wk_num_in_yr'){ # wk
df <- df %>%
gather(metric, value, -!!grouping) %>%
spread(!!grouping, value) %>%
arrange(
metric = ordered(metric, levels = ordering_array)
) %>%
select(c("metric", wk_nums)) # orders the columns so the wks are chronological (ie: 51 52 1 2), else they will display (1 2 51 52)
# add 'w' to week column names
names(df) <- c('metric', paste0("w",wk_nums))
}else{ # mth & yr
df <- df %>%
# select(-cur_yr_type) %>%
select(-mth_name) %>% ######### throws warning because of the factor order of mth_names if not removed
gather(metric, value, -!!grouping) %>%
spread(!!grouping, value) %>%
arrange(
metric = ordered(metric, levels = ordering_array)
)
# if(grouping == "~mth_num_in_yr"){ ## forces order of months
# df <- df %>% select(
# metric, starts_with("1|"), starts_with("2|"), starts_with("3|"), starts_with("4|"),
# starts_with("5|"), starts_with("6|"), starts_with("7|"), starts_with("8|"),
# starts_with("9|"), starts_with("10|"), starts_with("11|"), starts_with("12|")
# )
# }
}
# add week start dates to week column (to be header)
if(week_start_dates & grouping == "~wk_num_in_yr"){
names(df)[2:5] <- paste(paste0("w",wk_nums), wk_start_dates %>% as.character(), sep = "|")
}
# join df_cbr_ytd to mth data
if(cbr_ytd){
df <- left_join(df, df_cbr_ytd %>% gather(metric, `YTD`), by = c('metric' = 'metric'))
}
# FULL YR
# join df_full_yr to mth data
if(full_yr){
df <- left_join(df, df_full_yr %>% gather(metric, `Full Year`), by = c('metric' = 'metric'))
}
# join spark chart
if(spark){
df <- left_join(df, spark_df, by = c('metric' = 'metric'))
}
#if op2_and_var_ph (op2 and variance place holder) == TRUE add placeholder lines
if(op2_and_var_ph == TRUE){
ph <- tibble(metric = c('metric_cur_yr', 'metric_prev_yr', 'prev_yr_var', 'metric_goal', 'goal_var'))
df <- left_join(ph, df, by = c('metric' = 'metric'))
}
# if new name is provided, rename metric labels with respect to if goal (op2) is provided
# if(!is.null(new_name)){
# if(!missing(df_goal)){
# df <- df %>% mutate(
# metric = c(new_name, "Prior Year", "Variance vs. Prior Year", "OP2 Plan", "Variance vs. Plan")
# )
# }else(
# df <- df %>% mutate(
# metric = c(new_name, "Prior Year", "Variance vs. Prior Year")
# )
# )
# }
if(!is.null(new_name)){
df <- df %>% mutate(
metric = c(new_name, "Prior Year", "Variance vs. Prior Year", "OP2 Plan", "Variance vs. Plan")
)
}
# if yr grouping, rename column name from current year number to 'YTD' (ie: `2018` -> `YTD`)
if(grouping == "~yr_num"){
names(df) = c("metric", "YTD")
}
if(grouping == "~mth_num_in_yr" & month_names){
names(df)[2:13] <- month.abb
if(in_mth_header_op2){
month(Sys.Date()) + 2 -> start_pos
names(df)[(start_pos-1):13] <- paste0(names(df)[(start_pos-1):13], " (OP2)")
}
}
# if(grouping == "~mth_num_in_yr" & in_mth_header_op2){
# month(Sys.Date()) + 2
# names(df)[(month(Sys.Date()) + 1):13] <- paste0(names(df), " (OP2)")
# }
# return data frame
df
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.