added missing (M)BG/CNBD-k plot methods

fixes #35 
- added `(m)bgcnbd.PlotFreqVsConditionalExpectedFrequency` methods
- added `(m)bgcnbd.PlotRecVsConditionalExpectedFrequency` methods

.lintr

@@ -3,7 +3,7 @@ linters: with_defaults(
     multiple_dots_linter = NULL,
     camel_case_linter = NULL,
     spaces_left_parentheses_linter = NULL)
-exclusions: list("R/RcppExports.R", "doc/*")
+exclusions: list("R/RcppExports.R", "inst/doc/BTYDplus-HowTo.R", "tests/testthat/*")
 exclude: "# nolint"
 exclude_start: "# nolint start"
 exclude_end: "# nolint end"

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: BTYDplus
 Type: Package
 Title: Probabilistic Models for Assessing and Predicting your Customer Base
-Version: 1.0.2
+Version: 1.1.0
 Authors@R: person("Michael", "Platzer", email = "[email protected]", role = c("aut", "cre"))
 Description: Provides advanced statistical methods to describe and predict customers'
   purchase behavior in a non-contractual setting. It uses historic transaction records to fit a

NAMESPACE

@@ -9,7 +9,9 @@ export(bgcnbd.ExpectedCumulativeTransactions)
 export(bgcnbd.GenerateData)
 export(bgcnbd.LL)
 export(bgcnbd.PAlive)
+export(bgcnbd.PlotFreqVsConditionalExpectedFrequency)
 export(bgcnbd.PlotFrequencyInCalibration)
+export(bgcnbd.PlotRecVsConditionalExpectedFrequency)
 export(bgcnbd.PlotTrackingCum)
 export(bgcnbd.PlotTrackingInc)
 export(bgcnbd.cbs.LL)
@@ -25,7 +27,9 @@ export(mbgcnbd.ExpectedCumulativeTransactions)
 export(mbgcnbd.GenerateData)
 export(mbgcnbd.LL)
 export(mbgcnbd.PAlive)
+export(mbgcnbd.PlotFreqVsConditionalExpectedFrequency)
 export(mbgcnbd.PlotFrequencyInCalibration)
+export(mbgcnbd.PlotRecVsConditionalExpectedFrequency)
 export(mbgcnbd.PlotTrackingCum)
 export(mbgcnbd.PlotTrackingInc)
 export(mbgcnbd.cbs.LL)

NEWS

@@ -1,3 +1,7 @@
+1.1.0
+- added `(m)bgcnbd.PlotFreqVsConditionalExpectedFrequency` methods
+- added `(m)bgcnbd.PlotRecVsConditionalExpectedFrequency` methods
+
 1.0.2
 - speed up `xbgcnbd.EstimateParameters` by lowering lower bound of early stop to k=3
 

R/helpers.R

@@ -445,3 +445,83 @@ dc.PlotTracking <- function(actual, expected, T.cal = NULL,
   legend(pos, legend = c("Actual", "Model"), col = 1:2, lty = 1:2, lwd = 1)
   return(rbind(actual, expected))
 }
