Inputchecks for newcustomer in predict.spending and predict.transactions

Author: pschil

R/f_generics_clvfittedspending.R

@@ -50,6 +50,12 @@ setMethod("clv.controlflow.check.newdata", signature(clv.fitted="clv.fitted.spen
 # . clv.controlflow.predict.new.customer -----------------------------------------------------------------------
 setMethod("clv.controlflow.predict.new.customer", signature(clv.fitted="clv.fitted.spending"), definition = function(clv.fitted, clv.newcustomer){
 
+
+  # Only newcustomer.spending() is allowed
+  if(!is(newdata, "clv.newcustomer.spending")){
+    check_err_msg("To predict for new customers, 'newdata' has to be the output of 'newdata.spending()'!")
+  }
+
   return(drop(clv.model.predict.new.customer(
     clv.model = clv.fitted@clv.model,
     clv.fitted = clv.fitted,

R/f_generics_clvfittedtransactions.R

@@ -329,7 +329,7 @@ setMethod("clv.controlflow.predict.post.process.prediction.table", signature = s
 #' @include class_clv_fitted_transactions.R
 setMethod("clv.controlflow.predict.new.customer", signature = signature(clv.fitted="clv.fitted.transactions"), definition = function(clv.fitted, clv.newcustomer){
 
-  if(!is(clv.newcustomer, "clv.newcustomer.no.cov") | is(clv.newcustomer, "clv.newcustomer.static.cov")){
+  if(!is(clv.newcustomer, "clv.newcustomer.no.cov") | is(clv.newcustomer, "clv.newcustomer.static.cov") | is(clv.newcustomer, "clv.newcustomer.dynamic.cov")){
     check_err_msg("Parameter newdata has to be output from calling `newcustomer()`!")
   }
 

R/f_interface_newcustomer.R

@@ -156,6 +156,8 @@ NULL
 # considered VIRTUAL and cannot be instantiated. Inheriting from this class,
 # allows to define a class `newcustomer.spending` which has no slots and
 # otherwise would be considered VIRTUAL.
+# This base class additionally is handy to catch any type of newcustomer
+# instance when verifying parameters.
 # Making this class virtual is not required as having no slots and parent has
 # the same effect but better to be explicit.
 setClass("clv.newcustomer.base", contains = "VIRTUAL")

R/f_interface_predict_clvfittedspending.R

@@ -66,24 +66,24 @@
 predict.clv.fitted.spending <- function(object, newdata=NULL, uncertainty=c("none", "boots"), level=0.9, num.boots=100, verbose=TRUE, ...){
 
   check_err_msg(check_user_data_emptyellipsis(...))
-  check_err_msg(check_user_data_uncertainty(uncertainty = uncertainty))
-  # match uncertainty to one of the allowed values
-  uncertainty <- match.arg(tolower(uncertainty), choices=c("none", "boots"), several.ok=FALSE)
-
-
 
   # The usual prediction unless newdata indicates a new customer prediction (ie newdata=newcustomer.spending())
-  if(is(newdata, "clv.newcustomer.spending")){
+  # check for base class and not "clv.newcustomer.spending" as users likely will pass other newcustomer objects
+  if(is(newdata, "clv.newcustomer.base")){
+    # some type of newcustomer object passed
+
+    # No other parameters may be passed (all others must be missing)
+    if(!all(missing(uncertainty), missing(level), missing(num.boots))){
+      check_err_msg("No other parameters ('uncertainty', 'level', 'num.boots') may be specified when predicting for new customers!")
+    }
 
-    # TODO: Implement parameter checks
-    # not other parameters except object and newdata may be given (all others must be missing)
-    # if(!all(missing(prediction.end), missing(predict.spending), missing(continuous.discount.factor))){
-    #   check_err_msg("Parameters prediction.end, predict.spending and continuous.discount.factor may not be specified when predicting for new customers.")
-    # }
     return(clv.controlflow.predict.new.customer(clv.fitted = object, clv.newcustomer = newdata))
   }
 
-
+  # match uncertainty to one of the allowed values. Only after newdata section
+  # because after match.arg(), missing() is always false
+  check_err_msg(check_user_data_uncertainty(uncertainty = uncertainty))
+  uncertainty <- match.arg(tolower(uncertainty), choices=c("none", "boots"), several.ok=FALSE)
   return(clv.template.controlflow.predict(clv.fitted=object, verbose=verbose, user.newdata=newdata, uncertainty=uncertainty, num.boots=num.boots, level=level))
 }
 

R/f_interface_predict_clvfittedtransactions.R

@@ -185,23 +185,43 @@ predict.clv.fitted.transactions <- function(object, newdata=NULL, prediction.end
                                             continuous.discount.factor=log(1+0.1), uncertainty=c("none", "boots"), level=0.9, num.boots=100, verbose=TRUE, ...){
 
   check_err_msg(check_user_data_emptyellipsis(...))
-  check_err_msg(check_user_data_uncertainty(uncertainty=uncertainty))
-  # match uncertainty to one of the allowed values
-  uncertainty <- match.arg(tolower(uncertainty), choices = c("none", "boots"), several.ok = FALSE)
 
   # The usual prediction unless newdata indicates a new customer prediction (ie newdata=newcustomer())
-  # the newdata classes for static and dyncov inherit from `clv.newcustomer.no.cov`
-  if(is(newdata, "clv.newcustomer.no.cov")){
-    # TODO: Check that is not newcustomer.spending()
+  if(is(newdata, "clv.newcustomer.base")){
+
     # not other parameters except object and newdata may be given (all others must be missing)
-    if(!all(missing(prediction.end), missing(predict.spending), missing(continuous.discount.factor))){
-      check_err_msg("Parameters prediction.end, predict.spending and continuous.discount.factor may not be specified when predicting for new customers.")
+    if(!all(missing(prediction.end), missing(predict.spending),
+            missing(continuous.discount.factor), missing(uncertainty),
+            missing(level), missing(num.boots))){
+      check_err_msg("No other parameters ('prediction.end', 'predict.spending', 'continuous.discount.factor', uncertainty', 'level', 'num.boots') may be specified when predicting for new customers!")
     }
 
+    # the newdata classes for static and dyncov inherit from `clv.newcustomer.no.cov`
+    # but `clv.newcustomer.spending` does not
+    if(!is(newdata, "clv.newcustomer.no.cov")){
+
+      if(is(object, "clv.fitted.transactions.dynamic.cov")){
+        msg.newcustomer <- "newcustomer.dynamic()"
+      }else{
+        if(is(object, "clv.fitted.transactions.static.cov")){
+          msg.newcustomer <- "newcustomer.static()"
+        }else{
+          msg.newcustomer <- "newcustomer()"
+        }
+      }
+      check_err_msg(paste0("To predict for new customers, 'newdata' has to be the output of '",msg.newcustomer,"'!"))
+    }
 
     return(clv.controlflow.predict.new.customer(clv.fitted = object, clv.newcustomer = newdata))
   }
 
+
+  # match uncertainty to one of the allowed values. Only after newdata section
+  # because after match.arg(), missing() is always false
+  check_err_msg(check_user_data_uncertainty(uncertainty=uncertainty))
+  # match uncertainty to one of the allowed values
+  uncertainty <- match.arg(tolower(uncertainty), choices = c("none", "boots"), several.ok = FALSE)
+
   # If it was not explicitly passed in the call, the spending model should only be applied
   #   it there is spending data. Otherwise, predict does not work out-of-the-box for
   #   data object w/o spending