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

+
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/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 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 - - - - - - - - - - - -2 - - - - - - - - - - - -3 - - - - - - - - - - - -4 - - - - - - - - - - - -5 - - - - - - - - - - - -5 - - - - - - - - - - - -4 - - - - - - - - - - - -3 - - - - - - - - - - - -2 - - - - - - - - - - - -1 - - - - - - - - - - -1 -2 -3 -4 -5 - - - - - -1 -2 -3 -4 -5 - - - - - -1 -2 -3 -4 -5 - - - - - -1 -2 -3 -4 -5 - - - - - -1 -2 -3 -4 -5 -Monetary Score - -Recency Score -Frequency Score 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 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -5 -10 - - - - - - -0 -500 -1000 -1500 -Monetary -Frequency -Frequency vs Monetary 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 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -1 -2 -3 -4 -5 - - - - - - - - - - -1 -2 -3 -4 -5 -Frequency -Recency - - -400 -600 -800 -Mean Monetary Value - - - - - - -RFM Heat Map 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 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Monetary - - - - - - - - - - - -Recency - - - - - - - - - - - -Frequency - - - - - - - - - -0 -500 -1000 -1500 - - - - - -0 -250 -500 -750 -1000 - - - - -4 -8 -12 -16 -0 -100 -200 -300 - - - - - -Count -RFM Histograms 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 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -42 -83 -143 -187 -176 -150 -94 -51 -38 -20 -3 -5 -2 -1 - - - - - -0 -50 -100 -150 -200 - - - - - - - - - -0 -5 -10 -15 -Orders -Customers -Customers by Orders 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 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -250 -500 -750 -1000 - - - - - - - -5 -10 -Frequency -Recency -Recency vs Frequency 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 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -0 -250 -500 -750 -1000 - - - - - - - - - -0 -500 -1000 -1500 -Monetary -Recency -Recency vs Monetary 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) + +}) + + +