0001-allow-empty-model.patch

From 8c3ee5cbeb430aa3c16b4a516585449a0e5103a9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Kirill=20M=C3=BCller?= <kirill.mueller@ivt.baug.ethz.ch>
Date: Mon, 2 Sep 2013 17:28:43 +0200
Subject: [PATCH] allow empty model

---
 R/na.rpart.R |  1 +
 R/rpart.R    |  2 +-
 src/rpart.c  | 50 ++++++++++++++++++++++++++------------------------
 3 files changed, 28 insertions(+), 25 deletions(-)

diff --git a/R/na.rpart.R b/R/na.rpart.R
index 7db0274..a7da015 100644
--- a/R/na.rpart.R
+++ b/R/na.rpart.R
@@ -11,6 +11,7 @@ na.rpart <- function(x)
         keep <- if (is.matrix(ymiss))
             ((xmiss %*% rep(1, ncol(xmiss))) < ncol(xmiss)) &
                 ((ymiss %*% rep(1, ncol(ymiss))) == 0)
+        else if (ncol(xmiss) == 0) !ymiss
         else ((xmiss %*% rep(1, ncol(xmiss))) < ncol(xmiss)) & !ymiss
     }
     if (all(keep)) x
diff --git a/R/rpart.R b/R/rpart.R
index 6973b71..d3a7c73 100644
--- a/R/rpart.R
+++ b/R/rpart.R
@@ -142,7 +142,7 @@ rpart <-
     tfun <- function(x)
 	if (is.matrix(x)) rep(is.ordered(x), ncol(x)) else is.ordered(x)
     labs <- sub("^`(.*)`$", "\\1", attr(Terms, "term.labels")) # beware backticks
-    isord <- unlist(lapply(m[labs], tfun))
+    isord <- vapply(m[labs], tfun, logical(1))
 
     storage.mode(X) <- "double"
     storage.mode(wt) <- "double"
diff --git a/src/rpart.c b/src/rpart.c
index 3975e4f..9ac7af5 100644
--- a/src/rpart.c
+++ b/src/rpart.c
@@ -146,33 +146,35 @@ rpart(SEXP ncat2, SEXP method2, SEXP opt2,
      * I don't have to sort the categoricals.
      */
     rp.sorts = (int **) ALLOC(rp.nvar, sizeof(int *));
-    rp.sorts[0] = (int *) ALLOC(n * rp.nvar, sizeof(int));
-    maxcat = 0;
-    for (i = 0; i < rp.nvar; i++) {
-	rp.sorts[i] = rp.sorts[0] + i * n;
-	for (k = 0; k < n; k++) {
-	    if (!R_FINITE(rp.xdata[i][k])) {
-		rp.tempvec[k] = -(k + 1);       /* this variable is missing */
-		rp.xtemp[k] = 0;        /* avoid weird numerics in S's NA */
-	    } else {
-		rp.tempvec[k] = k;
-		rp.xtemp[k] = rp.xdata[i][k];
+    if (rp.nvar > 0) {
+	rp.sorts[0] = (int *) ALLOC(n * rp.nvar, sizeof(int));
+	maxcat = 0;
+	for (i = 0; i < rp.nvar; i++) {
+	    rp.sorts[i] = rp.sorts[0] + i * n;
+	    for (k = 0; k < n; k++) {
+		if (!R_FINITE(rp.xdata[i][k])) {
+		    rp.tempvec[k] = -(k + 1);       /* this variable is missing */
+		    rp.xtemp[k] = 0;        /* avoid weird numerics in S's NA */
+		} else {
+		    rp.tempvec[k] = k;
+		    rp.xtemp[k] = rp.xdata[i][k];
+		}
 	    }
+	    if (ncat[i] == 0)
+		mysort(0, n - 1, rp.xtemp, rp.tempvec);
+	    else if (ncat[i] > maxcat)
+		maxcat = ncat[i];
+	    for (k = 0; k < n; k++)
+		rp.sorts[i][k] = rp.tempvec[k];
 	}
-	if (ncat[i] == 0)
-	    mysort(0, n - 1, rp.xtemp, rp.tempvec);
-	else if (ncat[i] > maxcat)
-	    maxcat = ncat[i];
-	for (k = 0; k < n; k++)
-	    rp.sorts[i][k] = rp.tempvec[k];
-    }
 
-    /*
-     * save away a copy of the rp.sorts, if needed for xval
-     */
-    if (xvals > 1) {
-	savesort = (int *) ALLOC(n * rp.nvar, sizeof(int));
-	memcpy(savesort, rp.sorts[0], n * rp.nvar * sizeof(int));
+	/*
+	 * save away a copy of the rp.sorts, if needed for xval
+	 */
+	if (xvals > 1) {
+	    savesort = (int *) ALLOC(n * rp.nvar, sizeof(int));
+	    memcpy(savesort, rp.sorts[0], n * rp.nvar * sizeof(int));
+	}
     }
 
     /*
-- 
1.8.4

0002-predict.rpart-works-with-empty-model.patch

From b927c1e97637d21d97b089f732540653feff2b50 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Kirill=20M=C3=BCller?= <kirill.mueller@ivt.baug.ethz.ch>
Date: Mon, 2 Sep 2013 19:19:20 +0200
Subject: [PATCH 2/2] predict.rpart works with empty model

---
 R/rpart.matrix.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/rpart.matrix.R b/R/rpart.matrix.R
index 338767f..de70da0 100644
--- a/R/rpart.matrix.R
+++ b/R/rpart.matrix.R
@@ -14,7 +14,7 @@ rpart.matrix <- function(frame)
     ## turn other classes into numerics.
     ## We replace columns in frame rather than making a new object, since
     ## model.matrix wants a model.frame object as it's argument.
-    for (i in 1:ncol(frame)) {
+    for (i in seq_len(ncol(frame))) {
         if (is.character(frame[[i]])) frame[[i]] <- as.numeric(factor(frame[[i]]))
         else if (!is.numeric(frame[[i]])) frame[[i]] <- as.numeric(frame[[i]])
     }
-- 
1.8.4