Nothing
#' Segmentation
#'
#' Create segments based on recency, frequency and monetary scores.
#'
#' @param data An object of class \code{rfm_table}.
#' @param segment_names Names of the segments.
#' @param recency_lower Lower boundary for recency score.
#' @param recency_upper Upper boundary for recency score.
#' @param frequency_lower Lower boundary for frequency score.
#' @param frequency_upper Upper boundary for frequency score.
#' @param monetary_lower Lower boundary for monetary score.
#' @param monetary_upper Upper boundary for monetary score.
#'
#' @examples
#' # analysis date
#' analysis_date <- as.Date('2006-12-31')
#'
#' # generate rfm score
#' rfm_result <- rfm_table_order(rfm_data_orders, customer_id, order_date,
#' revenue, analysis_date)
#'
#' # segment names
#' segment_names <- c("Champions", "Potential Loyalist", "Loyal Customers",
#' "Promising", "New Customers", "Can't Lose Them",
#' "At Risk", "Need Attention", "About To Sleep", "Lost")
#'
#' # segment intervals
#' recency_lower <- c(5, 3, 2, 3, 4, 1, 1, 1, 2, 1)
#' recency_upper <- c(5, 5, 4, 4, 5, 2, 2, 3, 3, 1)
#' frequency_lower <- c(5, 3, 2, 1, 1, 3, 2, 3, 1, 1)
#' frequency_upper <- c(5, 5, 4, 3, 3, 4, 5, 5, 3, 5)
#' monetary_lower <- c(5, 2, 2, 3, 1, 4, 4, 3, 1, 1)
#' monetary_upper <- c(5, 5, 4, 5, 5, 5, 5, 5, 4, 5)
#'
#' # generate segments
#' segments <- rfm_segment(rfm_result, segment_names, recency_lower,
#' recency_upper, frequency_lower, frequency_upper, monetary_lower,
#' monetary_upper)
#'
#' segments
#'
#' @importFrom dplyr between everything
#'
#'@export
#'
rfm_segment <- function(data, segment_names = NULL, recency_lower = NULL,
recency_upper = NULL, frequency_lower = NULL,
frequency_upper = NULL, monetary_lower = NULL,
monetary_upper = NULL) {
customer_id <- NULL
segment <- NULL
rfm_score_table <- data$rfm
rfm_score_table$segment <- 1
n_segments <- length(segment_names)
for (i in seq_len(n_segments)) {
rfm_score_table$segment[(
(rfm_score_table$recency_score %>% between(recency_lower[i],
recency_upper[i])) &
(rfm_score_table$frequency_score %>% between(frequency_lower[i],
frequency_upper[i])) &
(rfm_score_table$monetary_score %>% between(monetary_lower[i],
monetary_upper[i])) &
!rfm_score_table$segment %in% segment_names)] <- segment_names[i]
}
rfm_score_table$segment[is.na(rfm_score_table$segment)] <- "Others"
rfm_score_table$segment[rfm_score_table$segment == 1] <- "Others"
rfm_score_table[c("customer_id", "segment", "rfm_score", "transaction_count",
"recency_days", "amount", "recency_score",
"frequency_score", "monetary_score")]
rfm_score_table %>%
select(c("customer_id", "segment", "rfm_score", "transaction_count",
"recency_days", "amount", "recency_score",
"frequency_score", "monetary_score"), everything())
}
#' Segment summary
#'
#' An overview of customer segments.
#'
#' @param segments Output from \code{rfm_segment}.
#'
#' @examples
#' # analysis date
#' analysis_date <- as.Date('2006-12-31')
#'
#' # generate rfm score
#' rfm_result <- rfm_table_order(rfm_data_orders, customer_id, order_date,
#' revenue, analysis_date)
#'
#' # segment names
#' segment_names <- c("Champions", "Potential Loyalist", "Loyal Customers",
#' "Promising", "New Customers", "Can't Lose Them",
#' "At Risk", "Need Attention", "About To Sleep", "Lost")
#'
#' # segment intervals
#' recency_lower <- c(5, 3, 2, 3, 4, 1, 1, 1, 2, 1)
#' recency_upper <- c(5, 5, 4, 4, 5, 2, 2, 3, 3, 1)
#' frequency_lower <- c(5, 3, 2, 1, 1, 3, 2, 3, 1, 1)
#' frequency_upper <- c(5, 5, 4, 3, 3, 4, 5, 5, 3, 5)
#' monetary_lower <- c(5, 2, 2, 3, 1, 4, 4, 3, 1, 1)
#' monetary_upper <- c(5, 5, 4, 5, 5, 5, 5, 5, 4, 5)
#'
#' # generate segments
#' segments <- rfm_segment(rfm_result, segment_names, recency_lower,
#' recency_upper, frequency_lower, frequency_upper, monetary_lower,
#' monetary_upper)
#'
#' # segment summary
#' rfm_segment_summary(segments)
#'
#' @export
#'
rfm_segment_summary <- function(segments) {
segments %>%
group_by(segment) %>%
summarise(
customers = n(),
orders = sum(transaction_count),
revenue = sum(amount)
) %>%
mutate(aov = round((revenue / orders), 2))
}
#' Visulaize segment summary
#'
#' Generates plots for customers, orders, revenue and average order value for
#' each segment.
#'
#' @param x An object of class \code{rfm_segment_summary}.
#' @param metric Metric to be visualized. Defaults to \code{"customers"}. Valid
#' values are:
#' \itemize{
#' \item \code{"customers"}
#' \item \code{"orders"}
#' \item \code{"revenue"}
#' \item \code{"aov"}
#' }
#' @param sort logical; if \code{TRUE}, sort metrics.
#' @param ascending logical; if \code{TRUE}, sort metrics in ascending order.
#' @param flip logical; if \code{TRUE}, creates horizontal bar plot.
#' @param bar_color Color of the bars.
#' @param plot_title Title of the plot.
#' @param xaxis_label X axis label.
#' @param yaxis_label Y axis label.
#' @param axis_label_size Font size of X axis tick labels.
#' @param axis_label_angle Angle of X axis tick labels.
#' @param bar_labels If \code{TRUE}, add labels to the bars. Defaults to
#' \code{TRUE}.
#' @param interactive If \code{TRUE}, uses \code{plotly} as the visualization
#' engine. If \code{FALSE}, uses \code{ggplot2}.
#' @param animate If \code{TRUE}, animates the bars. Defaults to \code{FALSE}.
#' @param print_plot logical; if \code{TRUE}, prints the plot else returns a
#' plot object.
#'
#' @examples
#' # analysis date
#' analysis_date <- as.Date('2006-12-31')
#'
#' # generate rfm score
#' rfm_result <- rfm_table_order(rfm_data_orders, customer_id, order_date,
#' revenue, analysis_date)
#'
#' # segment names
#' segment_names <- c("Champions", "Potential Loyalist", "Loyal Customers",
#' "Promising", "New Customers", "Can't Lose Them",
#' "At Risk", "Need Attention", "About To Sleep", "Lost")
#'
#' # segment intervals
#' recency_lower <- c(5, 3, 2, 3, 4, 1, 1, 1, 2, 1)
#' recency_upper <- c(5, 5, 4, 4, 5, 2, 2, 3, 3, 1)
#' frequency_lower <- c(5, 3, 2, 1, 1, 3, 2, 3, 1, 1)
#' frequency_upper <- c(5, 5, 4, 3, 3, 4, 5, 5, 3, 5)
#' monetary_lower <- c(5, 2, 2, 3, 1, 4, 4, 3, 1, 1)
#' monetary_upper <- c(5, 5, 4, 5, 5, 5, 5, 5, 4, 5)
#'
#' # generate segments
#' segments <- rfm_segment(rfm_result, segment_names, recency_lower,
#' recency_upper, frequency_lower, frequency_upper, monetary_lower,
#' monetary_upper)
#'
#' # segment summary
#' segment_overview <- rfm_segment_summary(segments)
#'
#' # plot segment summary
#' # summarize metric for all segments
#' # ggplot2
#' rfm_plot_segment_summary(segment_overview)
#'
#' # plotly
#' rfm_plot_segment_summary(segment_overview, interactive = TRUE)
#'
#' # select metric to be visualized
#' rfm_plot_segment_summary(segment_overview, metric = "orders")
#'
#' # sort the metric in ascending order
#' rfm_plot_segment_summary(segment_overview, metric = "orders", sort = TRUE,
#' ascending = TRUE)
#'
#' # default sorting is in descending order
#' rfm_plot_segment_summary(segment_overview, metric = "orders", sort = TRUE)
#'
#' # horizontal bars
#' rfm_plot_segment_summary(segment_overview, metric = "orders", flip = TRUE)
#'
#' @export
#'
rfm_plot_segment_summary <- function(x, metric = NULL, sort = FALSE,
ascending = FALSE, flip = FALSE,
bar_color = NULL, plot_title = NULL,
xaxis_label = NULL, yaxis_label = NULL,
axis_label_size = 8, axis_label_angle = 315,
bar_labels = TRUE, interactive = FALSE,
animate = FALSE, print_plot = TRUE) {
if (is.null(metric)) {
metric <- "customers"
}
if (is.null(bar_color)) {
bar_color <- "#0f1a34"
}
if (is.null(plot_title)) {
plot_title <- paste(to_title_case(metric), " Distribution by Segment")
}
if (is.null(xaxis_label)) {
xaxis_label <- "Segment"
}
if (is.null(yaxis_label)) {
yaxis_label <- to_title_case(metric)
}
if (interactive) {
animate <- FALSE
}
data <- x[c("segment", metric)]
ylim_max <-
data[[metric]] %>%
max() %>%
multiply_by(1.15) %>%
ceiling(.)
if (interactive) {
pkg_flag <- requireNamespace("plotly", quietly = TRUE)
if (pkg_flag) {
rfm_plotly_segment_summary(data, metric, flip, sort, ascending, bar_color,
plot_title, xaxis_label, yaxis_label)
} else {
if (interactive()) {
message('`plotly` must be installed for this functionality. Would you like to install?')
if (menu(c("Yes", "No")) == 1) {
install.packages("plotly")
rfm_plotly_segment_summary(data, metric, flip, sort, ascending, bar_color,
plot_title, xaxis_label, yaxis_label)
} else {
stop('Sorry! The functionality is not available without installing the required package.', call. = FALSE)
}
} else {
warning("`plotly` is not installed. Using `ggplot2` instead to generate the plot!")
p <- rfm_gg_segment_summary(data, metric, sort, ascending, flip,
bar_color, plot_title, xaxis_label,
yaxis_label, axis_label_size, axis_label_angle,
ylim_max, bar_labels)
}
}
} else {
if (animate) {
pkg_flag <- requireNamespace("gganimate", quietly = TRUE)
if (pkg_flag) {
print_plot <- FALSE
data <- rfm_animate_data(data, metric)
} else {
if (interactive()) {
message('`gganimate` must be installed for this functionality. Would you like to install?')
if (menu(c("Yes", "No")) == 1) {
install.packages("gganimate")
print_plot <- FALSE
data <- rfm_animate_data(data, metric)
} else {
stop('Sorry! The functionality is not available without installing the required package.', call. = FALSE)
}
} else {
animate <- FALSE
warning("`gganimate` is not installed. Using `ggplot2` instead to generate the plot!")
}
}
}
p <- rfm_gg_segment_summary(data, metric, sort, ascending, flip,
bar_color, plot_title, xaxis_label,
yaxis_label, axis_label_size, axis_label_angle,
ylim_max, bar_labels)
if (animate) {
p <- rfm_animate_plot(p)
gganimate::animate(p, fps=8, renderer = gganimate::gifski_renderer(loop = FALSE))
}
if (print_plot) {
print(p)
} else {
return(p)
}
}
}
#' Revenue distribution
#'
#' Customer and revenue distribution by segments.
#'
#' @param x An object of class \code{rfm_segment_summary}.
#' @param flip logical; if \code{TRUE}, creates horizontal bar plot.
#' @param colors Bar colors.
#' @param legend_labels Legend labels.
#' @param plot_title Title of the plot.
#' @param xaxis_label X axis label.
#' @param yaxis_label Y axis label.
#' @param axis_label_size Font size of X axis tick labels.
#' @param axis_label_angle Angle of X axis tick labels.
#' @param bar_labels If \code{TRUE}, add labels to the bars. Defaults to
#' \code{FALSE}.
#' @param bar_label_size Size of bar labels.
#' @param interactive If \code{TRUE}, uses \code{plotly} as the visualization
#' engine. If \code{FALSE}, uses \code{ggplot2}.
#' @param animate If \code{TRUE}, animates the bars. Defaults to \code{FALSE}.
#' @param print_plot logical; if \code{TRUE}, prints the plot else returns a
#' plot object.
#'
#' @examples
#' # analysis date
#' analysis_date <- as.Date('2006-12-31')
#'
#' # generate rfm score
#' rfm_result <- rfm_table_order(rfm_data_orders, customer_id, order_date,
#' revenue, analysis_date)
#'
#' # segment names
#' segment_names <- c("Champions", "Potential Loyalist", "Loyal Customers",
#' "Promising", "New Customers", "Can't Lose Them",
#' "At Risk", "Need Attention", "About To Sleep", "Lost")
#'
#' # segment intervals
#' recency_lower <- c(5, 3, 2, 3, 4, 1, 1, 1, 2, 1)
#' recency_upper <- c(5, 5, 4, 4, 5, 2, 2, 3, 3, 1)
#' frequency_lower <- c(5, 3, 2, 1, 1, 3, 2, 3, 1, 1)
#' frequency_upper <- c(5, 5, 4, 3, 3, 4, 5, 5, 3, 5)
#' monetary_lower <- c(5, 2, 2, 3, 1, 4, 4, 3, 1, 1)
#' monetary_upper <- c(5, 5, 4, 5, 5, 5, 5, 5, 4, 5)
#'
#' # generate segments
#' segments <- rfm_segment(rfm_result, segment_names, recency_lower,
#' recency_upper, frequency_lower, frequency_upper, monetary_lower,
#' monetary_upper)
#'
#' # segment summary
#' segment_overview <- rfm_segment_summary(segments)
#'
#' # revenue distribution
#' # ggplot2
#' rfm_plot_revenue_dist(segment_overview)
#'
#' # flip
#' rfm_plot_revenue_dist(segment_overview, flip = TRUE)
#'
#' # plotly
#' rfm_plot_revenue_dist(segment_overview, interactive = TRUE)
#'
#' @export
#'
rfm_plot_revenue_dist <- function(x, flip = FALSE,
colors = c("#3b5bdb", "#91a7ff"),
legend_labels = c("Revenue", "Customers"),
plot_title = "Revenue & Customer Distribution",
xaxis_label = NULL, yaxis_label = NULL,
axis_label_size = 8, axis_label_angle = 315,
bar_labels = FALSE, bar_label_size = 2,
interactive = FALSE, animate = FALSE,
print_plot = TRUE) {
if (interactive) {
animate <- FALSE
}
if (interactive) {
pkg_flag <- requireNamespace("plotly", quietly = TRUE)
if (pkg_flag) {
rfm_plotly_revenue_dist(x, flip, colors, legend_labels, plot_title,
xaxis_label, yaxis_label)
} else {
if (interactive()) {
message('`plotly` must be installed for this functionality. Would you like to install?')
if (menu(c("Yes", "No")) == 1) {
install.packages("plotly")
rfm_plotly_revenue_dist(x, flip, colors, legend_labels, plot_title,
xaxis_label, yaxis_label)
} else {
stop('Sorry! The functionality is not available without installing the required package.', call. = FALSE)
}
} else {
warning("`plotly` is not installed. Using `ggplot2` instead to generate the plot!")
p <- rfm_gg_revenue_dist(x, colors, legend_labels, flip,
plot_title, xaxis_label, yaxis_label,
axis_label_size, axis_label_angle,
bar_labels, bar_label_size)
}
}
} else {
data <- rfm_prep_revenue_dist(x)
share_data <- data[, c("category"), drop = FALSE]
if (animate) {
pkg_flag <- requireNamespace("gganimate", quietly = TRUE)
if (pkg_flag) {
print_plot <- FALSE
bar_labels <- FALSE
data <- rfm_animate_data(data, "share")
data$category <- rep(share_data$category, 10)
} else {
if (interactive()) {
message('`gganimate` must be installed for this functionality. Would you like to install?')
if (menu(c("Yes", "No")) == 1) {
install.packages("gganimate")
print_plot <- FALSE
bar_labels <- FALSE
data <- rfm_animate_data(data, "share")
data$category <- rep(share_data$category, 10)
} else {
stop('Sorry! The functionality is not available without installing the required package.', call. = FALSE)
}
} else {
animate <- FALSE
warning("`gganimate` is not installed. Using `ggplot2` instead to generate the plot!")
}
}
}
p <- rfm_gg_revenue_dist(data, colors, legend_labels, flip,
plot_title, xaxis_label, yaxis_label,
axis_label_size, axis_label_angle,
bar_labels, bar_label_size)
if (animate) {
p <- rfm_animate_plot(p)
gganimate::animate(p, fps=8, renderer = gganimate::gifski_renderer(loop = FALSE))
}
if (print_plot) {
print(p)
} else {
return(p)
}
}
}
#' Median plots
#'
#' Segment wise median recency, frequency & monetary value plot.
#'
#' @param rfm_segment_table Output from \code{rfm_segment}.
#' @param sort logical; if \code{TRUE}, sort metrics.
#' @param ascending logical; if \code{TRUE}, sort metrics in ascending order.
#' @param flip logical; if \code{TRUE}, creates horizontal bar plot.
#' @param bar_color Color of the bars.
#' @param plot_title Title of the plot.
#' @param xaxis_label X axis label.
#' @param yaxis_label Y axis label.
#' @param axis_label_size Font size of X axis tick labels.
#' @param axis_label_angle Angle of X axis tick labels.
#' @param bar_labels If \code{TRUE}, add labels to the bars. Defaults to
#' \code{TRUE}.
#' @param interactive If \code{TRUE}, uses \code{plotly} as the visualization
#' engine. If \code{FALSE}, uses \code{ggplot2}.
#' @param animate If \code{TRUE}, animates the bars. Defaults to \code{FALSE}.
#' @param print_plot logical; if \code{TRUE}, prints the plot else returns a
#' plot object.
#'
#' @examples
#' # analysis date
#' analysis_date <- as.Date('2006-12-31')
#'
#' # generate rfm score
#' rfm_result <- rfm_table_order(rfm_data_orders, customer_id, order_date,
#' revenue, analysis_date)
#'
#' # segment names
#' segment_names <- c("Champions", "Potential Loyalist", "Loyal Customers",
#' "Promising", "New Customers", "Can't Lose Them",
#' "At Risk", "Need Attention", "About To Sleep", "Lost")
#'
#' # segment intervals
#' recency_lower <- c(5, 3, 2, 3, 4, 1, 1, 1, 2, 1)
#' recency_upper <- c(5, 5, 4, 4, 5, 2, 2, 3, 3, 1)
#' frequency_lower <- c(5, 3, 2, 1, 1, 3, 2, 3, 1, 1)
#' frequency_upper <- c(5, 5, 4, 3, 3, 4, 5, 5, 3, 5)
#' monetary_lower <- c(5, 2, 2, 3, 1, 4, 4, 3, 1, 1)
#' monetary_upper <- c(5, 5, 4, 5, 5, 5, 5, 5, 4, 5)
#'
#' # generate segments
#' segments <- rfm_segment(rfm_result, segment_names, recency_lower,
#' recency_upper, frequency_lower, frequency_upper, monetary_lower,
#' monetary_upper)
#'
#' # plots
#' # visualize median recency
#' rfm_plot_median_recency(segments)
#'
#' # plotly
#' rfm_plot_median_recency(segments, interactive = TRUE)
#'
#' # sort in ascending order
#' rfm_plot_median_recency(segments, sort = TRUE, ascending = TRUE)
#'
#' # default sorting is in descending order
#' rfm_plot_median_recency(segments, sort = TRUE)
#'
#' # horizontal bars
#' rfm_plot_median_recency(segments, flip = TRUE)
#'
#' # median frequency
#' rfm_plot_median_frequency(segments)
#'
#' # median monetary value
#' rfm_plot_median_monetary(segments)
#'
#' @export
#'
rfm_plot_median_recency <- function(rfm_segment_table, sort = FALSE,
ascending = FALSE, flip = FALSE,
bar_color = NULL, plot_title = NULL,
xaxis_label = NULL, yaxis_label = NULL,
axis_label_size = 8, axis_label_angle = 315,
bar_labels = TRUE, interactive = FALSE,
animate = FALSE, print_plot = TRUE) {
if (interactive) {
animate <- FALSE
}
data <- rfm_prep_median(rfm_segment_table, recency_days)
if (interactive) {
pkg_flag <- requireNamespace("plotly", quietly = TRUE)
if (pkg_flag) {
rfm_plotly_median(data, bar_color, sort, ascending, flip, plot_title,
xaxis_label, yaxis_label)
} else {
if (interactive()) {
message('`plotly` must be installed for this functionality. Would you like to install?')
if (menu(c("Yes", "No")) == 1) {
install.packages("plotly")
rfm_plotly_median(data, bar_color, sort, ascending, flip, plot_title,
xaxis_label, yaxis_label)
} else {
stop('Sorry! The functionality is not available without installing the required package.', call. = FALSE)
}
} else {
warning("`plotly` is not installed. Using `ggplot2` instead to generate the plot!")
p <- rfm_gg_median(data, bar_color, sort, ascending, flip, plot_title,
xaxis_label, yaxis_label, axis_label_size,
axis_label_angle, bar_labels)
}
}
} else {
if (animate) {
pkg_flag <- requireNamespace("gganimate", quietly = TRUE)
if (pkg_flag) {
print_plot <- FALSE
data <- rfm_animate_data(data, "recency_days")
} else {
if (interactive()) {
message('`gganimate` must be installed for this functionality. Would you like to install?')
if (menu(c("Yes", "No")) == 1) {
install.packages("gganimate")
print_plot <- FALSE
data <- rfm_animate_data(data, "recency_days")
} else {
stop('Sorry! The functionality is not available without installing the required package.', call. = FALSE)
}
} else {
animate <- FALSE
warning("`gganimate` is not installed. Using `ggplot2` instead to generate the plot!")
}
}
}
p <- rfm_gg_median(data, bar_color, sort, ascending, flip, plot_title,
xaxis_label, yaxis_label, axis_label_size,
axis_label_angle, bar_labels)
if (animate) {
p <- rfm_animate_plot(p)
gganimate::animate(p, fps=8, renderer = gganimate::gifski_renderer(loop = FALSE))
}
if (print_plot) {
print(p)
} else {
return(p)
}
}
}
#' @rdname rfm_plot_median_recency
#' @export
#'
rfm_plot_median_frequency <- function(rfm_segment_table, sort = FALSE,
ascending = FALSE, flip = FALSE,
bar_color = NULL, plot_title = NULL,
xaxis_label = NULL, yaxis_label = NULL,
axis_label_size = 8,
axis_label_angle = 315,
bar_labels = TRUE, interactive = FALSE,
animate = FALSE, print_plot = TRUE) {
if (interactive) {
animate <- FALSE
}
data <- rfm_prep_median(rfm_segment_table, transaction_count)
if (interactive) {
pkg_flag <- requireNamespace("plotly", quietly = TRUE)
if (pkg_flag) {
rfm_plotly_median(data, bar_color, sort, ascending, flip, plot_title,
xaxis_label, yaxis_label)
} else {
if (interactive()) {
message('`plotly` must be installed for this functionality. Would you like to install?')
if (menu(c("Yes", "No")) == 1) {
install.packages("plotly")
rfm_plotly_median(data, bar_color, sort, ascending, flip, plot_title,
xaxis_label, yaxis_label)
} else {
stop('Sorry! The functionality is not available without installing the required package.', call. = FALSE)
}
} else {
warning("`plotly` is not installed. Using `ggplot2` instead to generate the plot!")
p <- rfm_gg_median(data, bar_color, sort, ascending, flip, plot_title,
xaxis_label, yaxis_label, axis_label_size,
axis_label_angle, bar_labels)
}
}
} else {
if (animate) {
pkg_flag <- requireNamespace("gganimate", quietly = TRUE)
if (pkg_flag) {
print_plot <- FALSE
data <- rfm_animate_data(data, "transaction_count")
} else {
if (interactive()) {
message('`gganimate` must be installed for this functionality. Would you like to install?')
if (menu(c("Yes", "No")) == 1) {
install.packages("gganimate")
print_plot <- FALSE
data <- rfm_animate_data(data, "transaction_count")
} else {
stop('Sorry! The functionality is not available without installing the required package.', call. = FALSE)
}
} else {
animate <- FALSE
warning("`gganimate` is not installed. Using `ggplot2` instead to generate the plot!")
}
}
}
p <- rfm_gg_median(data, bar_color, sort, ascending, flip, plot_title,
xaxis_label, yaxis_label, axis_label_size,
axis_label_angle, bar_labels)
if (animate) {
p <- rfm_animate_plot(p)
gganimate::animate(p, fps=8, renderer = gganimate::gifski_renderer(loop = FALSE))
}
if (print_plot) {
print(p)
} else {
return(p)
}
}
}
#' @rdname rfm_plot_median_recency
#' @export
#'
rfm_plot_median_monetary <- function(rfm_segment_table, sort = FALSE,
ascending = FALSE, flip = FALSE,
bar_color = NULL, plot_title = NULL,
xaxis_label = NULL, yaxis_label = NULL,
axis_label_size = 8,
axis_label_angle = 315,
bar_labels = TRUE, interactive = FALSE,
animate = FALSE, print_plot = TRUE) {
if (interactive) {
animate <- FALSE
}
data <- rfm_prep_median(rfm_segment_table, amount)
if (interactive) {
pkg_flag <- requireNamespace("plotly", quietly = TRUE)
if (pkg_flag) {
rfm_plotly_median(data, bar_color, sort, ascending, flip, plot_title,
xaxis_label, yaxis_label)
} else {
if (interactive()) {
message('`plotly` must be installed for this functionality. Would you like to install?')
if (menu(c("Yes", "No")) == 1) {
install.packages("plotly")
rfm_plotly_median(data, bar_color, sort, ascending, flip, plot_title,
xaxis_label, yaxis_label)
} else {
stop('Sorry! The functionality is not available without installing the required package.', call. = FALSE)
}
} else {
warning("`plotly` is not installed. Using `ggplot2` instead to generate the plot!")
p <- rfm_gg_median(data, bar_color, sort, ascending, flip, plot_title,
xaxis_label, yaxis_label, axis_label_size,
axis_label_angle, bar_labels)
}
}
} else {
if (animate) {
pkg_flag <- requireNamespace("gganimate", quietly = TRUE)
if (pkg_flag) {
print_plot <- FALSE
data <- rfm_animate_data(data, "amount")
} else {
if (interactive()) {
message('`gganimate` must be installed for this functionality. Would you like to install?')
if (menu(c("Yes", "No")) == 1) {
install.packages("gganimate")
print_plot <- FALSE
data <- rfm_animate_data(data, "amount")
} else {
stop('Sorry! The functionality is not available without installing the required package.', call. = FALSE)
}
} else {
animate <- FALSE
warning("`gganimate` is not installed. Using `ggplot2` instead to generate the plot!")
}
}
}
p <- rfm_gg_median(data, bar_color, sort, ascending, flip, plot_title,
xaxis_label, yaxis_label, axis_label_size, axis_label_angle,
bar_labels)
if (animate) {
p <- rfm_animate_plot(p)
gganimate::animate(p, fps=8, renderer = gganimate::gifski_renderer(loop = FALSE))
}
if (print_plot) {
print(p)
} else {
return(p)
}
}
}
#' RFM Segmentation Plot
#'
#' Generates tree map to visualize segments.
#'
#' @param table An object of class \code{rfm_segment_summary}.
#' @param metric Metric to be visualized. Defaults to \code{"customers"}. Valid
#' values are:
#' \itemize{
#' \item \code{"customers"}
#' \item \code{"orders"}
#' \item \code{"revenue"}
#' }
#' @param interactive If \code{TRUE}, uses \code{plotly} as the visualization
#' engine. If \code{FALSE}, uses \code{ggplot2}.
#' @param print_plot logical; if \code{TRUE}, prints the plot else returns a
#' plot object.
#'
#' @examples
#' # analysis date
#' analysis_date <- as.Date('2006-12-31')
#'
#' # generate rfm score
#' rfm_result <- rfm_table_order(rfm_data_orders, customer_id, order_date,
#' revenue, analysis_date)
#'
#' # segment names
#' segment_names <- c("Champions", "Potential Loyalist", "Loyal Customers",
#' "Promising", "New Customers", "Can't Lose Them",
#' "At Risk", "Need Attention", "About To Sleep", "Lost")
#'
#' # segment intervals
#' recency_lower <- c(5, 3, 2, 3, 4, 1, 1, 1, 2, 1)
#' recency_upper <- c(5, 5, 4, 4, 5, 2, 2, 3, 3, 1)
#' frequency_lower <- c(5, 3, 2, 1, 1, 3, 2, 3, 1, 1)
#' frequency_upper <- c(5, 5, 4, 3, 3, 4, 5, 5, 3, 5)
#' monetary_lower <- c(5, 2, 2, 3, 1, 4, 4, 3, 1, 1)
#' monetary_upper <- c(5, 5, 4, 5, 5, 5, 5, 5, 4, 5)
#'
#' # generate segments
#' segments <- rfm_segment(rfm_result, segment_names, recency_lower,
#' recency_upper, frequency_lower, frequency_upper, monetary_lower,
#' monetary_upper)
#'
#' # segment summary
#' segment_overview <- rfm_segment_summary(segments)
#'
#' # treemaps
#' # default metric is customers
#' rfm_plot_segment(segment_overview)
#'
#' # treemap of orders
#' rfm_plot_segment(segment_overview, metric = "orders")
#'
#' # plotly
#' rfm_plot_segment(segment_overview, metric = "revenue", interactive = TRUE)
#'
#' @export
#'
rfm_plot_segment <- function(table, metric = "customers", interactive = FALSE,
print_plot = TRUE) {
table$prop <- round((table[[metric]] / sum(table[[metric]])) * 100, 2)
if (interactive) {
pkg_flag <- requireNamespace("plotly", quietly = TRUE)
if (pkg_flag) {
p <- rfm_plotly_segment(table, metric)
} else {
if (interactive()) {
message('`plotly` must be installed for this functionality. Would you like to install?')
if (menu(c("Yes", "No")) == 1) {
install.packages("plotly")
p <- rfm_plotly_segment(table, metric)
} else {
stop('Sorry! The functionality is not available without installing the required package.', call. = FALSE)
}
} else {
warning("`plotly` is not installed. Using `ggplot2` instead to generate the plot!")
p <- rfm_gg_segment(table, metric)
}
}
} else {
p <- rfm_gg_segment(table, metric)
}
if (print_plot) {
print(p)
} else {
return(p)
}
}
#' Segment Scatter Plots
#'
#' @description Generate scatter plots to examine the relationship between
#' recency, frequency and monetary value.
#'
#' @param segments Output from \code{rfm_segment}.
#' @param x Metric to be represented on X axis.
#' @param y Metric to be represented on Y axis.
#' @param plot_title Title of the plot.
#' @param legend_title Title of the plot legend.
#' @param xaxis_label X axis label.
#' @param yaxis_label Y axis label.
#' @param interactive If \code{TRUE}, uses \code{plotly} as the visualization
#' engine. If \code{FALSE}, uses \code{ggplot2}.
#' @param animate If \code{TRUE}, animates the bars. Defaults to \code{FALSE}.
#' @param print_plot logical; if \code{TRUE}, prints the plot else returns a
#' plot object.
#'
#' @return Scatter plot.
#'
#' @examples
#' # analysis date
#' analysis_date <- as.Date('2006-12-31')
#'
#' # generate rfm score
#' rfm_result <- rfm_table_order(rfm_data_orders, customer_id, order_date,
#' revenue, analysis_date)
#'
#' # segment names
#' segment_names <- c("Champions", "Potential Loyalist", "Loyal Customers",
#' "Promising", "New Customers", "Can't Lose Them",
#' "At Risk", "Need Attention", "About To Sleep", "Lost")
#'
#' # segment intervals
#' recency_lower <- c(5, 3, 2, 3, 4, 1, 1, 1, 2, 1)
#' recency_upper <- c(5, 5, 4, 4, 5, 2, 2, 3, 3, 1)
#' frequency_lower <- c(5, 3, 2, 1, 1, 3, 2, 3, 1, 1)
#' frequency_upper <- c(5, 5, 4, 3, 3, 4, 5, 5, 3, 5)
#' monetary_lower <- c(5, 2, 2, 3, 1, 4, 4, 3, 1, 1)
#' monetary_upper <- c(5, 5, 4, 5, 5, 5, 5, 5, 4, 5)
#'
#' # generate segments
#' segments <- rfm_segment(rfm_result, segment_names, recency_lower,
#' recency_upper, frequency_lower, frequency_upper, monetary_lower,
#' monetary_upper)
#'
#' # visualize
#' # ggplot2
#' rfm_plot_segment_scatter(segments, "monetary", "recency")
#'
#' # plotly
#' rfm_plot_segment_scatter(segments, "monetary", "recency", interactive = TRUE)
#'
#' @export
rfm_plot_segment_scatter <- function(segments, x = "monetary", y = "recency",
plot_title = NULL, legend_title = NULL,
xaxis_label = NULL, yaxis_label = NULL,
interactive = FALSE, animate = FALSE,
print_plot = TRUE) {
x_data <- switch(x,
"recency" = "recency_days",
"frequency" = "transaction_count",
"monetary" = "amount"
)
y_data <- switch(y,
"recency" = "recency_days",
"frequency" = "transaction_count",
"monetary" = "amount"
)
if (is.null(xaxis_label)) {
xaxis_label <- to_title_case(x)
if (grepl("Monetary", xaxis_label)) {
xaxis_label <- paste(xaxis_label, "Value")
}
}
if (is.null(yaxis_label)) {
yaxis_label <- to_title_case(y)
if (grepl("Monetary", yaxis_label)) {
yaxis_label <- paste(yaxis_label, "Value")
}
}
if (is.null(plot_title)) {
plot_title <- paste(yaxis_label, "vs", xaxis_label)
}
if (interactive) {
animate <- FALSE
}
if (interactive) {
pkg_flag <- requireNamespace("plotly", quietly = TRUE)
if (pkg_flag) {
rfm_plotly_segment_scatter(segments, x_data, y_data, plot_title,
legend_title, xaxis_label, yaxis_label)
} else {
if (interactive()) {
message('`plotly` must be installed for this functionality. Would you like to install?')
if (menu(c("Yes", "No")) == 1) {
install.packages("plotly")
rfm_plotly_segment_scatter(segments, x_data, y_data, plot_title,
legend_title, xaxis_label, yaxis_label)
} else {
stop('Sorry! The functionality is not available without installing the required package.', call. = FALSE)
}
} else {
warning("`plotly` is not installed. Using `ggplot2` instead to generate the plot!")
p <- rfm_gg_segment_scatter(segments, x_data, y_data, plot_title,
legend_title, xaxis_label, yaxis_label)
}
}
} else {
p <- rfm_gg_segment_scatter(segments, x_data, y_data, plot_title,
legend_title, xaxis_label, yaxis_label)
if (animate) {
pkg_flag <- requireNamespace("gganimate", quietly = TRUE)
if (pkg_flag) {
print_plot <- FALSE
p <-
p +
gganimate::transition_reveal(along = rfm_score)
gganimate::animate(p, fps=8, renderer = gganimate::gifski_renderer(loop = FALSE))
} else {
if (interactive()) {
message('`gganimate` must be installed for this functionality. Would you like to install?')
if (menu(c("Yes", "No")) == 1) {
install.packages("gganimate")
print_plot <- FALSE
p <-
p +
gganimate::transition_reveal(along = rfm_score)
gganimate::animate(p, fps=8, renderer = gganimate::gifski_renderer(loop = FALSE))
} else {
stop('Sorry! The functionality is not available without installing the required package.', call. = FALSE)
}
} else {
animate <- FALSE
warning("`gganimate` is not installed. Using `ggplot2` instead to generate the plot!")
}
}
}
if (print_plot) {
print(p)
} else {
return(p)
}
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.