+
+
+#' Generic Method for Plotting Frequency vs. Conditional Expected Frequency
+#'
+#' @keywords internal
+dc.PlotFreqVsConditionalExpectedFrequency <- function(x, actual, expected, censor,
+                                                      xlab, ylab, xticklab, title) {
+
+  bin <- NULL # suppress checkUsage warnings
+  if (length(x) != length(actual) | length(x) != length(expected) |
+      !is.numeric(x) | !is.numeric(actual) | !is.numeric(expected) |
+      any(x < 0) | any(actual < 0) | any(expected < 0))
+    stop("x, actual and expected must be non-negative numeric vectors of same length.")
+
+  if (censor > max(x)) censor <- max(x)
+  dt <- data.table(x, actual, expected)
+  dt[, bin := pmin(x, censor)]
+  st <- dt[, .(transaction.actual = mean(actual),
+               transaction.expected = mean(expected),
+               bin.size = .N), keyby = bin]
+  st <- merge(data.table(bin = 0:censor), st, all.x = TRUE, by = "bin")
+  comparison <- t(st)[-1, ]
+  col.names <- paste(rep("freq", length(censor + 1)), (0:censor), sep = ".")
+  col.names[censor + 1] <- paste0(col.names[censor + 1], "+")
+  colnames(comparison) <- col.names
+  if (is.null(xticklab) == FALSE) {
+    x.labels <- xticklab
+  } else {
+    if (censor < ncol(comparison)) {
+      x.labels <- 0:(censor)
+      x.labels[censor + 1] <- paste0(censor, "+")
+    } else {
+      x.labels <- 0:(ncol(comparison))
+    }
+  }
+  actual <- comparison[1, ]
+  expected <- comparison[2, ]
+  ylim <- c(0, ceiling(max(c(actual, expected)) * 1.1))
+  plot(actual, type = "l", xaxt = "n", col = 1, ylim = ylim, xlab = xlab, ylab = ylab, main = title)
+  lines(expected, lty = 2, col = 2)
+  axis(1, at = 1:ncol(comparison), labels = x.labels)
+  legend("topleft", legend = c("Actual", "Model"), col = 1:2, lty = 1:2, lwd = 1)
+  return(comparison)
+}
+
+
+#' Generic Method for Plotting Frequency vs. Conditional Expected Frequency
+#'
+#' @keywords internal
+dc.PlotRecVsConditionalExpectedFrequency <- function(t.x, actual, expected,
+                                                     xlab, ylab, xticklab, title) {
+
+  bin <- NULL # suppress checkUsage warnings
+  if (length(t.x) != length(actual) | length(t.x) != length(expected) |
+      !is.numeric(t.x) | !is.numeric(actual) | !is.numeric(expected) |
+      any(t.x < 0) | any(actual < 0) | any(expected < 0))
+    stop("t.x, actual and expected must be non-negative numeric vectors of same length.")
+
+  dt <- data.table(t.x, actual, expected)
+  dt[, bin := floor(t.x)]
+  st <- dt[, .(actual = mean(actual),
+               expected = mean(expected),
+               bin.size = .N), keyby = bin]
+  st <- merge(data.table(bin = 1:floor(max(t.x))), st[bin > 0], all.x = TRUE, by = "bin")
+  comparison <- t(st)[-1, ]
+  x.labels <- NULL
+  if (is.null(xticklab) == FALSE) {
+    x.labels <- xticklab
+  } else {
+    x.labels <- 1:max(st$bin)
+  }
+  actual <- comparison[1, ]
+  expected <- comparison[2, ]
+  ylim <- c(0, ceiling(max(c(actual, expected), na.rm = TRUE) * 1.1))
+  plot(actual, type = "l", xaxt = "n", col = 1, ylim = ylim, xlab = xlab, ylab = ylab, main = title)
+  lines(expected, lty = 2, col = 2)
+  axis(1, at = 1:ncol(comparison), labels = x.labels)
+  legend("topleft", legend = c("Actual", "Model"), col = 1:2, lty = 1:2, lwd = 1)
+  return(comparison)
+}

R/mbg-cnbd-k.R

