write tree rules as SQL case when statements

R/asSQL.R

@@ -0,0 +1,33 @@
+asSQL <- function(model, ...) UseMethod("asSQL")
+
+asSQL.rpart <- function(model, ...)
+{
+    if (!inherits(model, "rpart")) stop(Rtxt("Not a legitimate rpart tree"))
+    target  <- as.character(attr(model$terms, "variables")[2]) # name of the dependent variable
+    frm     <- model$frame # a dataframe containing the nodes of the tree
+    names   <- row.names(frm) # the (unique) node numbers that follow a binary ordering indexed by node depth
+    ds.size <- model$frame[1,]$n # total number of rows in the data
+    ordered <- sort(frm$n, decreasing = TRUE, index.return = TRUE)$ix
+
+    cat("CASE ")
+    for (i in ordered)
+    {
+        if (frm[i,1] == "<leaf>")
+        {
+            cat("WHEN \n")
+            yval <- frm[i,]$yval
+            pth <- path.rpart(model,
+                              nodes = as.numeric(names[i]),
+                              print.it = FALSE,
+                              sql = TRUE)
+            pth <- unlist(pth)[-1]
+            if (length(pth) == 0) {pth <- "True"}
+
+            cat(sprintf("   %s\n", pth, sep = ""))
+            cat(sprintf("   %s %s\n",
+                        "THEN", yval))
+        }
+    }
+    cat("\n")
+    invisible(ordered)
+}

R/labels.rpart.R

@@ -14,7 +14,7 @@
 ##   ... = other args for abbreviate()
 ##
 labels.rpart <- function(object, digits = 4, minlength = 1L, pretty,
-                         collapse = TRUE, ...)
+                         collapse = TRUE, sql = FALSE, ...)
 {
     if (missing(minlength) && !missing(pretty)) {
 	minlength <- if (is.null(pretty)) 1L
@@ -75,7 +75,7 @@ labels.rpart <- function(object, digits = 4, minlength = 1L, pretty,
 	    j <- jrow[i]
 	    splits <- object$csplit[crow[i], ]
 	    ## splits will contain 1=left, 3=right, 2= neither
-            cl <- if (minlength == 1L) "" else ","
+            cl <- if (minlength == 1L) "" else if (sql) "', '" else ","
             lsplit[j] <-
                 paste((xlevels[[cindex[i]]])[splits == 1L], collapse = cl)
             rsplit[j] <-
@@ -90,8 +90,17 @@ labels.rpart <- function(object, digits = 4, minlength = 1L, pretty,
 	return(cbind(ltemp, rtemp))
     }
 
-    lsplit <- paste0(ifelse(ncat < 2L, "", "="), lsplit)
-    rsplit <- paste0(ifelse(ncat < 2L, "", "="), rsplit)
+    if (sql) {
+        lsplit <- ifelse(ncat < 2L,
+                         paste0( "", lsplit),
+                         paste0(paste0(" in ('", lsplit), "')"))
+        rsplit <- ifelse(ncat < 2L,
+                         paste0( "", rsplit),
+                         paste0(paste0(" in ('", rsplit), "')"))
+    } else {
+        lsplit <- paste0(ifelse(ncat < 2L, "", "="), lsplit)
+        rsplit <- paste0(ifelse(ncat < 2L, "", "="), rsplit)
+    }
 
     ## Now match them up to node numbers
     ##   The output will have one label per row of object$frame, each

R/path.rpart.R

@@ -1,10 +1,10 @@
 ## submitted by Anantha Prasad 1/26/98
 
-path.rpart <- function(tree, nodes, pretty = 0, print.it = TRUE)
+path.rpart <- function(tree, nodes, pretty = 0, print.it = TRUE, sql = FALSE)
 {
     if (!inherits(tree, "rpart"))
         stop("Not a legitimate \"rpart\" object")
-    splits <- labels.rpart(tree, pretty = pretty)
+    splits <- labels.rpart(tree, pretty = pretty, sql = sql)
     frame <- tree$frame
     n <- row.names(frame)
     node <- as.numeric(n)