analysis_date <- as.Date('2006-12-31')
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)
my_segments <- rfm_segment_summary(segments)
test_that('interactive order distribution plot is as expected', {
skip_on_cran()
p <- rfm_plot_order_dist(rfm_result, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$layoutAttrs[[1]]$title, "Customer Distribution by Orders")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Orders")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Customers")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that('interactive heatmap is as expected', {
skip_on_cran()
p <- rfm_plot_heatmap(rfm_result, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$colorbar$title, "Mean Monetary Value")
expect_equal(p$x$attrs[[1]]$colors,
c("#F1EEF6", "#BDC9E1", "#74A9CF", "#2B8CBE", "#045A8D"))
expect_equal(p$x$attrs[[1]]$type, "heatmap")
expect_equal(p$x$layoutAttrs[[1]]$title, "RFM Heat Map")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Frequency Score")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Recency Score")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that('interactive histogram is as expected', {
skip_on_cran()
p <- rfm_plot_histogram(rfm_result, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$histnorm, "count")
expect_true(p$x$attrs[[1]]$autobinx)
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$attrs[[1]]$marker$line$color, "white")
expect_equal(p$x$attrs[[1]]$marker$line$width, 1.5)
expect_equal(p$x$attrs[[1]]$type, "histogram")
expect_equal(p$x$layoutAttrs[[1]]$title, "Recency Distribution")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Recency")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Count")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that("interactive segment summary plot is as expected", {
skip_on_cran()
p <- rfm_plot_segment_summary(my_segments, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$layoutAttrs[[1]]$title, "Customers Distribution by Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Segment")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Customers")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that("interactive segment summary plot is as expected when sorted", {
skip_on_cran()
p <- rfm_plot_segment_summary(my_segments, sort = TRUE, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$layoutAttrs[[1]]$title, "Customers Distribution by Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$categoryorder, "total descending")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Customers")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that("interactive segment summary plot sorted in descending order", {
skip_on_cran()
p <- rfm_plot_segment_summary(my_segments, sort = TRUE,
ascending = TRUE, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$layoutAttrs[[1]]$title, "Customers Distribution by Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$categoryorder, "total ascending")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Customers")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that("interactive segment summary plot flipped", {
skip_on_cran()
p <- rfm_plot_segment_summary(my_segments, flip = TRUE,
interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$orientation, "h")
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$layoutAttrs[[1]]$title, "Customers Distribution by Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Customers")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Segment")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that("interactive segment summary plot flipped sorted", {
skip_on_cran()
p <- rfm_plot_segment_summary(my_segments, flip = TRUE, sort = TRUE,
interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$orientation, "h")
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$layoutAttrs[[1]]$title, "Customers Distribution by Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Customers")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Segment")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$categoryorder, "total ascending")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that("interactive segment summary plot flipped sorted ascending", {
skip_on_cran()
p <- rfm_plot_segment_summary(my_segments, flip = TRUE, sort = TRUE,
ascending = TRUE, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$orientation, "h")
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$layoutAttrs[[1]]$title, "Customers Distribution by Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Customers")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Segment")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$categoryorder, "total descending")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that('interactive revenue distribution plot', {
skip_on_cran()
p <- rfm_plot_revenue_dist(my_segments, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$name, "Revenue")
expect_equal(p$x$attrs[[1]]$marker$color, "#3b5bdb")
expect_equal(p$x$attrs[[2]]$type, "bar")
expect_equal(p$x$attrs[[2]]$name, "Customers")
expect_equal(p$x$attrs[[2]]$marker$color, "#91a7ff")
expect_equal(p$x$layoutAttrs[[1]]$title, "Revenue & Customer Distribution")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$ticksuffix, "%")
expect_equal(p$x$layoutAttrs[[1]]$legend$x, 100)
expect_equal(p$x$layoutAttrs[[1]]$legend$y, 0.5)
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
expect_snapshot(cat(p$x$attrs[[2]]$hovertext))
})
test_that('interactive revenue distribution plot flipped', {
skip_on_cran()
p <- rfm_plot_revenue_dist(my_segments, flip = TRUE, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$orientation, "h")
expect_equal(p$x$attrs[[1]]$name, "Revenue")
expect_equal(p$x$attrs[[1]]$marker$color, "#3b5bdb")
expect_equal(p$x$attrs[[2]]$type, "bar")
expect_equal(p$x$attrs[[2]]$orientation, "h")
expect_equal(p$x$attrs[[2]]$name, "Customers")
expect_equal(p$x$attrs[[2]]$marker$color, "#91a7ff")
expect_equal(p$x$layoutAttrs[[1]]$title, "Revenue & Customer Distribution")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$ticksuffix, "%")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "")
expect_equal(p$x$layoutAttrs[[1]]$legend$x, 100)
expect_equal(p$x$layoutAttrs[[1]]$legend$y, 0.5)
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
expect_snapshot(cat(p$x$attrs[[2]]$hovertext))
})
test_that('interactive segment plot', {
skip_on_cran()
p <- rfm_plot_segment(my_segments, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "treemap")
expect_equal(p$x$attrs[[1]]$values, c(50, 86, 158, 111, 278, 35, 48, 229))
expect_equal(p$x$attrs[[1]]$labels,
c("About To Sleep", "At Risk", "Champions", "Lost",
"Loyal Customers", "Need Attention", "Others",
"Potential Loyalist"))
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that('interactive segment scatter plot', {
skip_on_cran()
p <- rfm_plot_segment_scatter(segments, "monetary", "recency",
interactive = TRUE)
expect_equal(p$x$attrs[[1]]$mode, "markers")
expect_equal(p$x$attrs[[1]]$colors, "Paired")
expect_equal(p$x$attrs[[1]]$type, "scatter")
expect_equal(p$x$layoutAttrs[[1]]$title, "Recency vs Monetary Value")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Monetary Value")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Recency")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that("interactive median plot", {
skip_on_cran()
p <- rfm_plot_median_recency(segments, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$layoutAttrs[[1]]$title, "Median Recency by Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Segment")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Median Recency")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that("interactive median plot sorted", {
skip_on_cran()
p <- rfm_plot_median_recency(segments, sort = TRUE, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$layoutAttrs[[1]]$title, "Median Recency by Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$categoryorder, "total descending")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Median Recency")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that("interactive median plot sorted ascending", {
skip_on_cran()
p <- rfm_plot_median_recency(segments, sort = TRUE, ascending = TRUE,
interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$layoutAttrs[[1]]$title, "Median Recency by Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$categoryorder, "total ascending")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Median Recency")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that("interactive median plot flipped", {
skip_on_cran()
p <- rfm_plot_median_recency(segments, flip = TRUE, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$orientation, "h")
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$layoutAttrs[[1]]$title, "Median Recency by Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Median Recency")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Segment")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that("interactive median plot flipped sorted", {
skip_on_cran()
p <- rfm_plot_median_recency(segments, flip = TRUE, sort = TRUE,
interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$orientation, "h")
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$layoutAttrs[[1]]$title, "Median Recency by Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Median Recency")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Segment")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$categoryorder, "total ascending")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})
test_that("interactive median plot flipped sorted ascending", {
skip_on_cran()
p <- rfm_plot_median_recency(segments, flip = TRUE, sort = TRUE,
ascending = TRUE, interactive = TRUE)
expect_equal(p$x$attrs[[1]]$type, "bar")
expect_equal(p$x$attrs[[1]]$orientation, "h")
expect_equal(p$x$attrs[[1]]$marker$color, "#0f1a34")
expect_equal(p$x$layoutAttrs[[1]]$title, "Median Recency by Segment")
expect_equal(p$x$layoutAttrs[[1]]$xaxis$title, "Median Recency")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$title, "Segment")
expect_equal(p$x$layoutAttrs[[1]]$yaxis$categoryorder, "total descending")
expect_snapshot(cat(p$x$attrs[[1]]$hovertext))
})