closes #26, #27, #28

DESCRIPTION

@@ -20,6 +20,7 @@ Imports:
     forcats,
     ggplot2,
     grDevices,
+    ggthemes,
     lubridate,
     magrittr,
     purrr,

NAMESPACE

@@ -15,6 +15,9 @@ export(rfm_hist_data)
 export(rfm_histograms)
 export(rfm_launch_app)
 export(rfm_order_dist)
+export(rfm_plot_median_frequency)
+export(rfm_plot_median_monetary)
+export(rfm_plot_median_recency)
 export(rfm_rf_plot)
 export(rfm_rm_plot)
 export(rfm_segment)
@@ -23,17 +26,20 @@ export(rfm_table_customer_2)
 export(rfm_table_order)
 importFrom(RColorBrewer,brewer.pal)
 importFrom(assertthat,are_equal)
+importFrom(dplyr,arrange)
 importFrom(dplyr,bind_rows)
 importFrom(dplyr,count)
 importFrom(dplyr,enquo)
 importFrom(dplyr,group_by)
 importFrom(dplyr,mutate)
 importFrom(dplyr,n)
 importFrom(dplyr,pull)
+importFrom(dplyr,rename)
 importFrom(dplyr,select)
 importFrom(dplyr,summarise)
 importFrom(forcats,fct_unique)
 importFrom(ggplot2,aes)
+importFrom(ggplot2,coord_flip)
 importFrom(ggplot2,element_blank)
 importFrom(ggplot2,element_text)
 importFrom(ggplot2,facet_grid)
@@ -53,6 +59,7 @@ importFrom(ggplot2,theme)
 importFrom(ggplot2,xlab)
 importFrom(ggplot2,ylab)
 importFrom(ggplot2,ylim)
+importFrom(ggthemes,calc_pal)
 importFrom(grDevices,topo.colors)
 importFrom(lubridate,ddays)
 importFrom(lubridate,is.POSIXct)

R/rfm-segment.R

@@ -52,6 +52,7 @@ rfm_segment <- function(data, segment_names = NULL, recency_lower = NULL,
   }
 
   rfm_score_table$segment[is.na(rfm_score_table$segment)] <- "Others"
+  rfm_score_table$segment[rfm_score_table$segment == 1]   <- "Others"
 
   rfm_score_table %>%
     select(customer_id, segment, rfm_score, transaction_count, recency_days,
@@ -60,3 +61,124 @@ rfm_segment <- function(data, segment_names = NULL, recency_lower = NULL,
 
 
 }
+
+#' Segmentation plots
+#'
+#' Segment wise median recency, frequency & monetary value plot.
+#'
+#' @param rfm_segment_table Output from \code{rfm_segment}.
+#'
+#' @examples
+#' analysis_date <- lubridate::as_date('2006-12-31', tz = 'UTC')
+#' rfm_result <- rfm_table_order(rfm_data_orders, customer_id, order_date,
+#' revenue, analysis_date)
+#'
+#' segment_names <- c("Champions", "Loyal Customers", "Potential Loyalist",
+#'   "New Customers", "Promising", "Need Attention", "About To Sleep",
+#'   "At Risk", "Can't Lose Them", "Lost")
+#'
+#' recency_lower <- c(4, 2, 3, 4, 3, 2, 2, 1, 1, 1)
+#' recency_upper <- c(5, 5, 5, 5, 4, 3, 3, 2, 1, 2)
+#' frequency_lower <- c(4, 3, 1, 1, 1, 2, 1, 2, 4, 1)
+#' frequency_upper <- c(5, 5, 3, 1, 1, 3, 2, 5, 5, 2)
+#' monetary_lower <- c(4, 3, 1, 1, 1, 2, 1, 2, 4, 1)
+#' monetary_upper <- c(5, 5, 3, 1, 1, 3, 2, 5, 5, 2)
+#'
+#' segments <- rfm_segment(rfm_result, segment_names, recency_lower,
+#' recency_upper, frequency_lower, frequency_upper, monetary_lower,
+#' monetary_upper)
+#'
+#' rfm_plot_median_recency(segments)
+#' rfm_plot_median_frequency(segments)
+#' rfm_plot_median_monetary(segments)
+#'
+#' @importFrom dplyr arrange rename
+#' @importFrom ggplot2 coord_flip
+#' @importFrom ggthemes calc_pal
+#'
+#' @export
+#'
+rfm_plot_median_recency <- function(rfm_segment_table) {
+
+  data <-
+    rfm_segment_table %>%
+    group_by(segment) %>%
+    select(segment, recency_days) %>%
+    summarize(median(recency_days)) %>%
+    rename(segment = segment, avg_recency = `median(recency_days)`) %>%
+    arrange(avg_recency)
+
+  n_fill <- nrow(data)
+
+  p <-
+    ggplot(data, aes(segment, avg_recency)) +
+    geom_bar(stat = "identity", fill = calc_pal()(n_fill)) +
+    xlab("Segment") + ylab("Median Recency") +
+    ggtitle("Median Recency by Segment") +
+    coord_flip() +
+    theme(
+      plot.title = element_text(hjust = 0.5)
+    )
+
+  print(p)
+
+}
+
+#' @rdname rfm_plot_median_recency
+#' @export
+#'
+rfm_plot_median_frequency <- function(rfm_segment_table) {
+
+  data <-
+    rfm_segment_table %>%
+    group_by(segment) %>%
+    select(segment, transaction_count) %>%
+    summarize(median(transaction_count)) %>%
+    rename(segment = segment, avg_frequency = `median(transaction_count)`) %>%
+    arrange(avg_frequency)
+
+  n_fill <- nrow(data)
+
+  p <-
+    ggplot(data, aes(segment, avg_frequency)) +
+    geom_bar(stat = "identity", fill = calc_pal()(n_fill)) +
+    xlab("Segment") + ylab("Median Frequency") +
+    ggtitle("Median Frequency by Segment") +
+    coord_flip() +
+    theme(
+      plot.title = element_text(hjust = 0.5)
+    )
+
+  print(p)
+
+}
+
+
+#' @rdname rfm_plot_median_recency
+#' @export
+#'
+rfm_plot_median_monetary <- function(rfm_segment_table) {
+
+  data <-
+    rfm_segment_table %>%
+    group_by(segment) %>%
+    select(segment, amount) %>%
+    summarize(median(amount)) %>%
+    rename(segment = segment, avg_monetary = `median(amount)`) %>%
+    arrange(avg_monetary)
+
+  n_fill <- nrow(data)
+
+  p <-
+    ggplot(data, aes(segment, avg_monetary)) +
+    geom_bar(stat = "identity", fill = calc_pal()(n_fill)) +
+    xlab("Segment") + ylab("Median Monetary Value") +
+    ggtitle("Median Monetary Value by Segment") +
+    coord_flip() +
+    theme(
+      plot.title = element_text(hjust = 0.5)
+    )
+
+  print(p)
+
+}

_pkgdown.yml

@@ -56,7 +56,8 @@ reference:
 - title: Segmentation
 
   contents:
-  - rfm_segment  
+  - rfm_segment
+  - rfm_plot_median_recency  
 
 - title: Plots