diff --git a/DESCRIPTION b/DESCRIPTION
index 68945666..00fb3a2f 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -20,6 +20,7 @@ Imports:
forcats,
ggplot2,
grDevices,
+ ggthemes,
lubridate,
magrittr,
purrr,
diff --git a/NAMESPACE b/NAMESPACE
index 2301d3c1..7edc2359 100644
--- a/NAMESPACE
+++ b/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,6 +26,7 @@ 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)
@@ -30,10 +34,12 @@ 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)
diff --git a/R/rfm-segment.R b/R/rfm-segment.R
index 38b0f045..14552c15 100644
--- a/R/rfm-segment.R
+++ b/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)
+
+}
diff --git a/_pkgdown.yml b/_pkgdown.yml
index 5d50d8e0..bf158284 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -56,7 +56,8 @@ reference:
- title: Segmentation
contents:
- - rfm_segment
+ - rfm_segment
+ - rfm_plot_median_recency
- title: Plots
diff --git a/docs/reference/index.html b/docs/reference/index.html
index 0b88f3a9..5c37018d 100644
--- a/docs/reference/index.html
+++ b/docs/reference/index.html
@@ -178,6 +178,12 @@
rfm_segment()
Segmentation |
+
+
+
+ rfm_plot_median_recency() rfm_plot_median_frequency() rfm_plot_median_monetary()
+ |
+ Segmentation plots |
diff --git a/docs/reference/rfm_plot_median_recency-1.png b/docs/reference/rfm_plot_median_recency-1.png
new file mode 100644
index 00000000..4744da0b
Binary files /dev/null and b/docs/reference/rfm_plot_median_recency-1.png differ
diff --git a/docs/reference/rfm_plot_median_recency-2.png b/docs/reference/rfm_plot_median_recency-2.png
new file mode 100644
index 00000000..a3ba1acd
Binary files /dev/null and b/docs/reference/rfm_plot_median_recency-2.png differ
diff --git a/docs/reference/rfm_plot_median_recency-3.png b/docs/reference/rfm_plot_median_recency-3.png
new file mode 100644
index 00000000..b85ae9dc
Binary files /dev/null and b/docs/reference/rfm_plot_median_recency-3.png differ
diff --git a/docs/reference/rfm_plot_median_recency.html b/docs/reference/rfm_plot_median_recency.html
new file mode 100644
index 00000000..7ccaf2d7
--- /dev/null
+++ b/docs/reference/rfm_plot_median_recency.html
@@ -0,0 +1,198 @@
+
+
+
+
+
+
+
+
+Segmentation plots — rfm_plot_median_recency • rfm
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Segment wise median recency, frequency & monetary value plot.
+
+
+
+
rfm_plot_median_recency(rfm_segment_table)
+
+rfm_plot_median_frequency(rfm_segment_table)
+
+rfm_plot_median_monetary(rfm_segment_table)
+
+
Arguments
+
+
+
+ rfm_segment_table |
+ Output from rfm_segment . |
+
+
+
+
+
Examples
+
rfm_plot_median_frequency(segments)
rfm_plot_median_monetary(segments)
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/man/rfm_plot_median_recency.Rd b/man/rfm_plot_median_recency.Rd
new file mode 100644
index 00000000..0a524267
--- /dev/null
+++ b/man/rfm_plot_median_recency.Rd
@@ -0,0 +1,45 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/rfm-segment.R
+\name{rfm_plot_median_recency}
+\alias{rfm_plot_median_recency}
+\alias{rfm_plot_median_frequency}
+\alias{rfm_plot_median_monetary}
+\title{Segmentation plots}
+\usage{
+rfm_plot_median_recency(rfm_segment_table)
+
+rfm_plot_median_frequency(rfm_segment_table)
+
+rfm_plot_median_monetary(rfm_segment_table)
+}
+\arguments{
+\item{rfm_segment_table}{Output from \code{rfm_segment}.}
+}
+\description{
+Segment wise median recency, frequency & monetary value plot.
+}
+\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)
+
+}
diff --git a/tests/figs/deps.txt b/tests/figs/deps.txt
index 7ebf4190..6cb3f3da 100644
--- a/tests/figs/deps.txt
+++ b/tests/figs/deps.txt
@@ -1,6 +1,5 @@
Fontconfig: 2.11.94
FreeType: 2.6.0
Cairo: 1.14.2
-vdiffr: 0.2.2
-svglite: 1.2.0
-ggplot2: 2.2.1
+vdiffr: 0.2.3
+svglite: 1.2.1
diff --git a/tests/figs/test-rfm-plots-r/rfm-barchart.svg b/tests/figs/test-rfm-plots-r/rfm-barchart.svg
index a1228c8e..b590cc42 100644
--- a/tests/figs/test-rfm-plots-r/rfm-barchart.svg
+++ b/tests/figs/test-rfm-plots-r/rfm-barchart.svg
@@ -1,1032 +1 @@
-
-
diff --git a/tests/figs/test-rfm-plots-r/rfm-fmplot.svg b/tests/figs/test-rfm-plots-r/rfm-fmplot.svg
index 85eb3b3e..b590cc42 100644
--- a/tests/figs/test-rfm-plots-r/rfm-fmplot.svg
+++ b/tests/figs/test-rfm-plots-r/rfm-fmplot.svg
@@ -1,1038 +1 @@
-
-
diff --git a/tests/figs/test-rfm-plots-r/rfm-heatmap.svg b/tests/figs/test-rfm-plots-r/rfm-heatmap.svg
index 4ed001a6..b590cc42 100644
--- a/tests/figs/test-rfm-plots-r/rfm-heatmap.svg
+++ b/tests/figs/test-rfm-plots-r/rfm-heatmap.svg
@@ -1,109 +1 @@
-
-
diff --git a/tests/figs/test-rfm-plots-r/rfm-histograms.svg b/tests/figs/test-rfm-plots-r/rfm-histograms.svg
index 37ade358..b590cc42 100644
--- a/tests/figs/test-rfm-plots-r/rfm-histograms.svg
+++ b/tests/figs/test-rfm-plots-r/rfm-histograms.svg
@@ -1,194 +1 @@
-
-
diff --git a/tests/figs/test-rfm-plots-r/rfm-median-frequency.svg b/tests/figs/test-rfm-plots-r/rfm-median-frequency.svg
new file mode 100644
index 00000000..b590cc42
--- /dev/null
+++ b/tests/figs/test-rfm-plots-r/rfm-median-frequency.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/test-rfm-plots-r/rfm-median-monetary.svg b/tests/figs/test-rfm-plots-r/rfm-median-monetary.svg
new file mode 100644
index 00000000..b590cc42
--- /dev/null
+++ b/tests/figs/test-rfm-plots-r/rfm-median-monetary.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/test-rfm-plots-r/rfm-median-recency.svg b/tests/figs/test-rfm-plots-r/rfm-median-recency.svg
new file mode 100644
index 00000000..b590cc42
--- /dev/null
+++ b/tests/figs/test-rfm-plots-r/rfm-median-recency.svg
@@ -0,0 +1 @@
+
diff --git a/tests/figs/test-rfm-plots-r/rfm-orderdist.svg b/tests/figs/test-rfm-plots-r/rfm-orderdist.svg
index 045587f6..b590cc42 100644
--- a/tests/figs/test-rfm-plots-r/rfm-orderdist.svg
+++ b/tests/figs/test-rfm-plots-r/rfm-orderdist.svg
@@ -1,92 +1 @@
-
-
diff --git a/tests/figs/test-rfm-plots-r/rfm-rfplot.svg b/tests/figs/test-rfm-plots-r/rfm-rfplot.svg
index 506752a1..b590cc42 100644
--- a/tests/figs/test-rfm-plots-r/rfm-rfplot.svg
+++ b/tests/figs/test-rfm-plots-r/rfm-rfplot.svg
@@ -1,1040 +1 @@
-
-
diff --git a/tests/figs/test-rfm-plots-r/rfm-rmplot.svg b/tests/figs/test-rfm-plots-r/rfm-rmplot.svg
index 237b01a8..b590cc42 100644
--- a/tests/figs/test-rfm-plots-r/rfm-rmplot.svg
+++ b/tests/figs/test-rfm-plots-r/rfm-rmplot.svg
@@ -1,1044 +1 @@
-
-
diff --git a/tests/testthat/test-rfm-plots.R b/tests/testthat/test-rfm-plots.R
index 30a444cd..16c95cd4 100644
--- a/tests/testthat/test-rfm-plots.R
+++ b/tests/testthat/test-rfm-plots.R
@@ -81,3 +81,51 @@ test_that('output from rfm_order_dist is as expected', {
})
+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)
+
+test_that('output from rfm_plot_median_recency is as expected', {
+
+ skip_on_cran()
+
+ p <- rfm_plot_median_recency(segments)
+ vdiffr::expect_doppelganger('rfm median recency', p$plot)
+
+})
+
+test_that('output from rfm_plot_median_frequency is as expected', {
+
+ skip_on_cran()
+
+ p <- rfm_plot_median_frequency(segments)
+ vdiffr::expect_doppelganger('rfm median frequency', p$plot)
+
+})
+
+test_that('output from rfm_plot_median_monetary is as expected', {
+
+ skip_on_cran()
+
+ p <- rfm_plot_median_monetary(segments)
+ vdiffr::expect_doppelganger('rfm median monetary', p$plot)
+
+})
+
+
+