@@ -558,7 +558,7 @@ xbgcnbd.ConditionalExpectedTransactions <- function(params, T.star, x, t.x, T.ca
 #'
 #' @param params A vector with model parameters \code{k}, \code{r},
 #'   \code{alpha}, \code{a} and \code{b}, in that order.
-#' @param cal.cbs calibration period CBS (customer by sufficient statistic). It
+#' @param cal.cbs Calibration period CBS (customer by sufficient statistic). It
 #'   must contain columns for frequency ('x') and total time observed ('T.cal').
 #' @param censor Cutoff point for number of transactions in plot.
 #' @param xlab Descriptive label for the x axis.
@@ -823,6 +823,111 @@ xbgcnbd.PlotTrackingInc <- function(params, T.cal, T.tot, actual.inc.tracking.da
 
 
 
+#' (M)BG/CNBD-k Plot Frequency vs. Conditional Expected Frequency
+#'
+#' Plots the actual and conditional expected number transactions made by
+#' customers in the holdout period, binned according to calibration period
+#' frequencies, and returns this comparison in a matrix.
+#'
+#' @param params A vector with model parameters \code{k}, \code{r},
+#'   \code{alpha}, \code{a} and \code{b}, in that order.
+#' @param T.star Length of the holdout period.
+#' @param cal.cbs Calibration period CBS (customer by sufficient statistic). It
+#'   must contain columns for frequency ('x'), recency ('t.x') and total time
+#'   observed ('T.cal').
+#' @param x.star Vector of transactions made by each customer in the holdout period.
+#' @param censor Cutoff point for number of transactions in plot.
+#' @param xlab Descriptive label for the x axis.
+#' @param ylab Descriptive label for the x axis.
+#' @param xticklab A vector containing a label for each tick mark on the x axis.
+#' @param title Title placed on the top-center of the plot.
+#' @return Holdout period transaction frequency comparison matrix (actual vs. expected).
+#' @export
+#' @seealso \code{\link{bgcnbd.PlotFreqVsConditionalExpectedFrequency}}
+#' @examples
+#' \dontrun{
+#' data("groceryElog")
+#' cbs <- elog2cbs(groceryElog, T.cal = "2006-09-30")
+#' params <- mbgcnbd.EstimateParameters(cbs, k=2)
+#' mbgcnbd.PlotFreqVsConditionalExpectedFrequency(params, T.star=52, cbs, cbs$x.star, censor=7)
+#' }
+mbgcnbd.PlotFreqVsConditionalExpectedFrequency <- function(params, T.star, cal.cbs, x.star,
+                                                          censor, xlab = "Calibration period transactions",
+                                                          ylab = "Holdout period transactions", xticklab = NULL,
+                                                          title = "Conditional Expectation") {
+  x.star.est <- mbgcnbd.ConditionalExpectedTransactions(params, T.star, cal.cbs$x, cal.cbs$t.x, cal.cbs$T.cal)
+  dc.PlotFreqVsConditionalExpectedFrequency(x = cal.cbs$x, actual = x.star, expected = x.star.est,
+                                            censor = censor, xlab = xlab, ylab = ylab, xticklab = xticklab,
+                                            title = title)
+}
+
+#' @rdname mbgcnbd.PlotFreqVsConditionalExpectedFrequency
+#' @export
+bgcnbd.PlotFreqVsConditionalExpectedFrequency <- function(params, T.star, cal.cbs, x.star,
+                                                          censor, xlab = "Calibration period transactions",
+                                                          ylab = "Holdout period transactions", xticklab = NULL,
+                                                          title = "Conditional Expectation") {
+  x.star.est <- bgcnbd.ConditionalExpectedTransactions(params, T.star, cal.cbs$x, cal.cbs$t.x, cal.cbs$T.cal)
+  dc.PlotFreqVsConditionalExpectedFrequency(x = cal.cbs$x, actual = x.star, expected = x.star.est,
+                                            censor = censor, xlab = xlab, ylab = ylab, xticklab = xticklab,
+                                            title = title)
+}
+
+
+
+#' (M)BG/CNBD-k Plot Actual vs. Conditional Expected Frequency by Recency
+#'
+#' Plots the actual and conditional expected number transactions made by
+#' customers in the holdout period, binned according to calibration period
+#' recencies, and returns this comparison in a matrix.
+#'
+#' @param params A vector with model parameters \code{k}, \code{r},
+#'   \code{alpha}, \code{a} and \code{b}, in that order.
+#' @param cal.cbs Calibration period CBS (customer by sufficient statistic). It
+#'   must contain columns for frequency ('x'), recency ('t.x') and total time
+#'   observed ('T.cal').
+#' @param T.star Length of the holdout period.
+#' @param x.star Vector of transactions made by each customer in the holdout period.
+#' @param xlab Descriptive label for the x axis.
+#' @param ylab Descriptive label for the x axis.
+#' @param xticklab A vector containing a label for each tick mark on the x axis.
+#' @param title Title placed on the top-center of the plot.
+#' @return Matrix comparing actual and conditional expected transactions in the holdout period.
+#' @export
+#' @seealso \code{\link{bgcnbd.PlotFreqVsConditionalExpectedFrequency}}
+#' @examples
+#' \dontrun{
+#' data("groceryElog")
+#' cbs <- elog2cbs(groceryElog, T.cal = "2006-09-30")
+#' params <- mbgcnbd.EstimateParameters(cbs, k=2)
+#' mbgcnbd.PlotRecVsConditionalExpectedFrequency(params, cbs, T.star=52, cbs$x.star)
+#' }
+mbgcnbd.PlotRecVsConditionalExpectedFrequency <- function(
+                                       params, cal.cbs, T.star, x.star,
+                                       xlab = "Calibration period recency",
+                                       ylab = "Holdout period transactions", xticklab = NULL,
+                                       title = "Actual vs. Conditional Expected Transactions by Recency") {
+  x.star.est <- mbgcnbd.ConditionalExpectedTransactions(params, T.star, cal.cbs$x, cal.cbs$t.x, cal.cbs$T.cal)
+  dc.PlotRecVsConditionalExpectedFrequency(t.x = cal.cbs$t.x, actual = x.star, expected = x.star.est,
+                                            xlab = xlab, ylab = ylab, xticklab = xticklab,
+                                            title = title)
+}
+
+#' @rdname mbgcnbd.PlotRecVsConditionalExpectedFrequency
+#' @export
+bgcnbd.PlotRecVsConditionalExpectedFrequency <- function(
+                                      params, cal.cbs, T.star, x.star,
+                                      xlab = "Calibration period recency",
+                                      ylab = "Holdout period transactions", xticklab = NULL,
+                                      title = "Actual vs. Conditional Expected Transactions by Recency") {
+  x.star.est <- bgcnbd.ConditionalExpectedTransactions(params, T.star, cal.cbs$x, cal.cbs$t.x, cal.cbs$T.cal)
+  dc.PlotRecVsConditionalExpectedFrequency(t.x = cal.cbs$t.x, actual = x.star, expected = x.star.est,
+                                            xlab = xlab, ylab = ylab, xticklab = xticklab,
+                                            title = title)
+}
+
+
+
 #' Simulate data according to (M)BG/CNBD-k model assumptions
 #'
 #' @param n Number of customers.