Merge pull request #103 from ModelOriented/cran-release-0.0.3

Cran release fixes.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: xspliner
 Title: Assisted Model Building, using Surrogate Black-Box Models to Train Interpretable Spline Based Additive Models
-Version: 0.0.2.9005
+Version: 0.0.3
 Authors@R: c(
   person("Krystian", "Igras", email = "[email protected]", role = c("aut", "cre")),
   person("Przemyslaw", "Biecek", role =  c("aut", "ths")))
@@ -20,7 +20,7 @@ Imports: stats,
     magrittr,
     purrr,
     tidyr,
-    pROC
+    pROC (>= 1.15.3)
 Suggests:
     ALEPlot,
     factorMerger,

NEWS.md

@@ -1,3 +1,11 @@
+# xspliner 0.0.3
+* Summary method extended with comparison statistics
+* Extended methods for auto-extracting model metadata (lhs, response)
+* Added comparison plot for factor responses
+* Documentation extended with new examples
+* Ability to specify glm options
+* Added more informative progress messages
+
 # xspliner 0.0.2
 * Specify parameters hierarchy
 * Use of S3

R/methods-xspliner.R

@@ -66,14 +66,18 @@ measure_diff_roc <- function(a, b, measure = max) {
 }
 
 fit_roc_diff <- function(surrogate_scores, original_scores, original_labels) {
-  is_score_surrogate <- all(surrogate_scores <= 1 && surrogate_scores >=0)
-  is_score_original <- all(original_scores <= 1 && original_scores >=0)
+  is_score_surrogate <- all(surrogate_scores <= 1) && all(surrogate_scores >=0)
+  is_score_original <- all(original_scores <= 1) && all(original_scores >=0)
   if (is_score_original && is_score_surrogate) {
     roc_surrogate <- pROC::roc(original_labels, surrogate_scores, direction="<")
     roc_original <- pROC::roc(original_labels, original_scores, direction="<")
     thresholds <- union(roc_surrogate$thresholds, roc_original$thresholds)
-    roc_surrogate_on_thresholds <- pROC::coords(roc_surrogate, x = thresholds, input = "threshold", ret = c("se", "1-sp"))
-    roc_original_on_thresholds <- pROC::coords(roc_original, x = thresholds, input = "threshold", ret = c("se", "1-sp"))
+    roc_surrogate_on_thresholds <- pROC::coords(
+      roc_surrogate, x = thresholds, input = "threshold", ret = c("se", "1-sp"), transpose = TRUE
+    )
+    roc_original_on_thresholds <- pROC::coords(
+      roc_original, x = thresholds, input = "threshold", ret = c("se", "1-sp"), transpose = TRUE
+    )
     list(
       max = measure_diff_roc(roc_surrogate_on_thresholds, roc_original_on_thresholds),
       mean = measure_diff_roc(roc_surrogate_on_thresholds, roc_original_on_thresholds, measure = mean)
@@ -183,27 +187,27 @@ compare_summary <- function(surrogate, original, surrogate_pred_fun, original_pr
 #' summary(iris.xs, model = iris.rf, newdata = data)
 #'
 #' # Classification model
-#' data <- droplevels(iris[51:150, ]) # selecting only two species data
-#' iris.rf <- randomForest(Species ~ ., data = data)
-#' iris.xs <- xspline(iris.rf)
-#'
-#' # Comparing summaries requires providing prediction function
-#' # Prediction as probability for success
-#' prob_rf <- function(object, newdata) predict(object, newdata = newdata, type = "prob")[, 2]
-#' prob_xs <- function(object, newdata) predict(object, newdata = newdata, type = "response")
-#' summary(iris.xs, model = iris.rf, newdata = data, prediction_funs = list(prob_xs, prob_rf))
-#' # Prediction as final category
-#' response_rf <- function(object, newdata) predict(object, newdata = newdata)
-#' response_xs <- function(object, newdata) {
-#'   y_levels <- levels(newdata[[environment(object)$response]])
-#'   factor(
-#'     y_levels[(predict.glm(object, newdata = newdata, type = "link") > 0) + 1],
-#'     levels = y_levels
-#'   )
-#' }
-#' response_rf(iris.rf, newdata = data)
-#' response_xs(iris.xs, newdata = data)
-#' summary(iris.xs, model = iris.rf, newdata = data, prediction_funs = list(response_xs, response_rf))
+# data <- droplevels(iris[51:150, ]) # selecting only two species data
+# iris.rf <- randomForest(Species ~ ., data = data)
+# iris.xs <- xspline(iris.rf)
+#
+# # Comparing summaries requires providing prediction function
+# # Prediction as probability for success
+# prob_rf <- function(object, newdata) predict(object, newdata = newdata, type = "prob")[, 2]
+# prob_xs <- function(object, newdata) predict(object, newdata = newdata, type = "response")
+# summary(iris.xs, model = iris.rf, newdata = data, prediction_funs = list(prob_xs, prob_rf))
+# # Prediction as final category
+# response_rf <- function(object, newdata) predict(object, newdata = newdata)
+# response_xs <- function(object, newdata) {
+#   y_levels <- levels(newdata[[environment(object)$response]])
+#   factor(
+#     y_levels[(predict.glm(object, newdata = newdata, type = "link") > 0) + 1],
+#     levels = y_levels
+#   )
+# }
+# response_rf(iris.rf, newdata = data)
+# response_xs(iris.xs, newdata = data)
+# summary(iris.xs, model = iris.rf, newdata = data, prediction_funs = list(response_xs, response_rf))
 #'
 #' @export
 summary.xspliner <- function(object, predictor, ..., model = NULL, newdata = NULL,

R/utils-formula-build.R

@@ -204,7 +204,7 @@ get_predictors_classes <- function(data) {
 try_get <- function(possible) {
   possible_response <- try(possible, silent = TRUE)
   if (!("try-error" %in% class(possible_response))) {
-    if (length(possible_response) == 0 || possible_response == "NULL") {
+    if (length(possible_response) == 0 || identical(possible_response, "NULL")) {
       NULL
     } else {
       possible_response

cran-comments.md

@@ -1,39 +1,42 @@
 ## Test environments
-* local Ubuntu 18.10, R 3.5.1
-* Rhub Ubuntu Linux 16.04 LTS, R-release, GCC
+* local check
+  Ubuntu 18.10, R 3.6.1
 * win-builder
+  R version 3.5.3 (2019-03-11)
+  R Under development (unstable) (2019-09-02 r77130)
+  R version 3.6.1 (2019-07-05)
 
-## R CMD check results
+## `R CMD check xspliner_0.0.3.tar.gz --as-cran` results
 
 ```
 Status: OK
 ```
 
-## check_rhub() result
+## win-builder result
 
 ```
-* checking CRAN incoming feasibility ... NOTE
-Maintainer: ‘Krystian Igras <[email protected]>’
-
-New submission
-
-Possibly mis-spelled words in DESCRIPTION:
-  interpretable (9:41)
-  Interpretable (3:15)
-
-* checking examples ... NOTE
-Examples with CPU or elapsed time > 5s
-user system elapsed
-xspline 5.92  0.164   6.217
-
-0 errors | 0 warnings | 2 notes
+* using log directory 'd:/RCompile/CRANguest/R-oldrelease/xspliner.Rcheck'
+* using R version 3.5.3 (2019-03-11)
+* using platform: x86_64-w64-mingw32 (64-bit)
+...
+* DONE
+Status: OK
 ```
 
-# win-builder result
-
 ```
-* checking CRAN incoming feasibility ... NOTE
-Maintainer: 'Krystian Igras <[email protected]>'
+* using log directory 'd:/RCompile/CRANguest/R-devel/xspliner.Rcheck'
+* using R Under development (unstable) (2019-09-02 r77130)
+* using platform: x86_64-w64-mingw32 (64-bit)
+...
+* DONE
+Status: OK
+```
 
-Status: 1 NOTE
+```
+* using log directory 'd:/RCompile/CRANguest/R-release/xspliner.Rcheck'
+* using R version 3.6.1 (2019-07-05)
+* using platform: x86_64-w64-mingw32 (64-bit)
+...
+* DONE
+Status: OK
 ```